参考eachy的算法做的交点处批量断开程序

fools · 发表于 2006-1-25 14:41:46

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×

说明：
1。调用entmake生成line，arc，ellipse
2。本程序未调用break命令，故暂不考虑pline线的处理
3。因为用了vla-intersectwith函数，对于纯直线集建议另采用直线断点程序以提高速度。
4。本程序参考了很多人的设计思路，在此一并感谢，不一一提到，也希望大家帮忙看看，提一些改进意见

;;主函数
(defun c:MB (/ elist ssg n t0)
(VL-LOAD-COM)
(setq t0 (xdl-getutime))
(if (setq ssg (ssget '((0 . "line,arc,circle,ellipse"))))
(vlax-for obj (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
(setq elist (cons obj elist)) ; ssg->elist
)
)
(DoEntMake (InterSort (ssinter elist)))
(princ (strcat "\n*****找到交点"
(itoa n)
"个，交点断开操作共耗时"
(rtos (- (xdl-getutime) t0) 2 3)
"秒。*****"
)
)
(princ)
)
;;求交点集函数－nth
;;经过测试，nth函数仅比assoc函数快一点点。
;;故此函数也可取消i，j变量，直接使用assoc函数
(defun ssinter (el / el1 obj1 obj2 ipts pts list1 outlst i j)
(setq outlst (mapcar 'list el)
i -1 ;obj1位置指针
n 0 ;交点数计数器
)
(while el
(setq obj1 (car el)
list1 (nth (setq i (1+ i)) outlst) ;obj1已有的交点列表
el (cdr el)
el1 el
j i ;obj2位置指针
)
(while el1
(setq obj2 (car el1)
el1 (cdr el1)
j (1+ j)
)
;;取交点
(if (and (setq ipts (vla-intersectwith obj1 obj2 0))
(setq ipts (vlax-variant-value ipts))
(> (vlax-safearray-get-u-bound ipts 1) 0)
)
(progn
(setq ipts (vlax-safearray->list ipts)
pts '() ;obj1,obj2交点临时列表变量
)
(while (> (length ipts) 0)
(setq pts (cons (list (car ipts)
(cadr ipts)
(caddr ipts)
)
pts
)
ipts (cdddr ipts)
)
)
(setq list1 (append list1 pts) ;存obj1交点表，循环结束后再更新
n (+ n (length pts)) ;交点计数累加
)
;;obj2的交点列表立即更新
(setq
outlst (subst (append (nth j outlst) pts)
(nth j outlst)
outlst
)
)
)
)
)
;;当obj1存在交点，且非封闭曲线，添加两端点
(if (and (cdr list1) (not (vlax-curve-isClosed obj1)))
(setq list1 (append list1
(list (vlax-curve-getEndPoint obj1))
(list (vlax-curve-getStartPoint obj1))
)
)
)
(setq outlst (subst list1 (nth i outlst) outlst)) ;更新obj1交点列表
)
outlst
)
;;点集排序及删除重复点函数
(defun InterSort (el / obj1 pts plst outlst)
(setq outlst '()) ;empty list
(foreach item el
(setq obj1 (car item)
pts (cdr item)
plst '() ;empty list
)
(if pts ;若无交点，则不修改该实体
(progn
;;交点排序，列表为逆序
(setq
pts (vl-sort
pts
(function (lambda (p1 p2)
(< (vlax-curve-getParamAtPoint obj1 p1)
(vlax-curve-getParamAtPoint obj1 p2)
)
)
)
)
)
;;剔除重复点并将列表顺序转正
(foreach p pts
(if plst
(if (not (equal p (car plst) 0.00001))
(setq plst (cons p plst))
)
(setq plst (cons p plst))
)
)
;;闭合曲线需再添加首个交点以使新实体完全封闭
(if (vlax-curve-isClosed obj1)
(setq plst (cons (last plst) plst))
)
(setq plst (cons (vlax-vla-object->ename obj1) plst)
outlst (cons plst outlst)
)
)
)
)
outlst
)
;;调用entmake生成新实体
(defun DoEntMake (el / obj objlst objname objcen objratio objaxis)
(foreach e el
(setq obj (car e)
objlst (entget obj)
objlst (vl-remove (assoc -1 objlst) objlst) ;去除图元名
objlst (vl-remove (assoc 330 objlst) objlst) ;去除id
objlst (vl-remove (assoc 5 objlst) objlst) ;去除句柄
objname (cdr (assoc 0 objlst))
)
(cond
((= objname "LINE")
(repeat (- (length e) 2)
(setq e (cdr e))
(setq objlst (subst (cons 10 (car e)) (assoc 10 objlst) objlst))
(setq objlst (subst (cons 11 (cadr e)) (assoc 11 objlst) objlst))
(entmake objlst)
)
(entdel obj)
)
((= objname "CIRCLE")
(setq objcen (cdr (assoc 10 objlst)))
(setq objlst (subst (cons 0 "ARC") (assoc 0 objlst) objlst))
(setq objlst (append objlst
(list (cons 100 "AcDbArc")
(cons 50 0.0)
(cons 51 0.0)
)
)
)
(repeat (- (length e) 2)
(setq e (cdr e))
(setq objlst (subst (cons 50 (angle objcen (cadr e)))
(assoc 50 objlst)
objlst
)
)
(setq objlst (subst (cons 51 (angle objcen (car e)))
(assoc 51 objlst)
objlst
)
)
(entmake objlst)
)
(entdel obj)
)
((= objname "ARC")
(setq objcen (cdr (assoc 10 objlst)))
(repeat (- (length e) 2)
(setq e (cdr e))
(setq objlst (subst (cons 50 (angle objcen (cadr e)))
(assoc 50 objlst)
objlst
)
)
(setq objlst (subst (cons 51 (angle objcen (car e)))
(assoc 51 objlst)
objlst
)
)
(entmake objlst)
)
(entdel obj)
)
((= objname "ELLIPSE")
;;椭圆圆心
(setq objcen (cdr (assoc 10 objlst)))
;;相对于中心的长轴矢量
(setq objaxis (cdr (assoc 11 objlst)))
;;短轴与长轴的比例
(setq objratio (cdr (assoc 40 objlst)))
(repeat (- (length e) 2)
(setq e (cdr e))
(setq objlst (subst (cons 41 (pt->param (cadr e) objcen objaxis objratio))
(assoc 41 objlst)
objlst
)
)
(setq objlst (subst (cons 42 (pt->param (car e) objcen objaxis objratio))
(assoc 42 objlst)
objlst
)
)
(entmake objlst)
)
(entdel obj)
)
)
)
)
;;计算耗时
(defun xdl-getutime ()
(* 86400 (getvar "tdusrtimer"))
)
;;求椭圆曲线参数
(defun pt->param (pt cen axis ratio / ang param)
(setq ang (- (angle cen pt) (angle '(0. 0. 0.) axis)))
(cond ((= (cos ang) 0.0) ;防止分母cos为零出错
(if (> (sin ang) 0.0)
(setq param (* 0.5 PI))
(setq param (* 1.5 PI))
)
)
((= (sin ang) 0.0)
(if (> (cos ang) 0.0)
(setq param 0.0)
(setq param PI)
)
)
(T
(setq param (atan (/ (sin ang) (* (cos ang) ratio))))
(if (< (cos ang) 0.0)
(setq param (+ pi param))
)
)
)
param
)
(princ
"\n**********批量交点打断程序，键入MB执行命令**********"
)
(princ)

;;主函数 
(defun c:MB (/ elist ssg n t0) 
  (VL-LOAD-COM) 
  (setq t0 (xdl-getutime)) 
  (if (setq ssg (ssget '((0 . "line,arc,circle,ellipse")))) 
    (vlax-for obj (vla-get-activeselectionset 
                    (vla-get-activedocument (vlax-get-acad-object)) 
                  ) 
      (setq elist (cons obj elist))        ; ssg->elist 
    ) 
  ) 
  (DoEntMake (InterSort (ssinter elist))) 
  (princ (strcat "\n*****找到交点" 
                 (itoa n) 
                 "个，交点断开操作共耗时" 
                 (rtos (- (xdl-getutime) t0) 2 3) 
                 "秒。*****" 
         ) 
  ) 
  (princ) 
) 
 
;;求交点集函数－nth 
;;经过测试，nth函数仅比assoc函数快一点点。 
;;故此函数也可取消i，j变量，直接使用assoc函数 
(defun ssinter (el / el1 obj1 obj2 ipts pts list1 outlst i j) 
  (setq        outlst (mapcar 'list el) 
        i      -1                        ;obj1位置指针 
        n      0                        ;交点数计数器 
  ) 
  (while el 
    (setq obj1        (car el) 
          list1        (nth (setq i (1+ i)) outlst) ;obj1已有的交点列表 
          el        (cdr el) 
          el1        el 
          j        i                        ;obj2位置指针 
    ) 
    (while el1 
      (setq obj2 (car el1) 
            el1         (cdr el1) 
            j         (1+ j) 
      ) 
      ;;取交点 
      (if (and (setq ipts (vla-intersectwith obj1 obj2 0)) 
               (setq ipts (vlax-variant-value ipts)) 
               (> (vlax-safearray-get-u-bound ipts 1) 0) 
 
          ) 
        (progn 
          (setq        ipts (vlax-safearray->list ipts) 
                pts  '()                ;obj1,obj2交点临时列表变量 
          ) 
          (while (> (length ipts) 0) 
            (setq pts  (cons (list (car ipts) 
                                   (cadr ipts) 
                                   (caddr ipts) 
                             ) 
                             pts 
                       ) 
                  ipts (cdddr ipts) 
            ) 
          ) 
          (setq        list1 (append list1 pts) ;存obj1交点表，循环结束后再更新 
                n     (+ n (length pts)) ;交点计数累加 
          ) 
          ;;obj2的交点列表立即更新 
          (setq 
            outlst (subst (append (nth j outlst) pts) 
                          (nth j outlst) 
                          outlst 
                   ) 
          ) 
        ) 
      ) 
    ) 
    ;;当obj1存在交点，且非封闭曲线，添加两端点 
    (if        (and (cdr list1) (not (vlax-curve-isClosed obj1))) 
      (setq list1 (append list1 
                          (list (vlax-curve-getEndPoint obj1)) 
                          (list (vlax-curve-getStartPoint obj1)) 
                  ) 
      ) 
    ) 
    (setq outlst (subst list1 (nth i outlst) outlst)) ;更新obj1交点列表 
  ) 
  outlst 
) 
 
;;点集排序及删除重复点函数 
(defun InterSort (el / obj1 pts plst outlst) 
  (setq outlst '())                        ;empty list 
  (foreach item        el 
    (setq obj1 (car item) 
          pts  (cdr item) 
          plst '()                        ;empty list 
    ) 
    (if        pts                                ;若无交点，则不修改该实体 
      (progn 
        ;;交点排序，列表为逆序 
        (setq 
          pts (vl-sort 
                pts 
                (function (lambda (p1 p2) 
                            (< (vlax-curve-getParamAtPoint obj1 p1) 
                               (vlax-curve-getParamAtPoint obj1 p2) 
                            ) 
                          ) 
                ) 
              ) 
        ) 
        ;;剔除重复点并将列表顺序转正 
        (foreach p pts 
          (if plst 
            (if        (not (equal p (car plst) 0.00001)) 
              (setq plst (cons p plst)) 
            ) 
            (setq plst (cons p plst)) 
          ) 
        ) 
        ;;闭合曲线需再添加首个交点以使新实体完全封闭 
        (if (vlax-curve-isClosed obj1) 
          (setq plst (cons (last plst) plst)) 
        ) 
        (setq plst   (cons (vlax-vla-object->ename obj1) plst) 
              outlst (cons plst outlst) 
        ) 
 
      ) 
    ) 
  ) 
  outlst 
) 
 
;;调用entmake生成新实体 
(defun DoEntMake (el / obj objlst objname objcen objratio objaxis) 
  (foreach e el 
    (setq obj          (car e) 
          objlst  (entget obj) 
          objlst  (vl-remove (assoc -1 objlst) objlst) ;去除图元名 
          objlst  (vl-remove (assoc 330 objlst) objlst) ;去除id 
          objlst  (vl-remove (assoc 5 objlst) objlst) ;去除句柄 
          objname (cdr (assoc 0 objlst)) 
    ) 
    (cond 
      ((= objname "LINE") 
       (repeat (- (length e) 2) 
         (setq e (cdr e)) 
         (setq objlst (subst (cons 10 (car e)) (assoc 10 objlst) objlst)) 
         (setq objlst (subst (cons 11 (cadr e)) (assoc 11 objlst) objlst)) 
         (entmake objlst) 
       ) 
       (entdel obj) 
      ) 
      ((= objname "CIRCLE") 
       (setq objcen (cdr (assoc 10 objlst))) 
       (setq objlst (subst (cons 0 "ARC") (assoc 0 objlst) objlst)) 
       (setq objlst (append objlst 
                            (list (cons 100 "AcDbArc") 
                                  (cons 50 0.0) 
                                  (cons 51 0.0) 
                            ) 
                    ) 
       ) 
       (repeat (- (length e) 2) 
         (setq e (cdr e)) 
         (setq objlst (subst (cons 50 (angle objcen (cadr e))) 
                             (assoc 50 objlst) 
                             objlst 
                      ) 
         ) 
         (setq objlst (subst (cons 51 (angle objcen (car e))) 
                             (assoc 51 objlst) 
                             objlst 
                      ) 
         ) 
         (entmake objlst) 
       ) 
       (entdel obj) 
      ) 
      ((= objname "ARC") 
       (setq objcen (cdr (assoc 10 objlst))) 
       (repeat (- (length e) 2) 
         (setq e (cdr e)) 
         (setq objlst (subst (cons 50 (angle objcen (cadr e))) 
                             (assoc 50 objlst) 
                             objlst 
                      ) 
         ) 
         (setq objlst (subst (cons 51 (angle objcen (car e))) 
                             (assoc 51 objlst) 
                             objlst 
                      ) 
         ) 
         (entmake objlst) 
       ) 
       (entdel obj) 
      ) 
      ((= objname "ELLIPSE") 
       ;;椭圆圆心 
       (setq objcen (cdr (assoc 10 objlst))) 
       ;;相对于中心的长轴矢量 
       (setq objaxis (cdr (assoc 11 objlst))) 
       ;;短轴与长轴的比例 
       (setq objratio (cdr (assoc 40 objlst))) 
       (repeat (- (length e) 2) 
         (setq e (cdr e)) 
         (setq objlst (subst (cons 41 (pt->param (cadr e) objcen objaxis objratio)) 
                             (assoc 41 objlst) 
                             objlst 
                      ) 
         ) 
         (setq objlst (subst (cons 42 (pt->param (car e) objcen objaxis objratio)) 
                             (assoc 42 objlst) 
                             objlst 
                      ) 
         ) 
         (entmake objlst) 
       ) 
       (entdel obj) 
      ) 
    ) 
  ) 
) 
 
;;计算耗时 
(defun xdl-getutime () 
  (* 86400 (getvar "tdusrtimer")) 
) 
 
;;求椭圆曲线参数 
(defun pt->param (pt cen axis ratio / ang param) 
  (setq ang (- (angle cen pt) (angle '(0. 0. 0.) axis))) 
  (cond        ((= (cos ang) 0.0)                ;防止分母cos为零出错 
         (if (> (sin ang) 0.0) 
           (setq param (* 0.5 PI)) 
           (setq param (* 1.5 PI)) 
         ) 
        ) 
        ((= (sin ang) 0.0) 
         (if (> (cos ang) 0.0) 
           (setq param 0.0) 
           (setq param PI) 
         ) 
        ) 
        (T 
         (setq param (atan (/ (sin ang) (* (cos ang) ratio)))) 
         (if (< (cos ang) 0.0) 
           (setq param (+ pi param)) 
         ) 
        ) 
  ) 
  param 
) 
 
(princ 
  "\n**********批量交点打断程序，键入MB执行命令**********" 
) 
(princ)

lidejun_55 · 发表于 2006-1-25 17:40:17

楼主的签名让我感动。

eachy · 发表于 2006-2-7 08:41:31

几个建议：

1 求交点函数中用两个 Foreach 效率不高，建议用两次 while

(defun ssinters (el / e1 el0 e2 ipts ipts)
(while el
(setq e1 (car el)
el0 (cdr el)
)
(while el0
(setq e2 (car el0)
el0 (cdr el0)
)
(if (and (setq ipts (vla-intersectwith e1 e2 0))
(setq ipts (vlax-variant-value ipts))
(> (vlax-safearray-get-u-bound ipts 1) 0)
)
...
)
)
)
)

2 DoEntmake 建议用 Entmod 代替 Entmake，以保持原实体的特性

fools · 发表于 2006-2-7 12:45:10

多谢eachy的建议。
1。用两个foreach属于比较偷懒的做法，代码相对简单，效率确实降低了。因为我需要得到的是与每个实体相关的交点列表，而非纯交点集，在最终生成的列表中是存在多个重复的交点的。
如下所示：
((#[VLA-OBJECT IAcadLine 09c38134] (764.958 570.843 0.0) (873.747 502.544 0.0) (989.975 429.573 0.0) (1076.41 375.306 0.0))
(#[VLA-OBJECT IAcadLine 09c48aa4] (1333.15 295.409 0.0) (1071.39 509.498 0.0) (971.052 591.563 0.0) (880.702 665.458 0.0))
(#[VLA-OBJECT IAcadLine 09c48fa4] (855.449 297.511 0.0) (989.975 429.573 0.0) (1071.39 509.498 0.0) (1217.41 652.842 0.0))
(#[VLA-OBJECT IAcadLine 09c48a24] (619.753 270.178 0.0) (873.747 502.544 0.0) (971.052 591.563 0.0) (1143.75 749.56 0.0)))
所以如果用while，则需要用subst不断更新这个列表，补充端点及交点。应该效率可以提高，我改改试试。
2。用entmod只能更新少数线条，比如100根横线条与100根竖线条相交，原实体200个，新实体20200，大多数还是需要用entmake生成的，所以不太清楚为何你建议我用entmod。
3。没有完全按照你的算法，排除了线条重叠的因素，我觉得删除重叠线条应通过另一个独立程序实现，可作为交点打断前的预处理程序。

eachy · 发表于 2006-2-8 09:10:17

1 第一步指构造实体与交点表，不进行subst，全部构造完成后用 param 对交点在实体上排逆序，此时处理重复点（点沿实体排序在以前的帖子中有过讨论和代码）

2 对构造的实体和其交点表，用 entget 取得实体的 dxf 组码表，对 Line 而言可以用表替换 10 11 组码部分来 entmake 最后的实体用 entmod 或者 entmake，entmod 后的就不用 entdel 了。

3 同意你的观点，每个程序应该只干自己的事情。

snoopychen · 发表于 2006-2-8 11:26:41

楼主的程序挺好的
有一点，如图，打断后的属性发生了变化
请问能否使打断后的颜色和层不要修改呢？谢谢

fools · 发表于 2006-2-8 12:46:45

To snoopychen :
你的要求就是eachy提到的第二点。

根据eachy的建议修改了程序，首贴已更新。
当所选物体较多，而物体之间的交点不多时，效率显著提高。

eachy · 发表于 2006-2-12 18:54:00

排序部分这样改改（未经测试）

(defun xdl-pts-sortoncurve (el /)
(setq el
(mapcar
'(lambda (lst)
(vl-sort (cdr lst)
(function (lambda (p1 p2)
(< (vlax-curve-getParamAtPoint obj1 p1)
(vlax-curve-getParamAtPoint obj1 p2)
)
)
)
)
)
)
)
;;去除重复点
(mapcar '(lambda (lst / obj pts plst)
(setq obj (car lst)
pts (cdr lst)
)
(foreach p pts
(if plst
(if (not (equal p (car plst) 0.00001))
(setq plst (cons p plst))
)
(setq plst (cons p plst))
)
)
(cons obj plst)
)
el
)
)

(defun xdl-pts-sortoncurve (el /) 
  (setq        el 
         (mapcar 
           '(lambda (lst) 
              (vl-sort (cdr lst) 
                       (function (lambda (p1 p2) 
                                   (< (vlax-curve-getParamAtPoint obj1 p1) 
                                      (vlax-curve-getParamAtPoint obj1 p2) 
                                   ) 
                                 ) 
                       ) 
              ) 
            ) 
         ) 
  ) 
  ;;去除重复点 
  (mapcar '(lambda (lst / obj pts plst) 
             (setq obj (car lst) 
                   pts (cdr lst) 
             ) 
             (foreach p        pts 
               (if plst 
                 (if (not (equal p (car plst) 0.00001)) 
                   (setq plst (cons p plst)) 
                 ) 
                 (setq plst (cons p plst)) 
               ) 
             ) 
             (cons obj plst) 
           ) 
          el 
  ) 
)

fools · 发表于 2006-2-12 21:49:16

eachy的意思我明白，这样可以不用新生成一个表。
我的考虑还是将obj1和pts分开，保留程序原有框架，因为
1。排序中vlax-curve-getParamAtPoint需要用到obj1
2。当某实体与任何物体都不相交时，不处理该实体，交点集pts是判断标准
3。当曲线不封闭时，需增加端点
诸多处理若将实体名和交点集统一在一起写函数太累，分开写程序可读性强一点，呵呵。
采用了你的去除重复点函数，多谢。

雪山飞狐(lzh) · 发表于 2006-2-12 23:41:17

和我的TlsBoundary类（vba在块内按点生成填充的）部分函数的思路是一致的，pline线是可以处理的，唯一的缺憾是无法对spline进行处理

雨箭风刀 · 发表于 2006-4-2 12:29:31

lzh741206 ，为什么不能对spl处理？能说说么？

lzh741206 [

lewyee · 发表于 2006-4-3 15:29:23

LSP永远是不能用光驱,U盘得CAD工作者得首选!

jx2008 · 发表于 2007-1-24 00:46:25

不能对spline断开，这点不好啊，望尽快改进哦

tm010111 · 发表于 2009-12-3 21:14:53

使用时，发现程序对一些交叉的线打断时，会有bug，好像是(InterSort (ssinter elist))
生成的列表中，点的排列顺序有时候不对

GTJ116600 · 发表于 2013-5-30 05:41:25

这个程序竟然都有，太牛了。呵呵，晓东CAD家园太好了。

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

[原创] 参考eachy的算法做的交点处批量断开程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子