【炫翔】交点打断后，封闭区域转多段线图元表

炫翔 · 发表于 2013-11-7 10:12:54

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

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

×

交点打断后，封闭区域转多段线图元表
随手练习源码，写的较啰嗦目前只限于直线，纯VLISP LISP版本，
欢迎大家各抒己见

(defun C:XX( / a b en lst ss ss1 sss xx-ms)
(setq ss (ssget '((0 . "line"))))
(xx-co ss)
(setq sss (ssget "p"))
(setq ss1 (xx-l-break-ss ss));打断后的选择集
(setq en (entlast))
(setq xx-ms(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))));模型空间集合
(xx-addregion xx-ms(xx-ss-EnLst ss1)t);转为面域
(setq lst (xx-lst-EnLastLst en));面域的图元表
;面积从大到小排序
(setq lst (vl-sort lst '(lambda (a b)
(> (Vla-get-area(vlax-ename->vla-object a)) (Vla-get-area(vlax-ename->vla-object b)))
))
)
(entdel (car lst)) ; 删除最外围的面域
(setq lst (cdr lst)); 将面域转成多段线
(setq en (entlast))
(foreach a lst(xx-region2PL a))
(setq lst (xx-lst-EnLastLst en));多段线的图元表
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xx-region2PL(s1 / en ss)
(setq en (entlast))
(vl-cmdf "_.EXPLODE" (list s1 (getvar "viewctr")))
(setq ss (ssadd))
(while (setq en (entnext en))
(ssadd en ss)
)
(vl-cmdf "_.Pedit" "_m" ss "" "_j" "" "")
)
(defun xx-lst-EnLastLst (s1 / lst)
(while (setq s1 (entnext s1));获取图形中的下一个对象（图元）名
(if (not (member (cdr(assoc 0 (entget s1))) '("attrib" "vertex" "seqend")))
(setq lst (cons s1 lst))
)
)
(reverse lst)
)
(defun xx-ss-EnLst(ss / i el)
(setq i (sslength ss))
(while (setq e (ssname ss (setq i (1- i))))
(setq el (cons e el))
)
el
)
(defun xx-addregion (space el tf / regions)
(if (not
(vl-catch-all-error-p
(setq regions (vl-catch-all-apply
'vla-addregion
(list space
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length el)))
)
(mapcar 'vlax-ename->vla-object el)
)
)
)
)
)
)
)
(progn
(safearray-value (variant-value regions))
(if tf
(mapcar 'entdel el)
)
)
)
)
(defun xx-l-break-ss (ss / elist en obj objlst objname ss ssinter intersort)
;求交点集函数－nth
(defun ssinter (el / outlst i n obj1 list1 el1 j obj2 ipts pts)
(setq outlst(mapcar 'list el)
i -1
n 0
)
(while el
(setq obj1 (car el)
list1 (nth (setq i (1+ i))outlst)
el (cdr el)
el1 el
j i
)
(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 '()
)
(while (> (length ipts) 0)
(setq pts (cons (list (car ipts) (cadr ipts) (caddr ipts)) pts)
ipts (cdddr ipts)
)
)
(setq list1 (append list1 pts)
n (+ n (length pts))
)
(setq outlst(subst(append(nth j outlst)pts)(nth j outlst)outlst))
)
)
)
(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))
)
outlst
)
;点集排序及删除重复点函数
(defun intersort (el / outlst obj1 pts plst)
(setq outlst '())
(foreach item el
(setq obj1 (car item)
pts (cdr item)
plst '()
)
(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
)
(vl-load-com)
(setq en (entlast))
(if ss
(vlax-for obj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(setq elist (cons obj elist))
)
)
(foreach e (intersort (ssinter elist))
(setq obj (car e)
objlst (entget obj)
objlst (vl-remove (assoc -1 objlst) objlst)
objlst (vl-remove (assoc 330 objlst) objlst)
objlst (vl-remove (assoc 5 objlst) objlst)
objname (cdr (assoc 0 objlst))
)
(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 ))
(entmakex objlst)
)
(entdel obj)
)
(xx-ss-enlastss en)
)
(defun xx-ss-EnLastSs (s1 / ss)
(if (not s1)
(progn
(setq s1 (entnext))
(if s1
(setq ss (ssadd s1));将s1添加到ss选择集
(setq ss (ssadd));添加到ss选择集
)
)
(setq ss (ssadd));添加到ss选择集
)
(while (setq s1 (entnext s1));获取图形中的下一个对象（图元）名
(if (not (member (cdr(assoc 0 (entget s1))) '("attrib" "vertex" "seqend")))
(ssadd s1 ss);将s1加入选择集
)
)
(if (= 0 (sslength ss)) nil ss)
)

(defun C:XX( / a b en lst ss ss1 sss xx-ms) 
(setq ss (ssget '((0 . "line")))) 
(xx-co ss) 
(setq sss (ssget "p")) 
(setq ss1 (xx-l-break-ss ss));打断后的选择集 
(setq en (entlast)) 
(setq xx-ms(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))));模型空间集合 
(xx-addregion xx-ms(xx-ss-EnLst ss1)t);转为面域 
(setq lst (xx-lst-EnLastLst en));面域的图元表 
;面积从大到小排序 
(setq lst (vl-sort lst '(lambda (a b) 
        (> (Vla-get-area(vlax-ename->vla-object a)) (Vla-get-area(vlax-ename->vla-object b))) 
                         )) 
)                                       
(entdel (car lst)) ; 删除最外围的面域 
(setq lst (cdr lst)); 将面域转成多段线 
  (setq en (entlast)) 
  (foreach a lst(xx-region2PL a)) 
  (setq lst (xx-lst-EnLastLst en));多段线的图元表 
) 
 
 
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
(defun xx-region2PL(s1 / en ss) 
  (setq en (entlast)) 
  (vl-cmdf "_.EXPLODE" (list s1 (getvar "viewctr"))) 
  (setq ss (ssadd)) 
  (while (setq en (entnext en)) 
    (ssadd  en ss) 
    ) 
  (vl-cmdf "_.Pedit" "_m" ss "" "_j" "" "") 
) 
 
 
 
(defun xx-lst-EnLastLst (s1 / lst) 
   (while (setq s1 (entnext s1));获取图形中的下一个对象（图元）名 
    (if (not (member (cdr(assoc 0 (entget s1))) '("attrib" "vertex" "seqend"))) 
        (setq lst (cons s1 lst)) 
     ) 
   ) 
   (reverse lst)    
) 
 
(defun xx-ss-EnLst(ss /  i el) 
  (setq i (sslength ss)) 
  (while (setq e (ssname ss (setq i (1- i)))) 
    (setq el (cons e el)) 
  ) 
  el 
) 
 
 
(defun xx-addregion (space el tf / regions) 
  (if (not 
        (vl-catch-all-error-p 
          (setq regions (vl-catch-all-apply 
                          'vla-addregion 
                          (list space 
                                (vlax-make-variant 
                                  (vlax-safearray-fill 
                                    (vlax-make-safearray 
                                      vlax-vbobject 
                                      (cons 0 (1- (length el))) 
                                    ) 
                                    (mapcar 'vlax-ename->vla-object el) 
                                  ) 
                                ) 
                          ) 
                        ) 
          ) 
        ) 
      ) 
    (progn 
      (safearray-value (variant-value regions)) 
      (if tf 
        (mapcar 'entdel el) 
      ) 
    ) 
  ) 
) 
 
(defun xx-l-break-ss (ss / elist en obj objlst objname ss ssinter intersort) 
  ;求交点集函数－nth 
 (defun ssinter (el / outlst i n obj1 list1 el1 j obj2 ipts pts) 
  (setq outlst(mapcar 'list el) 
        i -1 
        n 0 
  ) 
  (while el 
    (setq obj1 (car el) 
          list1 (nth (setq i (1+ i))outlst) 
          el (cdr el) 
          el1 el 
          j i 
    ) 
    (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 '() 
          ) 
          (while (> (length ipts) 0) 
            (setq pts (cons (list (car ipts) (cadr ipts) (caddr ipts)) pts) 
                  ipts (cdddr ipts) 
            ) 
          ) 
          (setq list1 (append list1 pts) 
                n (+ n (length pts)) 
          ) 
          (setq outlst(subst(append(nth j outlst)pts)(nth j outlst)outlst)) 
        ) 
      ) 
    ) 
    (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)) 
  ) 
  outlst 
 ) 
 
 
 ;点集排序及删除重复点函数 
 (defun intersort (el / outlst obj1 pts plst) 
  (setq outlst '()) 
  (foreach item el 
    (setq obj1 (car item) 
          pts (cdr item) 
          plst '() 
    ) 
    (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 
 ) 
 
(vl-load-com) 
 (setq en (entlast)) 
 (if ss 
     (vlax-for obj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))) 
      (setq elist (cons obj elist)) 
    ) 
 ) 
 (foreach e (intersort (ssinter elist)) 
    (setq obj (car e) 
          objlst (entget obj) 
          objlst (vl-remove (assoc -1 objlst) objlst) 
          objlst (vl-remove (assoc 330 objlst) objlst) 
          objlst (vl-remove (assoc 5 objlst) objlst) 
          objname (cdr (assoc 0 objlst)) 
    ) 
    (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 )) 
      (entmakex objlst) 
    ) 
    (entdel obj) 
  ) 
  (xx-ss-enlastss en) 
) 
 
(defun xx-ss-EnLastSs (s1 / ss) 
  (if (not s1) 
    (progn 
      (setq s1 (entnext)) 
      (if s1 
        (setq ss (ssadd s1));将s1添加到ss选择集 
        (setq ss (ssadd));添加到ss选择集 
       ) 
    ) 
     (setq ss (ssadd));添加到ss选择集 
   ) 
    (while (setq s1 (entnext s1));获取图形中的下一个对象（图元）名 
     (if (not (member (cdr(assoc 0 (entget s1))) '("attrib" "vertex" "seqend"))) 
      (ssadd s1 ss);将s1加入选择集 
     ) 
    ) 
  (if (= 0 (sslength ss)) nil ss)   
)

st788796 · 发表于 2013-11-7 10:24:35

有点啰嗦了

(defun Region->Curve (ss tf / i el s)
(setq i (sslength ss) s (ssadd))
(if tf
(vl-cmdf ".copy" ss "" '(0. 0. 0.) "@")
)
(while (setq e (ssname ss (setq i (1- i))))
(setq el (cons e el))
)
(foreach x el
(vl-cmdf ".explode" (list x (getvar "viewctr")) "")
(vl-cmdf ".pedit" "m" "P" "" "y" "j" 0.0001 "")
(ssadd (entlast) s)
)
s
)

墙角哥 · 发表于 2016-8-9 23:46:35

很不错，学习一下

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

[研讨] 【炫翔】交点打断后，封闭区域转多段线图元表

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

评分