三维线条展开
本帖最后由 夏生生 于 2015-5-19 08:21 编辑恳请各位帮忙解决个问题，谢谢
一系列三角元组成的带状三维图形，将其展开为平面图形，起始点可设置为'(0. 0. 0.)和起始角为pi
例图如下
自己胡乱解决掉了，谢谢大家，感谢高飞鸟版主的矩阵，程序中没有的函数均详见高飞鸟版主的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)
)
)
) 是否可以这样，取得所有线段图元名及两端点坐标（（图元名 （0 0 0）（100 20 50））（（图元名 ...））），按坐标排序，依次用一根线段两端点找相同点，如相同去该线另一端点测试，通过就按点位3维长度画平面图形，循环......
没详尽考虑，我的大概思路，还请e派、g版、z版......等大师出手 首先定端部面为初始面，将其移动并旋转至wcs（其它面一起相同转换矩阵移动旋转），图元表剔除初始面除面交线(黄色)外线，然后将第二面以面交线（黄色）旋转至wcs（其它面一起相同转换矩阵旋转），循环
楼主，代码能否给我完整的，我用了2楼的代码加上高飞鸟的函数可还是执行不了。
出现下面的错误:
(or stringp symbolp): #<VLA-OBJECT IAcadLine 31f67584>
先谢谢了。 楼主我有点有急用，您看看方便的话发个完整的好吗？
参数类型错误: (or stringp symbolp): #<VLA-OBJECT IAcadLine 00000199b95ce358> 一样的BUG 命令: TTT
选择对象: 指定对角点: 找到 9 个
选择对象:; 错误: 参数类型错误: (or stringp symbolp): #<VLA-OBJECT IAcadLine 0000023bf53d7d58> 抱歉，好久没用了，我自己都不知道我写的是什么东西了
页:
[1]