API应用查找邻接三角形

st788796 · 发表于 2014-7-5 09:32:48

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

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

×

本帖最后由 st788796 于 2014-7-5 09:33 编辑

(defun c:tt (/ ss pnts:center lst)
(defun Pnts:Center (pts)
(mapcar '(lambda (x)
(/ x 4.)
)
(apply 'mapcar (cons '+ pts))
)
)
(if (setq ss (ssget '((0 . "3DFACE"))))
(progn
(setq lst (mapcar '(lambda (x / pts p1 p2 p3)
(setq pts (xdrx_entity_getstretchpoint x)
p1 (xdrx_line_midp (car pts) (cadr pts))
p2 (xdrx_line_midp (cadr pts) (caddr pts))
p3 (xdrx_line_midp (car pts) (caddr pts))
)
(list (list p1 pts)
(list p2 pts)
(list p3 pts)
)
)
(xdrx_pickset->ents ss)
)
lst (apply 'append lst)
lst (XD::List:GroupByIndex lst 1e-3)
)
(mapcar
'(lambda (x /)
(if (> (length x) 2)
(entmake
(list
'(0 . "line")
(cons 10
(apply 'Pnts:Center (cadr x))
)
(cons 11
(apply 'Pnts:Center (caddr x))
)
'(62 . 1)
)
)
)
)
lst
)
)
)
(princ)
)

(defun c:tt (/ ss pnts:center lst) 
  (defun Pnts:Center (pts) 
    (mapcar '(lambda (x) 
               (/ x 4.) 
             ) 
            (apply 'mapcar (cons '+ pts)) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "3DFACE")))) 
    (progn 
      (setq lst        (mapcar        '(lambda (x / pts p1 p2 p3) 
                           (setq pts (xdrx_entity_getstretchpoint x) 
                                 p1  (xdrx_line_midp (car pts) (cadr pts)) 
                                 p2  (xdrx_line_midp (cadr pts) (caddr pts)) 
                                 p3  (xdrx_line_midp (car pts) (caddr pts)) 
                           ) 
                           (list (list p1 pts) 
                                 (list p2 pts) 
                                 (list p3 pts) 
                           ) 
                         ) 
                        (xdrx_pickset->ents ss) 
                ) 
            lst        (apply 'append lst) 
            lst        (XD::List:GroupByIndex lst 1e-3) 
      ) 
      (mapcar 
        '(lambda (x /) 
           (if (> (length x) 2) 
             (entmake 
               (list 
                 '(0 . "line") 
                 (cons 10 
                       (apply 'Pnts:Center (cadr x)) 
                 ) 
                 (cons 11 
                       (apply 'Pnts:Center (caddr x)) 
                 ) 
                 '(62 . 1) 
               ) 
             ) 
           ) 
         ) 
        lst 
      ) 
    ) 
  ) 
  (princ) 
)

不可一次选择太多，对一个三角形会形成三个表，所以待分组的表数量是选择实体的 3 倍，在几百个实体时速度是很快的，对大量实体，分区域处理是最快方法

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

[每日一码] API应用 查找邻接三角形

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

[每日一码] API应用查找邻接三角形