直线两端变断线

xiao88gang 发表于 2017-10-10 19:48:47

这是一个可以把一条直线两端变断线的程序，并标记。为什么一直提示错误。请高手帮忙给看看。

(defun C:TT (/ ENT_BD    L LEN CX JS    ENAME ELIST
ENTNA ST ED    DIS ST1 ED1 ANGEANGS 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 T@33)
      (cons 10 BJ0)
      (cons 11 BJ1)
      )
      )
      (ENTMAKE (LIST (cons 0 "LINE")
      (cons 8 T@33)
      (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)
)

vectra 发表于 2017-10-10 20:26:52

(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)
)

补了个函数改了两个变量能用了不知道是不是这个意思

yoyoho 发表于 2017-10-11 06:12:48

感谢分享及修正程序!!!!!

xyp1964 发表于 2017-10-11 13:14:23

;; tt(直线两端定距打断)
(defun c:tt ()
(setq d0 (Udist 7 "" "两端需要断开的长度<输入或鼠标直接量取>" d0 nil))
(setq sy (Ukword 1 "Y N" "保留两端断开线段: Y-保留/N-删除" sy))
(setq i -1)
(princ "\n选择需要打断的线: ")
(if (setq ss (ssget '((0 . "line"))))
(while (setq s1 (ssname ss (setq i (1+ i))))
   (setq p1 (xyp-DXF 10 s1)
   p2 (xyp-DXF 11 s1)
   ll (distance p1 p2)
   )
   (if (> ll (* d0 2))
(progn
   (setq rad (angle p1 p2)
p11 (polar p1 rad d0)
p22 (polar p2 rad (- d0))
   )
   (if (= sy "Y")
   (foreach pt (list p22 p11) (xyp-breakE s1 pt pt))
   (progn
      (xyp-breakE s1 p2 p22)
      (xyp-breakE s1 p11 p1)
   )
   )
)
   )
)
)
(princ)
)

xiao88gang 发表于 2017-10-13 16:17:38

vectra 发表于 2017-10-10 20:26
补了个函数改了两个变量能用了不知道是不是这个意思

谢谢大师的帮忙，太完美了。

xiao88gang 发表于 2017-10-13 16:28:32

xyp1964 发表于 2017-10-11 13:14
;; tt(直线两端定距打断)
(defun c:tt ()
(setq d0 (Udist 7 "" "两端需要断开的长度" d0 nil))

谢谢，挺好用的。

pengfei2010 发表于 2017-10-16 08:55:36

回帖是一种美德！感谢楼主的无私分享谢谢

fsafaffa 发表于 2017-10-17 09:58:22

路过，顶一下

thomaslai 发表于 2018-8-7 15:37:55

本帖最后由 thomaslai 于 2018-8-8 10:35 编辑

vectra 发表于 2017-10-10 20:26
补了个函数改了两个变量能用了不知道是不是这个意思
请问大师能否打断后选取被打断的线段或者自动换图层呢??

页: [1]

明经CAD社区's Archiver

直线两端变断线