尺寸长度剪切
;;;;===Functions developed by Xiaoyu===;
; 尺寸界线修剪 小宇 98.8.5 E-MAIL:CHXY@HOTMAIL.COM
;
;命令是dt，就是dimtrim的意思
(defun dfrmvz (p /)
(if p (list (car p) (cadr p) 0.0))
)
(defun c:dt ( / n ss sn en pt10 pt13 pt14 ptx ptx1 ptx2 pt_1 pt_2 ang1 ang2
oexo ose1 ose2)
(if (and (setq pt_1 (getpoint "\n切断线第一点(切线要穿过尺寸线)<退出>: "))
(setq pt_2 (getpoint pt_1 "\n切断线第二点(切线要穿过尺寸线)<退出>: "))
(setq n 0 ss (ssget "F" (list pt_1 pt_2)))
)
(progn
(setq oexo (getvar "dimexo"))
(setq ose1 (getvar "dimse1"))
(setq ose2 (getvar "dimse2"))
(setvar "dimexo" 0.0)
(setvar "dimse1" 0)
(setvar "dimse2" 0)
(setq ptx (mapcar '(lambda (x y) (* 0.5 (+ x y))) pt_1 pt_2))
(while (setq sn (ssname ss n))
(setq n (1+ n) en (entget sn))
(if (= "DIMENSION" (cdr (assoc 0 en)))
(progn
(setq pt10 (cdr (assoc 10 en)) pt13 (cdr (assoc 13 en))
pt14 (cdr (assoc 14 en)) ang1 (angle pt10 pt14)
ang2 (+ ang1 (* 0.5 pi)) pt10 (dfrmvz pt10)
pt13 (dfrmvz pt13) pt14 (dfrmvz pt14)
pt_1 (inters pt13 (polar pt13 ang1 1000.)
pt10 (polar pt10 ang2 1000.) nil)
ptx (dfrmvz ptx) pt_2 (polar ptx ang2 1000.)
)
(if (and (setq ptx1 (inters pt10 pt14 ptx pt_2 nil))
(setq ptx2 (inters pt_1 pt13 ptx pt_2 nil)))
(progn
(setq en (subst (cons 14 ptx1) (assoc 14 en) en)
en (subst (cons 13 ptx2) (assoc 13 en) en)
)
(entmod en)
)
)
)
)
)
(setvar "dimexo" oexo)
(setvar "dimse1" ose1)
(setvar "dimse2" ose2)
)
)
(princ)
)
页:
[1]