cad lisp程序 标注 避让,[原创]标注对齐源程序 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - 东西 - Powered by Discuz...

本帖最后由 langjs 于 2014-2-8 01:16 编辑

根据网友建议修改更新于2010年12月31日。(网上有个某老大做的尺寸标注对齐的源程序，但是在对齐尺寸时，尺寸界线也发生移动。本人编写了一个尺寸标注对齐的程序，在对齐时候尺寸界线不移动，可能效果好一些，请大家试用。在明经里边学到很多东西，自己也献献丑，做的东西分享给大家。)

坐标的我已经发过一个，请参考http://bbs.mjtd.com/thread-78807-1-1.html

;;; _______________________________________________________;;; 标注对齐     langjs 2011.11.26

;;; (本程序仅适用于多个水平或垂直标注对齐)

;;; _______________________________________________________

(defun c:qq (/ ent i name np10 np11 np13 np14 p0 p00 p10 p11 p13 p14 ss ss1 ss2 u v)

(defun ssgengxin (ss / ent i name p10 p14 ss1 ss2) ; 将误选的横纵标注(少数量)从选择集中删除?

(setq ss1 (ssadd)  ss2 (ssadd))

(repeat (setq i (sslength ss))

(setq ent (entget (setq name (ssname ss (setq i (1- i)))))

p10 (cdr (assoc 10 ent))  p14 (cdr (assoc 14 ent))

)

(cond

((= (fix (+ 0.5 (car p10))) (fix (+ 0.5 (car p14))))

(setq ss1 (ssadd name ss1))

)

((= (fix (+ 0.5 (cadr p10))) (fix (+ 0.5 (cadr p14))))

(setq ss2 (ssadd name ss2))

)

(t )

)

)

(if (>= (sslength ss1) (sslength ss2))  ss1  ss2 )

)

(defun jisuan (ent / p10 p11 p13 p14)        ; 计算坐标点子程序

(setq p10 (cdr (assoc 10 ent))  p14 (cdr (assoc 14 ent))

p11 (cdr (assoc 11 ent))  p13 (cdr (assoc 13 ent))

)

(cond

((= (fix (+ 0.5 (car p10))) (fix (+ 0.5 (car p14))))

(setq np10 (list (car p10) (cadr p0))

np11 (list (car p11) (+ (- (cadr p11) (cadr p10)) (cadr p0)))

np13 (list (car p13) (cadr p00))

np14 (list (car p14) (cadr p00))

)

)

((= (fix (+ 0.5 (cadr p10))) (fix (+ 0.5 (cadr p14))))

(setq np10 (list (car p0) (cadr p10))

np11 (list (+ (- (car p11) (car p10)) (car p0)) (cadr p11))

np13 (list (car p00) (cadr p13))

np14 (list (car p00) (cadr p14))

)

)

)

)

(defun gengxin (ent u np10 v np11)

(setq ent (subst(cons u np10)(assoc u ent) ent ))

(entmod (subst  (cons v np11)(assoc v ent) ent ))

)

(setvar "cmdecho" 0)                       ; 关闭命令响应

(if (setq ss (ssget '((0 . "DIMENSION"))))

(progn

(setq ss (ssgengxin ss))

(if (setq p0 (getpoint "\n指定标注线位置,或:"))

(repeat (setq i (sslength ss))

(setq ent (entget (ssname ss (setq i (1- i)))))

(jisuan ent)

(gengxin ent 10 np10 11 np11)

)

(setq p0 '(0.0 0.0))

)

(if (setq p00 (getpoint "\n指定引出线位置,或:"))

(repeat (setq i (sslength ss))

(setq ent (entget (ssname ss (setq i (1- i)))))

(jisuan ent)

(gengxin ent 13 np13 14 np14)

)

)

)

)

(princ)

)