三维线条展开

夏生生 · 发表于 2015-5-19 08:20

本帖最后由夏生生于 2015-5-19 08:21 编辑

恳请各位帮忙解决个问题，谢谢
一系列三角元组成的带状三维图形，将其展开为平面图形，起始点可设置为'(0. 0. 0.)和起始角为pi
例图如下

x_s_s_1 · 发表于 2015-5-19 08:20

自己胡乱解决掉了，谢谢大家，感谢高飞鸟版主的矩阵，程序中没有的函数均详见高飞鸟版主的http://bbs.mjtd.com/thread-99926-3-1.html

(defun x_ssn (ss / n lst)
(repeat (setq N (sslength ss))
(setq LST (cons (ssname SS (setq N (1- N))) LST))
)
)
;;;消重
(defun deldup (ptLst alw / pt1)
(cond ((<= (length ptLst) 1) ptLst)
(t
(setq pt1 (car ptLst))
(cons pt1
(vl-remove-if
'(lambda (x) (equal pt1 x alw))
(deldup (cdr ptLst) alw)
)
)
)
)
)
;;;找重
(defun finddup (l1 / l2)
(while l1
(if (member (car l1) (cdr l1))
(setq l2 (append
l2
(list (car l1))
)
)
)
(setq l1 (vl-remove (car l1) l1))
)
l2
)
;;;两两组表
(defun buildlst (lst / a lst1)
(while (> (length lst) 1)
(setq a (car lst))
(setq lst (cdr lst))
(setq lst1 (cons (mapcar '(lambda (x) (list a x)) lst) lst1))
)
(apply 'append (reverse lst1))
)
;;;求交
(defun inter (en1 en2)
(list (inters (get_dxf en1 10)
(get_dxf en1 11)
(get_dxf en2 10)
(get_dxf en2 11)
)
en1
en2
)
)
;;;截取组码
(defun get_dxf (en num /) (cdr (assoc num (entget en))))
;;;反余弦
(defun acos (y)
(atan (sqrt (abs(- 1 (* y y)))) y)
)
;;;反正弦
(defun asin (y)
(-(/ pi 2)(acos y))
)
;;;表中删除表
(defun del_lst (lstdel lst /)
(repeat (length lstdel)
(setq lst (vl-remove-if '(lambda (x) (= x (car lstdel))) lst)lstdel(cdr lstdel))
)
lst
)
;;;共点则返回en2
(defun andpoint (en1 en2 /)
(if (or (equal (get_dxf en1 10) (get_dxf en2 10) 1e-6)
(equal (get_dxf en1 10) (get_dxf en2 11) 1e-6)
(equal (get_dxf en1 11) (get_dxf en2 10) 1e-6)
(equal (get_dxf en1 11) (get_dxf en2 11) 1e-6)
)
en2
nil
)
)
;;;图元表变为点表
(defun enlst->ptlst (enlst)
(deldup (append (mapcar '(lambda (x) (get_dxf x 10)) enlst)
(mapcar '(lambda (x) (get_dxf x 11)) enlst)
)
1e-6
)
)
;;;求两个面的夹角
(defun angle_f&f (ptlst1 ptlst2 / pt1 pt2 pt3 v1 v2 abc def)
(setq pt1 (car ptlst1)
pt2 (cadr ptlst1)
pt3 (caddr ptlst1)
)
(setq v1 (MAT:v-v pt1 pt2)
v2 (MAT:v-v pt1 pt3)
)
(setq abc (MAT:vxv v1 v2))
(setq pt1 (car ptlst2)
pt2 (cadr ptlst2)
pt3 (caddr ptlst2)
)
(setq v1 (MAT:v-v pt1 pt2)
v2 (MAT:v-v pt1 pt3)
)
(setq def (MAT:vxv v1 v2))
(acos (/ (MAT:Dot abc def)
(MAT:norm abc)
(MAT:norm def)
)
)
)
;;;求线与面的夹角
(defun angle_l&f (pta ptb ptlst / pt1 pt2 pt3 v1 v2 abc v)
(setq pt1 (car ptlst)
pt2 (cadr ptlst)
pt3 (caddr ptlst)
)
(setq v1 (MAT:v-v pt1 pt2)
v2 (MAT:v-v pt1 pt3)
)
(setq abc (MAT:vxv v1 v2))
(setq v(MAT:v-v pta ptb))
(asin (/ (abs(MAT:Dot abc v))
(MAT:norm abc)
(MAT:norm v)
)
)
)
(vl-load-com)
(defun c:ttt (/ ss enlst lst facelst intlst en1 en2 en3 face1 face2 ang
pt v objlst)
(setq ss (ssget))
;;;(setq enlst(x_ssn ss))
;;;拷贝一个表
(setq objlst (mapcar 'vla-copy
(mapcar 'vlax-ename->vla-object (x_ssn ss))
)
)
(setq enlst (mapcar 'vlax-vla-object->ename objlst))
;;;将原始坐标赋予图元
(foreach n enlst
(vlax-ldata-put
"coordinate"
(vlax-ename->vla-object n)
(list (get_dxf n 10) (get_dxf n 11))
)
)
(setq lst enlst)
;;;取得第一图元
(setq en1 (car enlst))
(setq facelst nil)
;;;以下循环开始
(while (> (length enlst) 2)
;;;从表中删除第一个图元
(setq enlst (del_lst (list en1) enlst))
(if (> (length enlst) 2)
(progn
;;;找出与第一个图元共点的图元
(setq
intlst
(vl-remove-if-not '(lambda (x) (andpoint en1 x)) enlst)
)
;;;两两组表
(setq intlst (mapcar '(lambda (x) (eval (cons 'inter x)))
(buildlst intlst)
)
)
;;;找到不相交的图元
(setq a (vl-remove-if '(lambda (x) (car x)) intlst))
;;;找到相交且交点不在第一图元端点的图元
(setq b (vl-remove-if
'(lambda (x)
(or (equal (car x) (get_dxf en1 10) 1e-6)
(equal (car x) (get_dxf en1 11) 1e-6)
)
)
(del_lst a intlst)
)
)
;;;取得第一面第二图元
(setq en2 (finddup (append (cdar a) (cdar b))))
;;;取得第二面第一图元亦即第一面第三图元
(setq en3 (del_lst en2 (cdar b)))
(setq facelst (cons (list en1 (car en2) (car en3)) facelst))
(setq enlst (del_lst en2 enlst))
(setq en1 (car en3))
)
(setq facelst (cons (cons en1 enlst) facelst))
)
)
(setq facelst (reverse facelst))
;;;循环开始
(while (> (length facelst) 1)
;;;求第二面与第一面夹角
(setq face1 (car facelst)
face2 (cadr facelst)
)
(setq ang (angle_f&f (enlst->ptlst face2) (enlst->ptlst face1))
pt (get_dxf (car face2) 10)
v (MAT:v-v (get_dxf (car face2) 11) pt)
)
(if (> ang (/ pi 2))
(setq ang (- pi ang))
)
(if (null (or (equal ang 0. 1e-6) (equal ang pi 1e-6)))
(mapcar '(lambda (x)
(vla-transformby
x
(vlax-tmatrix
(MAT:Rotation3D
pt
v
ang
)
)
)
)
(mapcar 'vlax-ename->vla-object (del_lst face1 lst))
)
)
(setq facelst (cdr facelst)
lst (del_lst (list (car face1) (cadr face1)) lst)
)
)
)

(defun x_ssn (ss / n lst) 
  (repeat (setq N (sslength ss)) 
    (setq LST (cons (ssname SS (setq N (1- N))) LST)) 
  ) 
) 
;;;消重 
(defun deldup (ptLst alw / pt1) 
  (cond        ((<= (length ptLst) 1) ptLst) 
        (t 
         (setq pt1 (car ptLst)) 
         (cons pt1 
               (vl-remove-if 
                 '(lambda (x) (equal pt1 x alw)) 
                 (deldup (cdr ptLst) alw) 
               ) 
         ) 
        ) 
  ) 
) 
;;;找重 
(defun finddup (l1 / l2) 
  (while l1 
    (if        (member (car l1) (cdr l1)) 
      (setq l2 (append 
                 l2 
                 (list (car l1)) 
               ) 
      ) 
    ) 
    (setq l1 (vl-remove (car l1) l1)) 
  ) 
  l2 
) 
;;;两两组表 
(defun buildlst        (lst / a lst1) 
  (while (> (length lst) 1) 
    (setq a (car lst)) 
    (setq lst (cdr lst)) 
    (setq lst1 (cons (mapcar '(lambda (x) (list a x)) lst) lst1)) 
  ) 
  (apply 'append (reverse lst1)) 
) 
;;;求交 
(defun inter (en1 en2) 
  (list        (inters        (get_dxf en1 10) 
                (get_dxf en1 11) 
                (get_dxf en2 10) 
                (get_dxf en2 11) 
        ) 
        en1 
        en2 
  ) 
) 
;;;截取组码 
(defun get_dxf (en num /) (cdr (assoc num (entget en)))) 
;;;反余弦 
(defun acos (y) 
   (atan (sqrt (abs(- 1 (* y y)))) y) 
) 
;;;反正弦 
(defun asin (y) 
  (-(/ pi 2)(acos y)) 
) 
;;;表中删除表 
(defun del_lst (lstdel lst /) 
  (repeat (length lstdel) 
    (setq lst (vl-remove-if '(lambda (x) (= x (car lstdel))) lst)lstdel(cdr lstdel)) 
  ) 
  lst 
) 
;;;共点则返回en2 
(defun andpoint        (en1 en2 /) 
  (if (or (equal (get_dxf en1 10) (get_dxf en2 10) 1e-6) 
          (equal (get_dxf en1 10) (get_dxf en2 11) 1e-6) 
          (equal (get_dxf en1 11) (get_dxf en2 10) 1e-6) 
          (equal (get_dxf en1 11) (get_dxf en2 11) 1e-6) 
      ) 
    en2 
    nil 
  ) 
) 
;;;图元表变为点表 
(defun enlst->ptlst (enlst) 
  (deldup (append (mapcar '(lambda (x) (get_dxf x 10)) enlst) 
                  (mapcar '(lambda (x) (get_dxf x 11)) enlst) 
          ) 
          1e-6 
  ) 
) 
;;;求两个面的夹角 
(defun angle_f&f (ptlst1 ptlst2 / pt1 pt2 pt3 v1 v2 abc def) 
  (setq        pt1 (car ptlst1) 
        pt2 (cadr ptlst1) 
        pt3 (caddr ptlst1) 
  ) 
  (setq        v1 (MAT:v-v pt1 pt2) 
        v2 (MAT:v-v pt1 pt3) 
  ) 
  (setq abc (MAT:vxv v1 v2)) 
  (setq        pt1 (car ptlst2) 
        pt2 (cadr ptlst2) 
        pt3 (caddr ptlst2) 
  ) 
  (setq        v1 (MAT:v-v pt1 pt2) 
        v2 (MAT:v-v pt1 pt3) 
  ) 
  (setq def (MAT:vxv v1 v2)) 
  (acos        (/ (MAT:Dot abc def) 
           (MAT:norm abc) 
           (MAT:norm def) 
        ) 
  ) 
) 
;;;求线与面的夹角 
(defun angle_l&f (pta ptb ptlst / pt1 pt2 pt3 v1 v2 abc v) 
  (setq        pt1 (car ptlst) 
        pt2 (cadr ptlst) 
        pt3 (caddr ptlst) 
  ) 
  (setq        v1 (MAT:v-v pt1 pt2) 
        v2 (MAT:v-v pt1 pt3) 
  ) 
  (setq abc (MAT:vxv v1 v2)) 
  (setq        v(MAT:v-v pta ptb)) 
  (asin        (/ (abs(MAT:Dot abc v)) 
           (MAT:norm abc) 
           (MAT:norm v) 
        ) 
  ) 
) 
(vl-load-com) 
(defun c:ttt (/        ss enlst lst facelst intlst en1        en2 en3        face1 face2 ang 
              pt v objlst) 
  (setq ss (ssget)) 
;;;(setq enlst(x_ssn ss)) 
;;;拷贝一个表 
  (setq        objlst (mapcar 'vla-copy 
                       (mapcar 'vlax-ename->vla-object (x_ssn ss)) 
               ) 
  ) 
  (setq enlst (mapcar 'vlax-vla-object->ename objlst)) 
;;;将原始坐标赋予图元 
  (foreach n enlst 
    (vlax-ldata-put 
      "coordinate" 
      (vlax-ename->vla-object n) 
      (list (get_dxf n 10) (get_dxf n 11)) 
    ) 
  ) 
  (setq lst enlst) 
;;;取得第一图元 
  (setq en1 (car enlst)) 
  (setq facelst nil) 
;;;以下循环开始 
  (while (> (length enlst) 2) 
;;;从表中删除第一个图元 
    (setq enlst (del_lst (list en1) enlst)) 
    (if        (> (length enlst) 2) 
      (progn 
;;;找出与第一个图元共点的图元 
        (setq 
          intlst 
           (vl-remove-if-not '(lambda (x) (andpoint en1 x)) enlst) 
        ) 
;;;两两组表 
        (setq intlst (mapcar '(lambda (x) (eval (cons 'inter x))) 
                             (buildlst intlst) 
                     ) 
        ) 
;;;找到不相交的图元 
        (setq a (vl-remove-if '(lambda (x) (car x)) intlst)) 
;;;找到相交且交点不在第一图元端点的图元 
        (setq b        (vl-remove-if 
                  '(lambda (x) 
                     (or (equal (car x) (get_dxf en1 10) 1e-6) 
                         (equal (car x) (get_dxf en1 11) 1e-6) 
                     ) 
                   ) 
                  (del_lst a intlst) 
                ) 
        ) 
;;;取得第一面第二图元 
        (setq en2 (finddup (append (cdar a) (cdar b)))) 
;;;取得第二面第一图元亦即第一面第三图元 
        (setq en3 (del_lst en2 (cdar b))) 
        (setq facelst (cons (list en1 (car en2) (car en3)) facelst)) 
        (setq enlst (del_lst en2 enlst)) 
        (setq en1 (car en3)) 
      ) 
      (setq facelst (cons (cons en1 enlst) facelst)) 
    ) 
  ) 
  (setq facelst (reverse facelst)) 
;;;循环开始 
  (while (> (length facelst) 1) 
;;;求第二面与第一面夹角 
    (setq face1        (car facelst) 
          face2        (cadr facelst) 
    ) 
    (setq ang (angle_f&f (enlst->ptlst face2) (enlst->ptlst face1)) 
          pt  (get_dxf (car face2) 10) 
          v   (MAT:v-v (get_dxf (car face2) 11) pt) 
    ) 
    (if        (> ang (/ pi 2)) 
      (setq ang (- pi ang)) 
    ) 
    (if        (null (or (equal ang 0. 1e-6) (equal ang pi 1e-6))) 
      (mapcar '(lambda (x) 
                 (vla-transformby 
                   x 
                   (vlax-tmatrix 
                     (MAT:Rotation3D 
                       pt 
                       v 
                       ang 
                     ) 
                   ) 
                 ) 
               ) 
              (mapcar 'vlax-ename->vla-object (del_lst face1 lst)) 
      ) 
    ) 
    (setq facelst (cdr facelst) 
          lst          (del_lst (list (car face1) (cadr face1)) lst) 
    ) 
  ) 
)

emk · 发表于 2015-5-19 08:51

是否可以这样，取得所有线段图元名及两端点坐标（（图元名（0 0 0）（100 20 50））（（图元名 ...））），按坐标排序，依次用一根线段两端点找相同点，如相同去该线另一端点测试，通过就按点位3维长度画平面图形，循环......
没详尽考虑，我的大概思路，还请e派、g版、z版......等大师出手

夏生生 · 发表于 2015-5-19 09:15

首先定端部面为初始面，将其移动并旋转至wcs（其它面一起相同转换矩阵移动旋转），图元表剔除初始面除面交线(黄色)外线，然后将第二面以面交线（黄色）旋转至wcs（其它面一起相同转换矩阵旋转），循环

yaokui25 · 发表于 2015-5-29 11:49

楼主，代码能否给我完整的，我用了2楼的代码加上高飞鸟的函数可还是执行不了。
出现下面的错误:
(or stringp symbolp): #<VLA-OBJECT IAcadLine 31f67584>
先谢谢了。

yaokui25 · 发表于 2015-5-29 11:56

楼主我有点有急用，您看看方便的话发个完整的好吗？

纵横八方 · 发表于 2021-9-1 17:21

参数类型错误: (or stringp symbolp): #<VLA-OBJECT IAcadLine 00000199b95ce358> 一样的BUG

ynhh · 发表于 2021-10-30 09:32

命令: TTT
选择对象: 指定对角点: 找到 9 个
选择对象: ; 错误: 参数类型错误: (or stringp symbolp): #<VLA-OBJECT IAcadLine 0000023bf53d7d58>

夏生生 · 发表于 2021-10-30 15:40

抱歉，好久没用了，我自己都不知道我写的是什么东西了

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

三维线条展开

最佳答案