求断线程序
在明经找到了一个可以断线的源码,首先谢谢这位朋友分享,这个程序只能断两侧,而我需要一个可以 中间也断的程序,输入两侧去掉的长度,再输入两侧保留的长度,中间部分自动删除,如图所示下面的是图是结果,请老师帮我改下,谢谢!(defun dxf (grc lst)(cdr (assoc grc lst))
)
(defun c:tt (/ ent_bd l len cx js ename elist entna st ed dis st1 ed1 ange angs sy tc)
(prompt "\n选择需要打断的线：")
(setq ent_bd (car (cdr (ssgetfirst))))
(while (= ent_bd nil) (setq ent_bd (ssget '((0 . "LINE")))))
(setvar "osmode" 0)
(setq l (getdist "\n两端需要断开的长度:<10>"))
(if (= l "")
(setq l 10)
)
(if (= l nil)
(setq l 10)
)
(setq sy (getstring "\n是否保留两端断开线段？[是-Y][否-N]<Y>:"))
(if (= sy "")
(setq sy "Y")
)
(setq len (sslength ent_bd))
(setq cx 0)
(setq js 0)
(repeat len
(setq ename (ssname ent_bd cx))
(setq elist (entget ename))
(setq entna (dxf 0 elist))
(if (= entna "LINE")
(progn (setq st (dxf 10 elist))
(setq ed (dxf 11 elist))
(setq dis (distance st ed))
(setq tc (dxf 8 elist))
(setq angs (angle st ed))
(setq st1 (polar st angs l))
(setq bj0 (polar st1 (+ angs (/ pi 2)) 1.5))
(setq bj1 (polar st1 (+ angs (/ pi 2) pi) 1.5))
(setq ange (angle ed st))
(setq ed1 (polar ed ange l))
(setq bj2 (polar ed1 (+ angs (/ pi 2)) 1.5))
(setq bj3 (polar ed1 (+ angs (/ pi 2) pi) 1.5))
(entdel ename)
(if (or (= sy "Y") (= sy "y"))
(progn (entmake (list (cons 0 "LINE")
(cons 8 tc)
(cons 10 st)
(cons 11 st1)
)
)
(entmake (list (cons 0 "LINE")
(cons 8 tc)
(cons 10 st1)
(cons 11 ed1)
)
)
(entmake (list (cons 0 "LINE")
(cons 8 tc)
(cons 10 ed1)
(cons 11 ed)
)
)
(entmake (list (cons 0 "LINE")
(cons 8 tc)
(cons 10 bj0)
(cons 11 bj1)
)
)
(entmake (list (cons 0 "LINE")
(cons 8 tc)
(cons 10 bj2)
(cons 11 bj3)
)
)
)
)
(if (or (= sy "N") (= sy "n"))
(entmake (list (cons 0 "LINE")
(cons 8 tc)
(cons 10 st1)
(cons 11 ed1)
)
)
)
(setq js (+ js 1))
)
)
(setq cx (+ cx 1))
)
(princ)
)
本帖最后由 xyp1964 于 2025-3-2 14:17 编辑
xyp1964 发表于 2025-3-2 12:16
非常感谢老师!
页:
[1]