设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › 源码共享 › 加速>> 批量交点断开!
返回列表 发新帖
查看: 562|回复: 6

加速>> 批量交点断开!

  [复制链接]
尘缘一生
发表于 2024-1-22 22:22 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 2024-1-23 12:33 编辑

批量交点断开，需要加速的，然而这个缺不好加速理想化，目前三领也没有做到全部抛弃BREAK方式。
从前发过几次改写的，应该说，一次次都有提高。

关于这个问题，代码方面也各不相同，怎么合理的规划是个大事，什么样的实体，采取怎么集成处理
三领在使用过程中，也一直在构思优化，下面贴上三领使用的源码，期待更好的优化下去。
  2. ;;交点断开程序----【开始】-----
  3. ;三领设计 V3.0 Modify by 尘缘一声  QQ:15290049
  4. (defun c:sl-break (/ e_lst ss)
  5.   (_undo1)
  6.   (setq e_lst (sysvar '("OSMODE" "CMDECHO" "ORTHOMODE" "DRAWORDERCTL")))
  7.   (setvar "CMDECHO" 0)
  8.   (setvar "OSMODE" 0) ;;捕捉关闭
  9.   (setvar "ORTHOMODE" 0) ;;正交关闭
  10.   (setvar "DRAWORDERCTL" 0)
  11.   (prompt
  12.     (slmsg
  13.       "\n 支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE!"
  14.       "\n や LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE!"
  15.       "\n Support LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE!"
  16.     )
  17.   )
  18.   (prompt
  19.     (slmsg
  20.       "\n 选择交点断开的实体，ENTER 键继续-->:"
  21.       "\n 匡拒ユ翴耞秨龟砰ENTER 龄膥尿-->:"
  22.       "\n Select the entity whose intersection is broken, and press ENTER to continue-->:"
  23.     )
  24.   )
  25.   (if (setq ss (sstoslss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))) ;sstoslss 选择集整理函数,
  26.     (sl_break_with ss t)
  27.   )
  28.   (mapcar 'eval e_lst)
  29.   (_undo2)
  30.   (princ)
  31. )
  32. ;;实体与其交点处断开----(一级)------
  33. ;;nam 实体名 lis 实体上断开点集表(已包含必要的端点)
  34. (defun ssbrkpoint (nam lis / ent lis1 tp namcen objaxis objratio w ly cl lt p0 p1 p2 enlst)
  35.   (setq tp (dxf1 nam 0))
  36.   (cond
  37.     ((member tp '("LWPOLYLINE" "POLYLINE")) ;整合决定此时已是:共线的
  38.       (setq w (linwind nam) ly (dxf1 nam 8) cl (sl-getcolor nam) lt (sl-linetype nam))
  39.       (if (> w 0.0)
  40.         (while (> (length lis) 1)
  41.           (slch:lwpolyline (list (car lis) (cadr lis)) nil w ly cl nil)
  42.           (vla-put-linetype (en2obj (entlast)) lt)
  43.           (setq lis (cdr lis))
  44.         )
  45.         (while (> (length lis) 1)
  46.           (slch:line (car lis) (cadr lis) ly cl nil)
  47.           (vla-put-linetype (en2obj (entlast)) lt)
  48.           (setq lis (cdr lis))
  49.         )
  50.       )
  51.       (entdel nam)
  52.     )
  53.     ((member tp '("LINE" "ARC"))
  54.       (setq
  55.         lis1 lis
  56.         ent (entget nam)
  57.         ent (vl-remove (assoc -1 ent) ent) ;去除图元名
  58.         ent (vl-remove (assoc 330 ent) ent) ;去除id
  59.         ent (vl-remove (assoc 5 ent) ent) ;去除句柄
  60.       )
  61.       (cond
  62.         ((= tp "LINE")
  63.           (while (> (length lis) 1)
  64.             (setq ent (subst (cons 10 (car lis)) (assoc 10 ent) ent))
  65.             (setq ent (subst (cons 11 (cadr lis)) (assoc 11 ent) ent))
  66.             (entmake ent)
  67.             (setq lis (cdr lis))
  68.           )
  69.         )
  70.         ((= tp "ARC")
  71.           (setq namcen (dxf1 ent 10))
  72.           (while (> (length lis) 1)
  73.             (setq ent (subst (cons 50 (angle namcen (cadr lis))) (assoc 50 ent) ent))
  74.             (setq ent (subst (cons 51 (angle namcen (car lis))) (assoc 51 ent) ent))
  75.             (entmake ent)
  76.             (setq lis (cdr lis))
  77.           )
  78.         )
  79.       )
  80.       (if (> (length lis1) 1) (entdel nam))
  81.     )
  82.     (t
  83.       ;;去除端点(此步重要)
  84.       (setq p1 (vlax-curve-getstartpoint nam) p2 (vlax-curve-getendpoint nam))
  85.       (if (equal (car lis) p1 1e-9)
  86.         (setq lis (cdr lis))
  87.       )
  88.       (if (equal (last lis) p2 1e-9)
  89.         (setq lis (reverse (cdr (reverse lis))))
  90.       )
  91.       ;;以上去除端点
  92.       (vl-catch-all-apply 'sl_break_obj (list nam lis))
  93.     )
  94.   )
  95.   (princ)
  96. )
  97. ;;求交点集函数-------------
  98. ;;参数 el (obj1 obj2 obj3)
  99. ;;返回 ((obj1 pt1 pt2...交点n) (obj2 pt1 pt2...交点n)....) ;包含实体端点
  100. (defun ssinter (el / el1 obj1 obj2 ipts pts list1 outlst i j)
  101.   (setq outlst (mapcar 'list el) i -1)
  102.   (while el
  103.     (setq obj1 (car el)
  104.       list1 (nth (setq i (1+ i)) outlst) ;obj1已有的交点列表
  105.       el (cdr el)
  106.       el1 el
  107.       j i
  108.     )
  109.     (while el1
  110.       (setq obj2 (car el1) el1 (cdr el1) j (1+ j))
  111.       (if (and
  112.             (setq ipts (vla-intersectwith obj1 obj2 0))
  113.             (setq ipts (vlax-variant-value ipts))
  114.             (> (vlax-safearray-get-u-bound ipts 1) 0)
  115.           )
  116.         (progn
  117.           (setq ipts (vlax-safearray->list ipts) pts '())  ;obj1,obj2交点临时列表变量
  118.           (while (> (length ipts) 0)
  119.             (setq pts (cons (list (car ipts) (cadr ipts) (caddr ipts)) pts) ipts (cdddr ipts))
  120.           )
  121.           (setq list1 (append list1 pts)) ;存obj1交点表,循环结束后再更新
  122.           (setq outlst (subst (append (nth j outlst) pts) (nth j outlst) outlst));;obj2的交点列表立即更新
  123.         )
  124.       )
  125.     )
  126.     (if (and (cdr list1) (not (vlax-curve-isClosed obj1)))
  127.       (setq list1 (append list1 (list (vlax-curve-getEndPoint obj1)) (list (vlax-curve-getStartPoint obj1))));;当obj1存在交点,且非封闭曲线,添加两端点
  128.     )
  129.     (setq outlst (subst list1 (nth i outlst) outlst));更新obj1交点列表
  130.   )
  131.   outlst
  132. )
  133. ;;点集排序及删除重复点函数---(一级)----
  134. ;;参数 ((obj1 pt1 pt2...交点n) (obj2 pt1 pt2...交点n)....)
  135. ;;返回 ((nam1 pt1 pt2...) (nam2 pt1 pt2...)....)
  136. (defun InterSort (el / obj1 pts plst outlst item)
  137.   (foreach item el
  138.     (setq obj1 (car item) pts (cdr item))
  139.     (if pts
  140.       (progn
  141.         (setq pts (vl-sort pts (function (lambda (p1 p2) (< (vlax-curve-getParamAtPoint obj1 p1) (vlax-curve-getParamAtPoint obj1 p2))))));;交点排序，列表为逆序
  142.         (setq plst (reverse (gps->lst-delsame pts)))
  143.         (if (vlax-curve-isClosed obj1) ;;闭合曲线需再添加首个交点以使新实体完全封闭
  144.           (setq plst (cons (last plst) plst))
  145.         )
  146.         (setq plst (cons (obj2en obj1) plst)
  147.           outlst (cons plst outlst)
  148.         )
  149.       )
  150.     )
  151.   )
  152.   outlst
  153. )
  154. ;;实体与其交点处断开--------(一级)------
  155. ;;nam 实体名  ptlst 实体上交点表(并未包含端点)
  156. (defun sl_break_obj (nam ptlst / enlst p0 p1 p2 tp maxparam minparam obj)
  157.   (setq tp (dxf1 nam 0) enlst (list nam))
  158.   (if (= tp "CIRCLE")
  159.     (progn
  160.       (arccirtopl nam) ;转为2点多段线圆
  161.       (setq nam (entlast))
  162.     )
  163.   )
  164.   (foreach p0 ptlst
  165.     (if enlst
  166.       (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list nam p0))))
  167.         (foreach obj enlst
  168.           (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj p0)))
  169.             (setq nam obj)
  170.           )
  171.         )
  172.       )
  173.     )
  174.     (cond
  175.       ((and (= tp "SPLINE") (vlax-curve-isclosed nam))
  176.         (setq
  177.           p1 (vlax-curve-getparamatpoint nam p0)
  178.           p2 (vlax-curve-getpointatparam nam (+ p1 0.000001))
  179.         )
  180.         (command "._break" nam "_non" (trans p0 0 1) "_non" (trans p2 0 1))
  181.       )
  182.       ((and (= tp "ELLIPSE") (vlax-curve-isclosed nam))
  183.         (setq
  184.           p1 (vlax-curve-getparamatpoint nam p0)
  185.           p2 (+ p1 0.000001)
  186.           minparam (min p1 p2)
  187.           maxparam (max p1 p2)
  188.           obj (en2obj nam)
  189.         )
  190.         (vlax-put obj 'startparameter maxparam)
  191.         (vlax-put obj 'endparameter (+ minparam 2pi))
  192.       )
  193.       (t
  194.         (command "._break" nam "_non" (trans p0 0 1) "_non" (trans p0 0 1))
  195.         (if (not (vlax-curve-isclosed nam))
  196.           (setq enlst (cons (entlast) enlst))
  197.         )
  198.       )
  199.     )
  200.   )
  201. )
  202. ;;选择集交点断开-------(一级)-------
  203. ;;支持line arc circle ellipse spline polyline lwpolyline
  204. ;self t 自交断  nil 自交不断
  205. (defun sl_break_with (ss self / ss1 ss2 nam e lis n tp)
  206.   (setq ss1 (ssadd) ss2 (ssadd))
  207.   (repeat (setq n (sslength ss))
  208.     (setq nam (ssname ss (setq n (1- n))) tp (dxf1 nam 0))
  209.     (cond
  210.       ((= tp "CIRCLE") ;转为2段多段线处理
  211.         (arccirtopl nam)
  212.         (ssadd (entlast) ss1)
  213.       )
  214.       ((or
  215.          (member tp '("LINE" "ARC"))
  216.          (= (sl:pts-onLine (getpt (ssadd nam))) t)
  217.        )
  218.         (ssadd nam ss2)
  219.       )
  220.       (t
  221.         (ssadd nam ss1)
  222.       )
  223.     )
  224.   )
  225.   (if (> (sslength ss2) 0)
  226.     (progn
  227.       (setq e (entlast))
  228.       (mapcar '(lambda (x) (ssbrkpoint (car x) (cdr x))) (InterSort (ssinter (ssget->vla-list ss2))))
  229.       (setq ss2 (last_ent e))
  230.     )
  231.   )
  232.   (if (> (sslength ss1) 0)
  233.     (if (> (sslength ss2) 0)
  234.       (progn
  235.         (setq ss1 (sl:pickset-join ss1 ss2))
  236.         (break_with_include_pl_sl ss1 ss1 self)
  237.       )
  238.       (break_with_include_pl_sl ss1 ss1 self)
  239.     )
  240.   )
  241. )
  242. ;;对象是否在锁定层上-----(一级)-----
  243. (defun onlockedlayer (nam / entlst)
  244.   (setq entlst (tblsearch "LAYER" (dxf1 nam 8)))
  245.   (= 4 (logand 4 (dxf1 entlst 70)))
  246. )
  247. ;;坐标表--->三维点表------(一级)---
  248. (defun list->3pair (old / new)
  249.   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old)))
  250.   (reverse new)
  251. )
  252. ;;选择集交点断开-------(一级)-------
  253. ;self t 自交断  nil 自交不断
  254. (defun break_with_include_pl_sl (ss2brk ss2brkwith self / intpts lst masterlist obj intobj obj2brk)
  255.   (foreach obj (ssget->vla-list ss2brk)
  256.     (if (not (onlockedlayer (obj2en obj)))
  257.       (progn
  258.         (setq lst nil)
  259.         (foreach intobj (ssget->vla-list ss2brkwith)
  260.           (if (and (or self (not (equal obj intobj))) (setq intpts (get_interpts obj intobj 0)))
  261.             (setq lst (append (list->3pair intpts) lst))
  262.           )
  263.         )
  264.         (if lst (setq masterlist (cons (cons (obj2en obj) lst) masterlist)))
  265.       )
  266.     )
  267.   )
  268.   (if masterlist
  269.     (foreach obj2brk masterlist
  270.       (vl-catch-all-apply 'sl_break_obj (list (car obj2brk) (cdr obj2brk)))
  271.     )
  272.   )
  273. )
  274. ;;交点断开程序【结束】-------



本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复

使用道具 举报

尘缘一生
 楼主| 发表于 2024-1-23 03:33 | 显示全部楼层
本帖最后由 尘缘一生 于 2024-1-23 04:08 编辑

再次改写压缩，

  2. ;;交点断开程序----【开始】-----
  3. ;三领设计 V3.0 Modify by 尘缘一声  QQ:15290049
  4. (defun c:sl-break (/ e_lst ss)
  5.   (_undo1)
  6.   (setq e_lst (sysvar '("OSMODE" "CMDECHO" "ORTHOMODE" "DRAWORDERCTL")))
  7.   (setvar "CMDECHO" 0)
  8.   (setvar "OSMODE" 0) ;;捕捉关闭
  9.   (setvar "ORTHOMODE" 0) ;;正交关闭
  10.   (setvar "DRAWORDERCTL" 0)
  11.   (prompt
  12.     (slmsg
  13.       "\n 支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE!"
  14.       "\n や LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE!"
  15.       "\n Support LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE!"
  16.     )
  17.   )
  18.   (prompt
  19.     (slmsg
  20.       "\n 选择交点断开的实体，ENTER 键继续-->:"
  21.       "\n 匡拒ユ翴耞秨龟砰ENTER 龄膥尿-->:"
  22.       "\n Select the entity whose intersection is broken, and press ENTER to continue-->:"
  23.     )
  24.   )
  25.   (if (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
  26.     (sl_break_with ss t)
  27.   )
  28.   (mapcar 'eval e_lst)
  29.   (_undo2)
  30.   (princ)
  31. )
  32. ;;实体与其交点处断开----(一级)------
  33. ;;nam 实体名 lis 实体上断开点集表(已包含必要的端点)
  34. (defun ssbrkpoint (nam lis / ent lis1 tp namcen objaxis objratio w ly cl lt p0 p1 p2 enlst)
  35.   (setq tp (dxf1 nam 0))
  36.   (if (= tp "CIRCLE") ;转为2段多段线处理
  37.     (progn (arccirtopl nam) (setq nam (entlast)))
  38.   )
  39.   (cond
  40.     ((and (member tp '("LWPOLYLINE" "POLYLINE")) (= (sl:pts-onLine lis) t) (= (checkarc nam) nil)) ;共线、不带圆弧的
  41.       (setq w (linwind nam) ly (dxf1 nam 8) cl (sl-getcolor nam) lt (sl-linetype nam))
  42.       (if (> w 0.0)
  43.         (while (> (length lis) 1)
  44.           (slch:lwpolyline (list (car lis) (cadr lis)) nil w ly cl nil)
  45.           (vla-put-linetype (en2obj (entlast)) lt)
  46.           (setq lis (cdr lis))
  47.           )
  48.         (while (> (length lis) 1)
  49.           (slch:line (car lis) (cadr lis) ly cl nil)
  50.           (vla-put-linetype (en2obj (entlast)) lt)
  51.           (setq lis (cdr lis))
  52.           )
  53.         )
  54.       (entdel nam)
  55.     )
  56.     ((member tp '("LINE" "ARC")) ;(member tp '("LINE" "ARC" "CIRCLE"))
  57.       (setq
  58.         lis1 lis
  59.         ent (entget nam)
  60.         ent (vl-remove (assoc -1 ent) ent) ;去除图元名
  61.         ent (vl-remove (assoc 330 ent) ent) ;去除id
  62.         ent (vl-remove (assoc 5 ent) ent) ;去除句柄
  63.         )
  64.       (cond
  65.         ((= tp "LINE")
  66.           (while (> (length lis) 1)
  67.             (setq ent (subst (cons 10 (car lis)) (assoc 10 ent) ent))
  68.             (setq ent (subst (cons 11 (cadr lis)) (assoc 11 ent) ent))
  69.             (entmake ent)
  70.             (setq lis (cdr lis))
  71.             )
  72.           )
  73.         ;((= tp "CIRCLE")
  74.         ;  (setq objcen (dxf1 ent 10))
  75.         ;  (setq ent (subst (cons 0 "ARC") (assoc 0 ent) ent))
  76.         ;  (setq ent (append ent (list (cons 100 "AcDbArc") (cons 50 0.0) (cons 51 0.0))))
  77.         ;  (while (> (length lis) 1)
  78.         ;    (setq ent (subst (cons 50 (angle objcen (cadr lis))) (assoc 50 ent) ent))
  79.         ;    (setq ent (subst (cons 51 (angle objcen (car lis))) (assoc 51 ent) ent))
  80.         ;    (entmake ent)
  81.         ;    (setq lis (cdr lis))
  82.         ;  )
  83.         ;)
  84.         ((= tp "ARC")
  85.           (setq namcen (dxf1 ent 10))
  86.           (while (> (length lis) 1)
  87.             (setq ent (subst (cons 50 (angle namcen (cadr lis))) (assoc 50 ent) ent))
  88.             (setq ent (subst (cons 51 (angle namcen (car lis))) (assoc 51 ent) ent))
  89.             (entmake ent)
  90.             (setq lis (cdr lis))
  91.             )
  92.           )
  93.         )
  94.       (if (> (length lis1) 1) (entdel nam))
  95.     )
  96.     (t
  97.       (setq p1 (vlax-curve-getstartpoint nam) p2 (vlax-curve-getendpoint nam))
  98.       (setq lis (remove_ite_list lis p1));;去除端点
  99.       (setq lis (remove_ite_list lis p2))
  100.       (vl-catch-all-apply 'sl_break_obj (list nam lis))
  101.     )
  102.   )
  103.   (princ)
  104. )
  105. ;;求交点集函数-------------
  106. ;;参数 el (obj1 obj2 obj3)
  107. ;;返回 ((obj1 pt1 pt2...交点n) (obj2 pt1 pt2...交点n)....) ;包含实体端点
  108. (defun ssinter (el / el1 obj1 obj2 ipts pts list1 outlst i j)
  109.   (setq outlst (mapcar 'list el) i -1)
  110.   (while el
  111.     (setq obj1 (car el)
  112.       list1 (nth (setq i (1+ i)) outlst) ;obj1已有的交点列表
  113.       el (cdr el)
  114.       el1 el
  115.       j i
  116.     )
  117.     (while el1
  118.       (setq obj2 (car el1) el1 (cdr el1) j (1+ j))
  119.       (if (and
  120.             (setq ipts (vla-intersectwith obj1 obj2 0))
  121.             (setq ipts (vlax-variant-value ipts))
  122.             (> (vlax-safearray-get-u-bound ipts 1) 0)
  123.             )
  124.         (progn
  125.           (setq ipts (vlax-safearray->list ipts) pts '())  ;obj1,obj2交点临时列表变量
  126.           (while (> (length ipts) 0)
  127.             (setq pts (cons (list (car ipts) (cadr ipts) (caddr ipts)) pts) ipts (cdddr ipts))
  128.             )
  129.           (setq list1 (append list1 pts)) ;存obj1交点表,循环结束后再更新
  130.           (setq outlst (subst (append (nth j outlst) pts) (nth j outlst) outlst));;obj2的交点列表立即更新
  131.           )
  132.         )
  133.     )
  134.     (if (and (cdr list1) (not (vlax-curve-isClosed obj1)))
  135.       (setq list1 (append list1 (list (vlax-curve-getEndPoint obj1)) (list (vlax-curve-getStartPoint obj1))));;当obj1存在交点,且非封闭曲线,添加两端点
  136.     )
  137.     (setq outlst (subst list1 (nth i outlst) outlst));更新obj1交点列表
  138.   )
  139.   outlst
  140. )
  141. ;;点集排序及删除重复点函数---(一级)----
  142. ;;参数 ((obj1 pt1 pt2...交点n) (obj2 pt1 pt2...交点n)....)
  143. ;;返回 ((nam1 pt1 pt2...) (nam2 pt1 pt2...)....)
  144. (defun InterSort (el / obj1 pts plst outlst item)
  145.   (foreach item el
  146.     (setq obj1 (car item) pts (cdr item))
  147.     (if pts
  148.       (progn
  149.         (setq pts (vl-sort pts (function (lambda (p1 p2) (< (vlax-curve-getParamAtPoint obj1 p1) (vlax-curve-getParamAtPoint obj1 p2))))));;交点排序，列表为逆序
  150.         (setq plst (reverse (gps->lst-delsame pts)))
  151.         (if (vlax-curve-isClosed obj1) ;;闭合曲线需再添加首个交点以使新实体完全封闭
  152.           (setq plst (cons (last plst) plst))
  153.           )
  154.         (setq plst (cons (obj2en obj1) plst)
  155.           outlst (cons plst outlst)
  156.           )
  157.         )
  158.     )
  159.   )
  160.   outlst
  161. )
  162. ;;实体与其交点处断开--------(一级)------
  163. ;;nam 实体名  ptlst 实体上交点表(并未包含端点)
  164. (defun sl_break_obj (nam ptlst / enlst p0 p1 p2 tp maxparam minparam obj closif)
  165.   (setq tp (dxf1 nam 0) enlst (list nam))
  166.   (foreach p0 ptlst
  167.     (if enlst
  168.       (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list nam p0))))
  169.         (foreach obj enlst
  170.           (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj p0)))
  171.             (setq nam obj)
  172.             )
  173.           )
  174.         )
  175.     )
  176.     (setq closif (vlax-curve-isclosed nam))
  177.     (cond
  178.       ((and (member tp '("SPLINE" "CIRCLE")) closif)
  179.         (setq
  180.           p1 (vlax-curve-getparamatpoint nam p0)
  181.           p2 (vlax-curve-getpointatparam nam (+ p1 0.000001))
  182.           )
  183.         (command "._break" nam "_non" (trans p0 0 1) "_non" (trans p2 0 1))
  184.         (if (= tp "CIRCLE") (setq tp "ARC"))
  185.         )
  186.       ((and (= tp "ELLIPSE") closif)
  187.         (setq
  188.           p1 (vlax-curve-getparamatpoint nam p0)
  189.           p2 (+ p1 0.000001)
  190.           minparam (min p1 p2)
  191.           maxparam (max p1 p2)
  192.           obj (en2obj nam)
  193.           )
  194.         (vlax-put obj 'startparameter maxparam)
  195.         (vlax-put obj 'endparameter (+ minparam 2pi))
  196.         )
  197.       (t
  198.         (command "._break" nam "_non" (trans p0 0 1) "_non" (trans p0 0 1))
  199.         (if (not closif)
  200.           (setq enlst (cons (entlast) enlst))
  201.           )
  202.         )
  203.     )
  204.   )
  205. )
  206. ;;对象是否在锁定层上-----(一级)-----
  207. (defun onlockedlayer (nam / entlst)
  208.   (setq entlst (tblsearch "LAYER" (dxf1 nam 8)))
  209.   (= 4 (logand 4 (dxf1 entlst 70)))
  210. )
  211. ;;选择集交点断开-------(一级)-------
  212. ;;支持line arc circle ellipse spline polyline lwpolyline
  213. ;self t 自交断  nil 自交不断
  214. (defun sl_break_with (ss self / obj lis lis1)
  215.   (setq lis (ssget->vla-list ss))
  216.   (if self
  217.     (foreach obj lis
  218.       (if (not (onlockedlayer (obj2en obj)))
  219.         (setq lis (cons obj lis))
  220.         )
  221.     )
  222.   )
  223.   (mapcar '(lambda (x) (vl-catch-all-apply 'ssbrkpoint (list (car x) (cdr x)))) (InterSort (ssinter lis)))
  224. )
  225. ;;交点断开程序【结束】-------


回复 支持 1 反对 0

使用道具 举报

bai2000
发表于 2024-1-23 15:59 | 显示全部楼层
看着不错，支持一下，虽然有自定义函数：
(progn (arccirtopl nam) (setq nam (entlast)))
  )
  (cond
    ((and (member tp '("LWPOLYLINE" "POLYLINE")) (= (sl:pts-onLine lis) t) (= (checkarc nam) nil)) ;共线、不带圆弧的
      (setq w (linwind nam) ly (dxf1 nam 8) cl (sl-getcolor nam) lt (sl-linetype nam))
回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2024-1-24 00:21 | 显示全部楼层
bai2000 发表于 2024-1-23 15:59
看着不错，支持一下，虽然有自定义函数：
(progn (arccirtopl nam) (setq nam (entlast)))
  )

还在修改，思考加速的深挖一下，目前，想合并两部分交点问题，还没有做到。
回复 支持 反对

使用道具 举报

ghgh0130
发表于 2024-1-24 11:56 | 显示全部楼层
看着不错，支持一下。。
回复 支持 反对

使用道具 举报

atone
发表于 2024-2-13 19:39 | 显示全部楼层
批量交点断开，期待更新
回复 支持 反对

使用道具 举报

meja
发表于 2024-2-20 11:43 | 显示全部楼层
这个国外很多大神写过，leemac 和 cab 的最出名
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-5-2 08:43 , Processed in 0.399336 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表