求老师帮忙改个断线程序

shirker · 发表于 2025-3-2 13:02:16

在明经找到了一个可以断线的源码,首先谢谢这位朋友分享,这个程序只能断两侧,而我需要一个可以中间也断的程序,输入两侧去掉的长度,再输入两侧保留的长度,中间部分自动删除,如图所示下面的是图是结果,请老师帮我改下,谢谢!

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

shirker · 发表于 2025-3-2 16:33:41

问题已经解决了,麻烦版主帮忙删下贴,谢谢!

账号		自动登录	找回密码
密码			注册