多段线，圆，弧，直线，曲线相交点打断。大量的话速度比较慢，希望大神优化

陈进佳 · 发表于 2016-1-1 19:50:48

(defun tt (ss0 ss1 / e1 e2 @pt2 pt1 ptn)
(vl-load-com)
(setq ptn '())
(setq e1 (vlax-ename->vla-object ss0)
e2 (vlax-ename->vla-object ss1)
)
(setq @pt2 (vlax-invoke e1 'IntersectWith e2 0))
(repeat (/ (length @pt2) 3)
(setq pt1 (list (car @pt2) (cadr @pt2) (caddr @pt2)))
(setq @pt2 (cdddr @pt2))
(setq ptn (cons pt1 ptn))
)
(reverse ptn)
)
(defun enjddd (ent ptlst / e entlst id tement tempt pt l)
(if (= (cdr (assoc 0 (entget ent))) "CIRCLE")
(progn
(setq
l (+ (angle (cdr (assoc 10 (entget ent))) (car ptlst)) 0.00000001)
)
(setq pt (polar (cdr (assoc 10 (entget ent)))
l
(cdr (assoc 40 (entget ent)))
)
)
(command "break" ent (car ptlst) pt)
)
)
(setq entlst (cons ent entlst)
id (entlast)
)
(while (setq tempt (car ptlst))
(foreach e entlst
(command "BREAK" e tempt tempt)
(if (setq tement (entnext id))
(setq entlst (cons tement entlst)
id tement
)
)
)
(setq ptlst (cdr ptlst))
)
)
(defun c:tr (/ ss1 ssn ssm i j k ssc ptlst ptls)
(vl-load-com)
(setq ptlst nil
ptls nil
ol(getvar "osmode")
ss1 (ssget)
i -1
)
(setvar "osmode" 0)
(while (setq ssn (ssname ss1 (setq i (1+ i))))
(setq j 0)
(setq ptlst nil)
(repeat (sslength ss1)
(setq ssm (ssname ss1 j)
ptlst (append (tt ssn ssm) ptlst)
j (1+ j)
)
)
(setq ptls (cons ptlst ptls))
)
(setq ptls (reverse ptls))
(setq k 0)
(while (setq ssc (ssname ss1 k))
(enjddd ssc (nth k ptls))
(setq k (1+ k))
)
(setvar "osmode" 0)
)

(defun tt (ss0 ss1 / e1 e2 @pt2 pt1 ptn) 
  (vl-load-com) 
  (setq ptn '()) 
  (setq  e1 (vlax-ename->vla-object ss0) 
  e2 (vlax-ename->vla-object ss1) 
  ) 
  (setq @pt2 (vlax-invoke e1 'IntersectWith e2 0)) 
  (repeat (/ (length @pt2) 3) 
    (setq pt1 (list (car @pt2) (cadr @pt2) (caddr @pt2))) 
    (setq @pt2 (cdddr @pt2)) 
    (setq ptn (cons pt1 ptn)) 
  ) 
  (reverse ptn) 
) 
(defun enjddd (ent ptlst / e entlst id tement tempt pt l) 
  (if (= (cdr (assoc 0 (entget ent))) "CIRCLE") 
    (progn 
      (setq 
  l (+ (angle (cdr (assoc 10 (entget ent))) (car ptlst)) 0.00000001) 
      ) 
      (setq pt (polar (cdr (assoc 10 (entget ent))) 
          l 
          (cdr (assoc 40 (entget ent))) 
         ) 
      ) 
      (command "break" ent (car ptlst) pt) 
       
      ) 
    
  ) 
   
 
  (setq  entlst (cons ent entlst) 
  id     (entlast) 
  ) 
  (while (setq tempt (car ptlst)) 
    (foreach e entlst 
      (command "BREAK" e tempt tempt) 
      (if (setq tement (entnext id)) 
  (setq entlst (cons tement entlst) 
        id     tement 
  ) 
      ) 
    ) 
    (setq ptlst (cdr ptlst)) 
  ) 
) 
(defun c:tr (/ ss1 ssn ssm i j k ssc ptlst ptls) 
  (vl-load-com) 
  (setq  ptlst nil 
  ptls  nil 
  ol(getvar "osmode") 
   
  ss1   (ssget) 
  i     -1 
  ) 
  (setvar "osmode" 0) 
  (while (setq ssn (ssname ss1 (setq i (1+ i)))) 
    (setq j 0) 
    (setq ptlst nil) 
    (repeat (sslength ss1) 
      (setq ssm    (ssname ss1 j) 
      ptlst (append (tt ssn ssm) ptlst) 
      j    (1+ j) 
      ) 
    ) 
    (setq ptls (cons ptlst ptls)) 
  ) 
  (setq ptls (reverse ptls)) 
  (setq k 0) 
  (while (setq ssc (ssname ss1 k)) 
    (enjddd ssc (nth k ptls)) 
    (setq k (1+ k)) 
  ) 
  (setvar "osmode" 0) 
)

尘缘一生 · 发表于 2022-5-5 01:08:38

本帖最后由尘缘一生于 2022-5-5 01:23 编辑

速度问题，就是用的COMMAND 原因，抛弃command 程序会写很长，本坛有部分代码，我整合过，整理下，并没有解决速度问题。
http://bbs.mjtd.com/thread-185383-1-1.html

;选择集交点断开 modify by 尘缘一生 QQ:15290049
;;两实体（en1 en2）为实体名 -------交点------(一级)----------------
;;k:（0--不延伸,1--延伸基本对象,2--延伸参数传递的对象,3--延伸)
(defun sl-Curveinters (en1 en2 k / pl pts)
(setq pl (vlax-invoke (vlax-ename->vla-object en1) 'IntersectWith (vlax-ename->vla-object en2) k))
(while pl
(setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
pl (cdr (cdr (cdr pl)))
)
)
pts
)
;;实体与其交点打断--------(一级)------------
(defun break_obj (ent brkptlst / brkobjlst en tp maxparam closedobj minparam obj obj2break p1param p2 p2param)
(setq obj2break ent brkobjlst (list ent) tp (cdr (assoc 0 (entget ent))))
(foreach brkpt brkptlst
(if brkobjlst
(progn
(if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break brkpt))))
(foreach obj brkobjlst
(if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj brkpt)))
(setq obj2break obj)
)
)
)
)
)
;;---------------------------------
(cond
((and (= "SPLINE" tp)
(vlax-curve-isclosed obj2break))
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
)
(command "._break" obj2break (trans brkpt 0 1) (trans p2 0 1))
)
((= "CIRCLE" tp)
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
)
(command "._break" obj2break (trans brkpt 0 1) (trans p2 0 1))
(setq tp "ARC")
)
((and (= "ELLIPSE" tp) (vlax-curve-isclosed obj2break))
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2param (+ p1param 0.000001)
minparam (min p1param p2param)
maxparam (max p1param p2param)
obj (vlax-ename->vla-object obj2break)
)
(vlax-put obj 'startparameter maxparam)
(vlax-put obj 'endparameter (+ minparam 2pi))
)
(t
(setq closedobj (vlax-curve-isclosed obj2break))
(command "._break" obj2break (trans brkpt 0 1) (trans brkpt 0 1))
(if (not closedobj)
(setq brkobjlst (cons (entlast) brkobjlst))
)
)
)
)
)
;;主程序------------------
;支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
(defun c:tr (/ ss1 ssn ssm i j k ssc ptlst ptls)
(vl-load-com)
(prompt "\n 支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
(setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(setq ptlst nil ptls nil ol (getvar "osmode") i -1)
(setvar "osmode" 0)
(while (setq ssn (ssname ss1 (setq i (1+ i))))
(setq j 0)
(setq ptlst nil)
(repeat (sslength ss1)
(setq ssm (ssname ss1 j)
ptlst (append (sl-Curveinters ssn ssm 0) ptlst)
j (1+ j)
)
)
(setq ptls (cons ptlst ptls))
)
(setq ptls (reverse ptls))
(setq k 0)
(while (setq ssc (ssname ss1 k))
(break_obj ssc (nth k ptls))
(setq k (1+ k))
)
(setvar "osmode" 0)
)

;选择集交点断开  modify by 尘缘一生  QQ:15290049 
 
;;两实体（en1 en2） 为实体名 -------交点------(一级)---------------- 
;;k:（0--不延伸,1--延伸基本对象,2--延伸参数传递的对象,3--延伸) 
(defun sl-Curveinters (en1 en2 k / pl pts) 
  (setq pl (vlax-invoke (vlax-ename->vla-object en1) 'IntersectWith (vlax-ename->vla-object en2) k))   
  (while pl 
    (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl)))) 
      pl (cdr (cdr (cdr pl))) 
    ) 
  ) 
  pts 
) 
;;实体与其交点打断--------(一级)------------ 
(defun break_obj (ent brkptlst / brkobjlst en tp maxparam closedobj minparam obj obj2break p1param p2 p2param) 
  (setq obj2break ent brkobjlst (list ent) tp (cdr (assoc 0 (entget ent)))) 
  (foreach brkpt brkptlst 
    (if brkobjlst 
      (progn 
        (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break brkpt)))) 
          (foreach obj brkobjlst 
            (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj brkpt))) 
              (setq obj2break obj) 
            ) 
          ) 
        ) 
      ) 
    ) 
    ;;--------------------------------- 
    (cond 
      ((and (= "SPLINE" tp) 
         (vlax-curve-isclosed obj2break)) 
        (setq p1param (vlax-curve-getparamatpoint obj2break brkpt) 
          p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001)) 
        ) 
        (command "._break" obj2break (trans brkpt 0 1) (trans p2 0 1)) 
      ) 
      ((= "CIRCLE" tp) 
        (setq p1param (vlax-curve-getparamatpoint obj2break brkpt) 
          p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001)) 
        ) 
        (command "._break" obj2break (trans brkpt 0 1) (trans p2 0 1)) 
        (setq tp "ARC") 
      ) 
      ((and (= "ELLIPSE" tp) (vlax-curve-isclosed obj2break)) 
        (setq p1param  (vlax-curve-getparamatpoint obj2break brkpt) 
          p2param  (+ p1param 0.000001) 
          minparam (min p1param p2param) 
          maxparam (max p1param p2param) 
          obj (vlax-ename->vla-object obj2break) 
        ) 
        (vlax-put obj 'startparameter maxparam) 
        (vlax-put obj 'endparameter (+ minparam 2pi)) 
      ) 
      (t    
        (setq closedobj (vlax-curve-isclosed obj2break)) 
        (command "._break" obj2break (trans brkpt 0 1) (trans brkpt 0 1)) 
        (if (not closedobj) 
          (setq brkobjlst (cons (entlast) brkobjlst)) 
        ) 
      ) 
    ) 
  ) 
) 
;;主程序------------------ 
;支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" 
(defun c:tr (/ ss1 ssn ssm i j k ssc ptlst ptls) 
  (vl-load-com) 
  (prompt "\n 支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE") 
  (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) 
  (setq ptlst nil ptls nil ol (getvar "osmode") i -1) 
  (setvar "osmode" 0) 
  (while (setq ssn (ssname ss1 (setq i (1+ i)))) 
    (setq j 0) 
    (setq ptlst nil) 
    (repeat (sslength ss1) 
      (setq ssm (ssname ss1 j) 
        ptlst (append (sl-Curveinters ssn ssm 0) ptlst) 
        j (1+ j) 
      ) 
    ) 
    (setq ptls (cons ptlst ptls)) 
  ) 
  (setq ptls (reverse ptls)) 
  (setq k 0) 
  (while (setq ssc (ssname ss1 k)) 
    (break_obj ssc (nth k ptls)) 
    (setq k (1+ k)) 
  ) 
  (setvar "osmode" 0) 
)

ZJKUSO · 发表于 2022-5-30 09:45:10

尘缘一生发表于 2022-5-5 01:08
速度问题，就是用的COMMAND 原因，抛弃command 程序会写很长，本坛有部分代码，我整合过，整理下，并没有解 ...

能添加打断后删除吗？

类似下面这样

wu112031853 · 发表于 2016-1-12 20:56:18

厉害！！！！

唯寻 · 发表于 2016-2-21 10:19:46

真是太牛了

haotaer · 发表于 2016-2-24 17:12:33

高手出手那纯属娱乐。只是热心帮忙

凡海涛在石大 · 发表于 2016-4-10 23:14:11

请问出现这个no function definition: XLR_JDLB_SS，该怎么解决

陈进佳 · 发表于 2016-4-11 23:20:52

凡海涛在石大发表于 2016-4-10 23:14
请问出现这个no function definition: XLR_JDLB_SS，该怎么解决

回复错地方了

香远益清 · 发表于 2019-12-24 17:09:29

真是太牛了,高手出手那纯属娱乐。只是热心帮忙

小小的人 · 发表于 2020-5-4 21:13:12

太厉害了终于找到了我之前找到的只能打断直线现在这个很全面很好用

陈进佳 · 发表于 2020-9-20 16:23:52

小小的人发表于 2020-5-4 21:13
太厉害了终于找到了我之前找到的只能打断直线现在这个很全面很好用

999999 · 发表于 2020-12-10 13:11:42

顶起，上班时试一试

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

多段线，圆，弧，直线，曲线相交点打断。大量的话速度比较慢，希望大神优化

本帖子中包含更多资源