meja 发表于 2023-6-10 20:33:10

贴一个 打断曲线的 源码，差一点点就可以运行

;命令为【TES】可以自己修改，打字注意用英文打字。
(defun c:TES ( / &kw &kw1 ent os ss1 ss2 x)
(vl-load-com)
(setq os (getvar "osmode"))
(princ "\n请选择要被打断的曲线");圆不能被打断于点排除
(if (and (setq &kw (ssget '((0 . "LINE,LWPOLYLINE,ARC,HELIX,ELLIPSE,SPLINE,POLYLINE"))))
          (princ "\n请选择打断曲线")
          (setq &kw1 (ssget '((0 . "LINE,LWPOLYLINE,CIRCLE,ARC,HELIX,ELLIPSE,SPLINE,POLYLINE"))))
   )
(progn;;1
   (setvar "osmode" 0)
   (setq ss1 '())
   (while (setq ent (ssname &kw1 0))
    (setq &kw1 (ssdel ent &kw1) ss1 (cons ent ss1))
   )
   (mapcar '(lambda (x) (vl-catch-all-apply 'ssdel (list x &kw))) ss1);排除重复选择的对象
   (setq ss2 '())
   (while (setq ent (ssname &kw 0))
    (setq &kw (ssdel ent &kw) ss2 (cons ent ss2))
   )
   (while (setq ent (car ss2))
    (setq ss2 (cdr ss2))
    (dxd20 ent ss1)
   )
   (setvar "osmode" os)
);progn
)
(princ)
)

;判断
(defun apd20 (ent p1 / ent p1 pt1 pt2 pt3)
(setq pt1 (vlax-curve-getStartPoint ent) pt2 (vlax-curve-getEndPoint ent) pt3 (vlax-curve-getclosestpointto ent p1))
(if (and (> (distance p1 pt1) 0.0001)
          (> (distance p1 pt2) 0.0001)
          (< (distance p1 pt3) 0.0001)
      )
      pt3
      nil
)
)


;vlax-erased-p
;打断曲线于点
(defun dxd20 (ent1 ss / kkk ent1 ent2 ent3 ent8 n p1 pt1 pt2 ss ss3 ss4 ss5 ss6)
(setq ss5 (list ent1) ent8 (entlast))
(while (setq ent2 (car ss))
(setq ss (cdr ss))
(setq ss4 '() n -1)
(while (setq ent3 (nth (setq n (1+ n)) ss5)) (if (= (vlax-erased-p ent3) nil) (setq ss4 (cons ent3 ss4))))
(setq n -1 ss6 '())
(while (setq ent3 (nth (setq n (1+ n)) ss4));计算出所有点
   (if (vlax-curve-isClosed ent3)
    (setq kkk nil)
    (setq kkk t pt1 (vlax-curve-getStartPoint ent3) pt2 (vlax-curve-getEndPoint ent3))
   )
   (if (setq ss3 (acet-geom-intersectwith ent3 ent2 0))
    (progn
   (while (setq p1 (car ss3))
      (setq ss3 (cdr ss3))
      (if kkk
       (setq ss6 (cons p1 ss6))
       (if (and (> (distance p1 pt1) 0.0001) (> (distance p1 pt2) 0.0001)) (setq ss6 (cons p1 ss6)) )
      )
   );while
    )
   )
)
(while (setq p1 (car ss6))
   (setq ss6 (cdr ss6) ss4 '() n -1)
   (while (setq ent3 (nth (setq n (1+ n)) ss5)) (if (= (vlax-erased-p ent3) nil) (setq ss4 (cons ent3 ss4))))
   (while (setq ent3 (car ss4))
    (setq ss4 (cdr ss4))
    (if (apd20 ent3 p1)
   (progn
      (setq p1 (vlax-curve-getclosestpointto ent3 p1))
      (command "BREAK" (list ent3 p1) p1)
   )
    )
   );while
   (while (setq ent8 (entnext ent8)) (setq ss5 (cons ent8 ss5)) )
   (setq ent8 (entlast))
)
)
)请帮忙处理一下bug

sandyvs 发表于 2023-6-11 08:33:15

有啥bug啊？

小鸟 发表于 2023-6-12 02:40:53

我试了 可以打断，你是怎么用的

meja 发表于 2023-6-12 13:11:13

小鸟 发表于 2023-6-12 02:40
我试了 可以打断，你是怎么用的

你什么版本呢？我在2020下出错！

小鸟 发表于 2023-6-12 18:09:53

meja 发表于 2023-6-12 13:11
你什么版本呢？我在2020下出错！

2018版的

Bao_lai 发表于 2023-6-12 18:18:57

meja 发表于 2023-6-12 13:11
你什么版本呢？我在2020下出错！

可能是高版本command问题 ，改成command-s试试。

meja 发表于 2023-6-12 19:37:23

小鸟 发表于 2023-6-12 02:40
我试了 可以打断，你是怎么用的

输入的字符串有缺陷。不知道哪个地方卡住了，可否整理下发上来

小鸟 发表于 2023-6-12 23:03:31

meja 发表于 2023-6-12 19:37
输入的字符串有缺陷。不知道哪个地方卡住了，可否整理下发上来

你截图看看 ，我试了都可以打断的

meja 发表于 2023-6-18 21:38:06

小鸟 发表于 2023-6-12 23:03
你截图看看 ，我试了都可以打断的

你把你的打包发上来{:1_1:}

小鸟 发表于 2023-6-24 18:45:47

meja 发表于 2023-6-18 21:38
你把你的打包发上来

完全没有改动，直接就可以用了.
页: [1]
查看完整版本: 贴一个 打断曲线的 源码，差一点点就可以运行