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

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

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

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

本帖最后由 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))
)

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

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

沙发一下

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

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

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

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

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

先看看solid实体的定义

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

估计是想solid→hatch

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

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

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

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

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

这个有点类似于把相交或者相切的圆连接成一个圆，连接是能连接上，关键它不再是圆了
页: [1]
查看完整版本: 求凡相交或相连的SOLID图元合并