- (defun c:dag (/ ss ptx i endata pt13 pt14 ang vlen)
- (princ "\n选择要对齐的标注")
- (setq ss (ssget '((0 . "DIMENSION"))))
- ;;需要计算一下哪种标注最多
- ;;排除少量的,用最多的那种
- (while (= (car (grread 1)) 5)
- (setq ptx (cadr (grread 1)))
- (setq i 0)
- (repeat (sslength ss)
- (setq endata (entget (ssname ss i)))
- (entmod (subst (cons 10 ptx) (assoc 10 endata) endata ))
- (setq i (1+ i))
- ); end repeat
- );end while
- ;;下面来指定引线起点
- (setq ptx (getpoint "\n指定标注引线起点") i 0)
- (repeat (sslength ss)
- (setq endata (entget (ssname ss i)))
- (setq pt13 (cdr (assoc 13 endata))
- pt14 (cdr (assoc 14 endata)))
- (if (= 33 (cdr (assoc 70 endata))) (setq ang (angle pt13 pt14)) (setq ang (cdr (assoc 50 endata))))
- (entmake (list '(0 . "LINE") (cons 10 ptx) (cons 11 (polar ptx ang 100))))
- (setq vlen (vlax-ename->vla-object (entlast)))
- ;;求出跟线最近的点
- (setq endata (subst (cons 13 (vlax-curve-getclosestpointto vlen pt13 T)) (assoc 13 endata) endata)
- endata (subst (cons 14 (vlax-curve-getclosestpointto vlen pt14 T)) (assoc 14 endata) endata))
- (vla-erase vlen)
- (entmod endata)
- (setq i (1+ i))
-
- );end repeat
-
- )
|