求凡相交或相连的SOLID图元合并

品茗新秀 · 发表于 2014-4-20 16:53

求凡相交或相连的SOLID图元合并成一个SOLID图元

q3_2006 · 发表于 2014-4-20 16:53

本帖最后由 q3_2006 于 2014-4-21 14:59 编辑

(vl-load-com)
(vl-load-com)
(setq *doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq *ms (vla-get-ModelSpace *doc))
(defun ss2vlst (ss / i l)
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
)
)
)
(defun lst2objarray (objList / arraySpace sArray)
(setq arraySpace (vlax-make-safearray vlax-vbObject (cons 0 (1- (length objList)))))
(setq sArray (vlax-safearray-fill arraySpace objList))
)
(defun vlst2ss (lst / i ss)
(setq ss (ssadd))
(repeat (setq i (length lst))
(ssadd (vlax-vla-object->ename (nth (setq i (1- i)) lst)) ss)
)
)
(defun t0 (ss / e i regions s0 s1 se ssn vlalst)
(setq s0 (ssget "x"))
(if ss
(progn
(vla-startundomark *doc)
(setq vlalst (ss2vlst ss)
regions (vlax-safearray->list (vlax-variant-value
(vla-addregion *ms
(lst2objarray vlalst)
)
)
)
)
(vl-cmdf "erase" ss "")
(vl-cmdf "_union" (vlst2ss regions) "")
(vl-cmdf "explode" (entlast))
(setq ssn (ssget "p"))
(repeat (setq i (sslength ssn))
(setq e (ssname ssn (setq i (1- i))))
(vl-cmdf "explode" e "")
(vl-cmdf "pedit" "m" (ssget "p") "" "y" "j" "" "")
)
(setq s1 (ssget "x"))
(vl-cmdf "select" s1 "r" s0 "")
(setq se (ssget "p"))
(repeat (setq i (sslength se))
(setq e (ssname se (setq i (1- i))))
(vl-cmdf "bhatch" "p" "s" "s" e "" "")
)
)
)
)
(defun mkpline (pts cl)
(entmakex (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length pts))
(if cl
(cons 70 1)
(cons 70 0)
)
)
(mapcar '(lambda (a) (cons 10 a)) pts)
)
)
)
(defun delsame (l) (if l (cons (car l) (delsame (vl-remove (car l) l)))))
(defun gvp (e) (delsame (vl-remove nil (mapcar '(lambda (x) (if (wcmatch (itoa (car x)) "1?") (cdr x))) (entget e)))))
(defun lst2ss (lst / i ss)
(setq ss (ssadd))
(repeat (setq i (length lst))
(ssadd (nth (setq i (1- i)) lst) ss)
)
)
(defun c:tt ( / e e1 i l pts ss)
(setq ss (ssget '((0 . "SOLID"))))
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
pts (gvp e)
pts (if (= (length pts) 3) pts (list (car pts) (cadr pts) (cadddr pts) (caddr pts)))
e1 (mkpline pts t)
l (cons e1 l)
)
(entdel e)
)
(t0 (lst2ss l))
)

(vl-load-com) 
(vl-load-com) 
(setq *doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) 
(setq *ms (vla-get-ModelSpace *doc)) 
(defun ss2vlst (ss / i l) 
  (if ss 
    (repeat (setq i (sslength ss)) 
      (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l)) 
    ) 
  ) 
) 
(defun lst2objarray (objList / arraySpace sArray) 
  (setq arraySpace (vlax-make-safearray vlax-vbObject (cons 0 (1- (length objList))))) 
  (setq sArray (vlax-safearray-fill arraySpace objList)) 
) 
(defun vlst2ss (lst / i ss) 
    (setq ss (ssadd)) 
    (repeat (setq i (length lst)) 
     (ssadd (vlax-vla-object->ename (nth (setq i (1- i)) lst)) ss) 
    ) 
  ) 
(defun t0 (ss / e i regions s0 s1 se ssn vlalst) 
 (setq s0 (ssget "x")) 
  (if ss 
    (progn 
      (vla-startundomark *doc) 
      (setq vlalst (ss2vlst ss) 
     regions (vlax-safearray->list (vlax-variant-value 
             (vla-addregion *ms 
              (lst2objarray vlalst) 
             ) 
       ) 
      ) 
      ) 
      (vl-cmdf "erase" ss "") 
      (vl-cmdf "_union" (vlst2ss regions) "") 
      (vl-cmdf "explode" (entlast)) 
      (setq ssn (ssget "p")) 
      (repeat (setq i (sslength ssn)) 
      (setq e (ssname ssn (setq i (1- i)))) 
      (vl-cmdf "explode" e "") 
      (vl-cmdf "pedit" "m" (ssget "p") "" "y" "j" "" "") 
    ) 
    (setq s1 (ssget "x")) 
      (vl-cmdf "select" s1 "r" s0 "") 
      (setq se (ssget "p")) 
      (repeat (setq i (sslength se)) 
      (setq e (ssname se (setq i (1- i)))) 
      (vl-cmdf "bhatch" "p" "s" "s" e "" "") 
    ) 
    ) 
  ) 
) 
(defun mkpline (pts cl) 
    (entmakex (append (list '(0 . "LWPOLYLINE") 
       '(100 . "AcDbEntity") 
       '(100 . "AcDbPolyline") 
       (cons 90 (length pts)) 
       (if cl 
         (cons 70 1) 
         (cons 70 0) 
       ) 
        ) 
        (mapcar '(lambda (a) (cons 10 a)) pts) 
       ) 
    ) 
  ) 
(defun delsame (l) (if l (cons (car l) (delsame (vl-remove (car l) l))))) 
(defun gvp (e) (delsame (vl-remove nil (mapcar '(lambda (x) (if (wcmatch (itoa (car x)) "1?") (cdr x))) (entget e))))) 
(defun lst2ss (lst / i ss) 
    (setq ss (ssadd)) 
    (repeat (setq i (length lst)) 
     (ssadd (nth (setq i (1- i)) lst) ss) 
    ) 
  ) 
(defun c:tt ( / e e1 i l pts ss) 
    (setq ss (ssget '((0 . "SOLID")))) 
    (repeat (setq i (sslength ss)) 
     (setq e (ssname ss (setq i (1- i))) 
      pts (gvp e) 
      pts (if (= (length pts) 3) pts (list (car pts) (cadr pts) (cadddr pts) (caddr pts))) 
      e1 (mkpline pts t) 
      l (cons e1 l) 
     ) 
     (entdel e) 
    ) 
    (t0 (lst2ss l)) 
)

cable2004 · 发表于 2014-4-20 17:02

本帖最后由 cable2004 于 2014-4-20 23:50 编辑

沙发一下

lucas_3333 · 发表于 2014-4-20 20:31

你的代码在吗？你的思路在哪？

ZZXXQQ · 发表于 2014-4-21 07:53

SOLID图元具有与多义线相同的顶点参数。可以根据其顶点坐标生成多义线，然后生成面域，生成并集，炸开再生成封闭多义线，然后再生成SOLID。

xyp1964 · 发表于 2014-4-21 08:35

先看看solid实体的定义

xyp1964 · 发表于 2014-4-21 08:38

估计是想solid→hatch

品茗新秀 · 发表于 2014-4-21 11:24

这个看样子难度较大，顶出高手

Gu_xl · 发表于 2014-4-21 12:36

违背自然规律的提问！Solid对象只有四个顶点！

llsheng_73 · 发表于 2014-4-21 12:42

这个有点类似于把相交或者相切的圆连接成一个圆，连接是能连接上，关键它不再是圆了

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

[提问] 求凡相交或相连的SOLID图元合并

最佳答案

点评

点评

本帖子中包含更多资源