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

guosheyang 发表于 2022-4-28 10:37:19

本帖最后由 guosheyang 于 2022-5-4 23:17 编辑

给朋友们分享优化后的交点打断程序，借用三维命令实现，速度也过得去，关键是打断结果准确（与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"))) "")
)
(setqun_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 发表于 2022-4-28 11:32:39

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

尘缘一生 发表于 2022-4-29 22:49:44

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

guosheyang 发表于 2022-4-29 23:43:01

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

请问你用的啥版本的？

尘缘一生 发表于 2022-4-29 23:46:25

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

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

guosheyang 发表于 2022-4-30 00:07:11

尘缘一生发表于 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))
)
)

尘缘一生 发表于 2022-4-30 06:22:53

本帖最后由尘缘一生于 2022-4-30 06:25 编辑

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 ...
在最后的删除部分，我改了下可以了，
先断开自交线，圆弧转多段线后，扩展下，觉得应该很不错，速度可以。等找下判断自交线代码有没有。
;功能：借用三维命令打断相交线（样条线多段线直线圆椭圆适用）
;参数：ss 需要打断的相交曲线选择集（注意不能有自相交线）
(defun c:tt ()
(setq ss (ssget '((0 . "LINE,*POLYLINE,ARC,CIRCLE,SPLINE,ELLIPSE"))))
(ygs_brk_int_cur ss)
)
;;-------------------------
(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 "")
(sl:-erase ss)
)
;;ss:实体、选择集或表删除-----（一级）---------
(defun sl:-erase (ss / n)
(cond
((= (type ss) 'ENAME) (entdel ss))
((= (type ss) 'VLA-OBJECT) (vla-erase ss))
((and (= (type ss) 'PICKSET) (> (sslength ss) 0))
   (repeat (setq n (sslength ss))
   (entdel (ssname ss (setq n (1- n))))
   )
)
((= (type ss) 'LIST)
   (foreach s1 ss (sl:-erase s1))
)
)
)
;选择集包围盒 -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 08:32:24

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

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

guosheyang 发表于 2022-4-30 16:17:27

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

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

尘缘一生 发表于 2022-4-30 18:02:22

本帖最后由尘缘一生于 2022-4-30 18:05 编辑

guosheyang 发表于 2022-4-30 16:17
圆圆弧椭圆椭圆弧样条线不用转多段线带圆弧的多段线也适用
我试了，自交的样条曲线，还是不行的。

代码没完成，先保留这里备用。判断SPLINE自交没有找到函数，不判断，直接转PLINE为PLIN，代码看太繁杂，还没修改好。;打断相交线----------------
(defun c:tt (/ ss ss1 ss2 nam n i obj tp e_lst temp xk)
(setq e_lst (sysvar '("osmode" "cmdecho" "PELLIPSE" "CLAYER" "peditaccept")) ss1 (ssadd))
(setvar "CMDECHO" 0) (setvar "OSMODE" 0) (setvar "peditaccept" 1)
(setq ss (ssget '((0 . "LINE,*POLYLINE,ARC,CIRCLE,SPLINE,ELLIPSE,REGION"))))
(repeat (setq n (sslength ss))
(setq nam (ssname ss (setq n (1- n))) tp (dxf1 nam 0) obj (en2obj nam))
(cond
   ((= tp "ARC")
   (command "pedit" nam "w" 0 "")
   (ssdel nam ss)
   (ssadd (entlast) ss1)
   )
   ((= tp "SPLINE")
   (command "pedit" nam 10 "w" 0 "")
   (ssdel nam ss)
   (ssadd (entlast) ss1)
   )
   ((= tp "REGION")
   (setq xk (linwind nam))
   (reg2pline nam)
   (vla-put-ConstantWidth (en2obj (entlast)) xk)
   (ssdel nam ss)
   (ssadd (entlast) ss1)
   )
   ((or (= tp "POLYLINE")
      (and (= tp "LWPOLYLINE" tp) (= (_polyselfintersect-p obj) t)) ;自交
   )
   (setq xk (linwind nam))
   (setq temp (entlast))
   (vla-explode obj)
   (vla-delete obj)
   (setq ss2 (last_ent temp))
   (repeat (setq i (sslength ss2))
      (vla-put-ConstantWidth (en2obj (ssname ss2 (setq i (1- i)))) xk)
   )
   (ssdel nam ss)
   (setq ss2 (last_ent temp))
   )
)
)
(ygs_brk_int_cur (sl:pickset-join (sl:pickset-join ss1 ss1) ss))
(mapcar 'eval e_lst)
)

页: [1]

明经CAD社区's Archiver

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

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