借用三维命令打断相交线（样条线 多段线 直线 圆 椭圆适用）

guosheyang

给朋友们分享优化后的交点打断程序，借用三维命令实现，速度也过得去，关键是打断结果准确（与breakall插件比），可以将打断后的结果直接用region命令生成单独的封闭图元（拓扑多边形对应的面域单元）；17版CAD中测试通过，建议高版本适用。

;功能：借用三维命令打断相交线（样条线 多段线 直线 圆 椭圆适用）
;参数：ss 需要打断的相交曲线选择集（注意 不能有自相交线）      

;(ygs_brk_int_cur(setq ss(ssget)))
(defun ygs_brk_int_cur(ss / JX PT SJD SZ UN_SURF YSD YXD ZSD ZXD ZXYS)
(setvar 'cmdecho 0)
(setq sz(getvar  'surfacemodelingmode))
(if(= sz 1)
    (command "_.extrude""MO""SU" ss "" 2 """"
            "_.union" (ssget "A" '((0 . "NURBSURFACE"))) "")
    (command "_.extrude""MO""SU" ss "" 2 """"
           "_.union" (ssget "A" '((0 . "EXTRUDEDSURFACE"))) "")
)
(setq  un_surf(entlast)
        zxys(LM:ssboundingbox ss)  
        zxd(list(-(car (car zxys))100)(-(cadr (car zxys))100)0)
        ysd(list(+(car (cadr zxys))100)(+(cadr (cadr zxys))100)0)
        zsd(list(car zxd)(cadr ysd)0)
        yxd(list(car ysd)(cadr zxd)0)
        sjd(list zxd yxd ysd zsd));四角点
(entmakex(append (list '(0 . "LWPOLYLINE")
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbPolyline")
                          '(62 . 0)
                          (cons 90 (length sjd))
                          (cons 70 1)
                   )
                   (mapcar '(lambda (pt) (cons 10 pt)) sjd)
         )
)
(command "_.REGION"
         (setq jx(entlast))
        ""
        "_.intersect"
           (entlast)
           un_surf
        ""
   "_.erase" ss ""
)
  (entdel jx)
  (princ)
)
;选择集包围盒 -Lee Mac
(defun LM:ssboundingbox(sel / idxllp ls1 ls2 obj urp)
    (repeat (setq idx(sslength sel))
        (setq obj (vlax-ename->vla-object(ssname sel(setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (cons (vlax-safearray->list llp) ls1)
                  ls2 (cons (vlax-safearray->list urp) ls2)
            )
        )
    )
    (if (and ls1 ls2)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
    )
)

ynhh

原来是羊羊羊大师
感觉您到三维方面很有研究
能不能请您看看
http://bbs.mjtd.com/thread-184565-1-1.html
之前回复的这个
;_栏选起点，切面1第一点pt1
;_栏选终点，切面1第二点pt2
感觉操作不太方便
能不能请您看看，只是选取三维圆管时，就可画出其轴线，或得到轴线上任意两点
谢谢。

尘缘一生

试了试，怎么总弹出个对话框，要加载个什么。。。。。

guosheyang

尘缘一生 发表于 2022-4-29 22:49
试了试，怎么总弹出个对话框，要加载个什么。。。。。

请问你用的啥版本的？

尘缘一生

guosheyang 发表于 2022-4-29 23:43
请问你用的啥版本的？

WIN7 64位  CAD2020 调出的是 APPLOAD对话框

guosheyang

尘缘一生 发表于 2022-4-29 23:46
WIN7 64位  CAD2020 调出的是 APPLOAD对话框

试下这个看看
;(ygs_brk_int_cur(setq ss(ssget)))
(defun ygs_brk_int_cur(ss / PT SJD UN_SURF YSD YXD ZSD ZXD ZXYS)
  (setvar 'cmdecho 0)
  (vl-cmdf "extrude" "MO" "SU" ss "" 2 "" "")
  (vl-cmdf "union" (ssget "A" '((0 . "EXTRUDEDSURFACE"))) "")
  (setq        un_surf(entlast)
        zxys(LM:ssboundingbox ss)  
        zxd(list(-(car (car zxys))100)(-(cadr (car zxys))100)0)
        ysd(list(+(car (cadr zxys))100)(+(cadr (cadr zxys))100)0)
        zsd(list(car zxd)(cadr ysd)0)
        yxd(list(car ysd)(cadr zxd)0)
        sjd(list zxd yxd ysd zsd));四角点
(entmakex(append (list '(0 . "LWPOLYLINE")
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbPolyline")
                          '(62 . 0)
                          (cons 90 (length sjd))
                          (cons 70 1)
                   )
                   (mapcar '(lambda (pt) (cons 10 pt)) sjd)
            )
  )
  (vl-cmdf "region"
           (entlast)
           "" )
  (vl-cmdf"_intersect"
           (entlast)
           un_surf
           "" )
(vl-cmdf "erase" ss ""
  )
)
;选择集包围盒 -Lee Mac
(defun LM:ssboundingbox(sel / idxllp ls1 ls2 obj urp)
    (repeat (setq idx(sslength sel))
        (setq obj (vlax-ename->vla-object(ssname sel(setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (cons (vlax-safearray->list llp) ls1)
                  ls2 (cons (vlax-safearray->list urp) ls2)
            )
        )
    )
    (if (and ls1 ls2)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
    )
)

尘缘一生

guosheyang 发表于 2022-4-30 00:07
试下这个看看
;(ygs_brk_int_cur(setq ss(ssget)))
(defun ygs_brk_int_cur(ss / PT SJD UN_SURF YSD Y ...

在最后的删除部分，我改了下可以了，
先断开自交线，圆弧转多段线后，扩展下，觉得应该很不错，速度可以。等找下判断自交线代码有没有。

2. ;功能：借用三维命令打断相交线（样条线 多段线 直线 圆 椭圆适用）
   
3. ;参数：ss 需要打断的相交曲线选择集（注意 不能有自相交线）      
   
4. (defun c:tt ()
   
5.   (setq ss (ssget '((0 . "LINE,*POLYLINE,ARC,CIRCLE,SPLINE,ELLIPSE"))))
   
6.   (ygs_brk_int_cur ss)
   
7. )
   
8. ;;-------------------------
   
9. (defun ygs_brk_int_cur(ss / PT SJD UN_SURF YSD YXD ZSD ZXD ZXYS)
   
10.   (setvar 'cmdecho 0)
    
11.   (vl-cmdf "extrude" "MO" "SU" ss "" 2 "" "")
    
12.   (vl-cmdf "union" (ssget "A" '((0 . "EXTRUDEDSURFACE"))) "")
    
13.   (setq un_surf (entlast)
    
14.     zxys(LM:ssboundingbox ss)  
    
15.     zxd(list(-(car (car zxys))100)(-(cadr (car zxys))100)0)
    
16.     ysd(list(+(car (cadr zxys))100)(+(cadr (cadr zxys))100)0)
    
17.     zsd(list(car zxd)(cadr ysd)0)
    
18.     yxd(list(car ysd)(cadr zxd)0)
    
19.     sjd(list zxd yxd ysd zsd)
    
20.   );四角点
    
21.   (entmakex
    
22.     (append
    
23.       (list
    
24.         '(0 . "LWPOLYLINE")
    
25.         '(100 . "AcDbEntity")
    
26.         '(100 . "AcDbPolyline")
    
27.         '(62 . 0)
    
28.         (cons 90 (length sjd))
    
29.         (cons 70 1)
    
30.       )
    
31.       (mapcar '(lambda (pt) (cons 10 pt)) sjd)
    
32.     )
    
33.   )
    
34.   (vl-cmdf "region" (entlast) "")
    
35.   (vl-cmdf "_intersect" (entlast) un_surf "")
    
36.   (sl:-erase ss)
    
37. )
    
38. ;;ss:实体、选择集或表删除-----（一级）---------
    
39. (defun sl:-erase (ss / n)
    
40.   (cond
    
41.     ((= (type ss) 'ENAME) (entdel ss))
    
42.     ((= (type ss) 'VLA-OBJECT) (vla-erase ss))
    
43.     ((and (= (type ss) 'PICKSET) (> (sslength ss) 0))
    
44.       (repeat (setq n (sslength ss))
    
45.         (entdel (ssname ss (setq n (1- n))))
    
46.       )
    
47.     )
    
48.     ((= (type ss) 'LIST)
    
49.       (foreach s1 ss (sl:-erase s1))
    
50.     )
    
51.   )
    
52. )
    
53. ;选择集包围盒 -Lee Mac
    
54. (defun LM:ssboundingbox(sel / idxllp ls1 ls2 obj urp)
    
55.   (repeat (setq idx(sslength sel))
    
56.     (setq obj (vlax-ename->vla-object(ssname sel(setq idx (1- idx)))))
    
57.     (if (and (vlax-method-applicable-p obj 'getboundingbox)
    
58.           (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
    
59.         )
    
60.       (setq ls1 (cons (vlax-safearray->list llp) ls1)
    
61.         ls2 (cons (vlax-safearray->list urp) ls2)
    
62.       )
    
63.     )
    
64.   )
    
65.   (if (and ls1 ls2)
    
66.     (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
    
67.   )
    
68. )

;功能：借用三维命令打断相交线（样条线 多段线 直线 圆 椭圆适用）<br /> ;参数：ss 需要打断的相交曲线选择集（注意 不能有自相交线）      <br /> (defun c:tt ()<br />   (setq ss (ssget '((0 . "LINE,*POLYLINE,ARC,CIRCLE,SPLINE,ELLIPSE"))))<br />   (ygs_brk_int_cur ss)<br /> )<br /> ;;-------------------------<br /> (defun ygs_brk_int_cur(ss / PT SJD UN_SURF YSD YXD ZSD ZXD ZXYS)<br />   (setvar 'cmdecho 0)<br />   (vl-cmdf "extrude" "MO" "SU" ss "" 2 "" "")<br />   (vl-cmdf "union" (ssget "A" '((0 . "EXTRUDEDSURFACE"))) "")<br />   (setq un_surf (entlast)<br />     zxys(LM:ssboundingbox ss)  <br />     zxd(list(-(car (car zxys))100)(-(cadr (car zxys))100)0)<br />     ysd(list(+(car (cadr zxys))100)(+(cadr (cadr zxys))100)0)<br />     zsd(list(car zxd)(cadr ysd)0)<br />     yxd(list(car ysd)(cadr zxd)0)<br />     sjd(list zxd yxd ysd zsd)<br />   );四角点<br />   (entmakex<br />     (append <br />       (list <br />         '(0 . "LWPOLYLINE")<br />         '(100 . "AcDbEntity")<br />         '(100 . "AcDbPolyline")<br />         '(62 . 0)<br />         (cons 90 (length sjd))<br />         (cons 70 1)<br />       )<br />       (mapcar '(lambda (pt) (cons 10 pt)) sjd)<br />     )<br />   )<br />   (vl-cmdf "region" (entlast) "")<br />   (vl-cmdf "_intersect" (entlast) un_surf "")<br />   (sl:-erase ss)<br /> )<br /> ;;ss:实体、选择集或表删除-----（一级）---------<br /> (defun sl:-erase (ss / n)<br />   (cond<br />     ((= (type ss) 'ENAME) (entdel ss))<br />     ((= (type ss) 'VLA-OBJECT) (vla-erase ss))<br />     ((and (= (type ss) 'PICKSET) (> (sslength ss) 0))<br />       (repeat (setq n (sslength ss))<br />         (entdel (ssname ss (setq n (1- n))))<br />       )<br />     )<br />     ((= (type ss) 'LIST)<br />       (foreach s1 ss (sl:-erase s1))<br />     )<br />   )<br /> )<br /> ;选择集包围盒 -Lee Mac<br /> (defun LM:ssboundingbox(sel / idxllp ls1 ls2 obj urp)<br />   (repeat (setq idx(sslength sel))<br />     (setq obj (vlax-ename->vla-object(ssname sel(setq idx (1- idx)))))<br />     (if (and (vlax-method-applicable-p obj 'getboundingbox)<br />           (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))<br />         )<br />       (setq ls1 (cons (vlax-safearray->list llp) ls1)<br />         ls2 (cons (vlax-safearray->list urp) ls2)<br />       )<br />     )<br />   )<br />   (if (and ls1 ls2)<br />     (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))<br />   )<br /> )

guosheyang

尘缘一生 发表于 2022-4-30 06:22
在最后的删除部分，我改了下可以了，
先断开自交线，圆弧转多段线后，扩展下，觉得应该很不错，速度可以 ...

嗯 首先要处理掉 自交线 pl线炸开  spl 线 自交的也要 先处理   因为是调用 command  不同版本 可能有区别 能调的可用  就可以了   祝贺！

guosheyang

尘缘一生 发表于 2022-4-30 06:22
在最后的删除部分，我改了下可以了，
先断开自交线，圆弧转多段线后，扩展下，觉得应该很不错，速度可以 ...

圆 圆弧 椭圆  椭圆弧 样条线  不用转多段线  带圆弧的多段线也适用   

尘缘一生

guosheyang 发表于 2022-4-30 16:17
圆 圆弧 椭圆  椭圆弧 样条线  不用转多段线  带圆弧的多段线也适用

我试了，自交的样条曲线，还是不行的。

代码没完成，先保留这里备用。判断SPLINE自交没有找到函数，不判断，直接转PLINE为PLIN，代码看太繁杂，还没修改好。

2. ;打断相交线----------------   
   
3. (defun c:tt (/ ss ss1 ss2 nam n i obj tp e_lst temp xk)
   
4.   (setq e_lst (sysvar '("osmode" "cmdecho" "PELLIPSE" "CLAYER" "peditaccept")) ss1 (ssadd))
   
5.   (setvar "CMDECHO" 0) (setvar "OSMODE" 0) (setvar "peditaccept" 1)
   
6.   (setq ss (ssget '((0 . "LINE,*POLYLINE,ARC,CIRCLE,SPLINE,ELLIPSE,REGION"))))
   
7.   (repeat (setq n (sslength ss))
   
8.     (setq nam (ssname ss (setq n (1- n))) tp (dxf1 nam 0) obj (en2obj nam))
   
9.     (cond
   
10.       ((= tp "ARC")
    
11.         (command "pedit" nam "w" 0 "")
    
12.         (ssdel nam ss)
    
13.         (ssadd (entlast) ss1)
    
14.       )
    
15.       ((= tp "SPLINE")
    
16.         (command "pedit" nam 10 "w" 0 "")
    
17.         (ssdel nam ss)
    
18.         (ssadd (entlast) ss1)
    
19.       )
    
20.       ((= tp "REGION")
    
21.         (setq xk (linwind nam))
    
22.         (reg2pline nam)
    
23.         (vla-put-ConstantWidth (en2obj (entlast)) xk)
    
24.         (ssdel nam ss)
    
25.         (ssadd (entlast) ss1)
    
26.       )
    
27.       ((or (= tp "POLYLINE")
    
28.          (and (= tp "LWPOLYLINE" tp) (= (_polyselfintersect-p obj) t)) ;自交
    
29.        )
    
30.         (setq xk (linwind nam))
    
31.         (setq temp (entlast))
    
32.         (vla-explode obj)
    
33.         (vla-delete obj)
    
34.         (setq ss2 (last_ent temp))
    
35.         (repeat (setq i (sslength ss2))
    
36.           (vla-put-ConstantWidth (en2obj (ssname ss2 (setq i (1- i)))) xk)
    
37.         )
    
38.         (ssdel nam ss)
    
39.         (setq ss2 (last_ent temp))
    
40.       )
    
41.     )
    
42.   )
    
43.   (ygs_brk_int_cur (sl:pickset-join (sl:pickset-join ss1 ss1) ss))
    
44.   (mapcar 'eval e_lst)
    
45. )

;打断相交线----------------    <br /> (defun c:tt (/ ss ss1 ss2 nam n i obj tp e_lst temp xk)<br />   (setq e_lst (sysvar '("osmode" "cmdecho" "PELLIPSE" "CLAYER" "peditaccept")) ss1 (ssadd))<br />   (setvar "CMDECHO" 0) (setvar "OSMODE" 0) (setvar "peditaccept" 1) <br />   (setq ss (ssget '((0 . "LINE,*POLYLINE,ARC,CIRCLE,SPLINE,ELLIPSE,REGION"))))<br />   (repeat (setq n (sslength ss))<br />     (setq nam (ssname ss (setq n (1- n))) tp (dxf1 nam 0) obj (en2obj nam))<br />     (cond <br />       ((= tp "ARC")<br />         (command "pedit" nam "w" 0 "")<br />         (ssdel nam ss)<br />         (ssadd (entlast) ss1)<br />       )<br />       ((= tp "SPLINE")<br />         (command "pedit" nam 10 "w" 0 "")<br />         (ssdel nam ss)<br />         (ssadd (entlast) ss1)<br />       )<br />       ((= tp "REGION")<br />         (setq xk (linwind nam))<br />         (reg2pline nam)<br />         (vla-put-ConstantWidth (en2obj (entlast)) xk) <br />         (ssdel nam ss)<br />         (ssadd (entlast) ss1)<br />       )<br />       ((or (= tp "POLYLINE")<br />          (and (= tp "LWPOLYLINE" tp) (= (_polyselfintersect-p obj) t)) ;自交<br />        )<br />         (setq xk (linwind nam))<br />         (setq temp (entlast))<br />         (vla-explode obj)<br />         (vla-delete obj)<br />         (setq ss2 (last_ent temp))<br />         (repeat (setq i (sslength ss2))<br />           (vla-put-ConstantWidth (en2obj (ssname ss2 (setq i (1- i)))) xk)<br />         )<br />         (ssdel nam ss)<br />         (setq ss2 (last_ent temp))<br />       )<br />     )<br />   )<br />   (ygs_brk_int_cur (sl:pickset-join (sl:pickset-join ss1 ss1) ss))<br />   (mapcar 'eval e_lst)<br /> )