<p>楼上的很好了，太谢谢每一个帮忙的人。</p><p>好像我从来没明白过，member，foreach函数，昨晚查相关资料，也是越看越害怕，越看越头痛。</p><p>equal函数可直接比较，就觉得它好懂事，可是当同心圆超过三层时，它总会重复画多一条，有没有办法刮刮它的小鼻子，治治它的调皮劲？</p>
;;继续完善如下：
(defun c:tt (/ ss en sp1 sp2 ep1 ep2 an1 sl i pcen ptl p p1 p2)
(vl-load-com)
(princ "\选取投影圆: ")
(if (and (setq ss (ssget '((0 . "CIRCLE"))))
(setq en(car (entsel "\n选择第1条边线: "))
sp1 (vlax-curve-getstartpoint en);_针对本例这个更方便
ep1 (vlax-curve-getendpoint en)
)
(setq en(car (entsel "\n选择第2条边线: "))
sp2 (vlax-curve-getstartpoint en)
ep2 (vlax-curve-getendpoint en)
)
)
(progn
(setq sl (sslength ss)
i -1
an1 (+ (* 0.5 pi) (angle sp1 ep1)) ;_平行线垂线角度
)
(repeat sl
(setq
pcen (cdr (assoc 10 (entget (ssname ss (setq i (1+ i))))))
) ;_圆心
(if (member pcen ptl)
nil
(setq ptl (cons pcen ptl))
) ;_构造圆心点表
)
(foreach p ptl
(setq
p1 (inters sp1 ep1 p (polar p an1 10) nil) ;_圆心向第一条线的交点
p2 (inters sp2 ep2 p (polar p an1 10) nil) ;_圆心向第二条线在交点
)
(command "_line"
"_non"
(polar p1 (angle p2 p1) 3) ;_交点、圆心方向延长 3
"_non"
(polar p2 (angle p1 p2) 3) ;_交点、圆心方向延长 3
""
)
) ;_end foreach
)
)
(princ)
)
<p><font color="#cc0033"><font color="#000000">各位高手是否可以考虑让程序适用</font>UCS</font>坐标系统呢? 谢谢!</p>
yoyoho发表于2010-5-16 11:33:00static/image/common/back.gif各位高手是否可以考虑让程序适用UCS坐标系统呢? 谢谢!
<p>跟<font color="#cc0033">UCS</font>坐标系，有什么关系？</p>
<p></p><p>这题也不难，为啥就引来了众多高手跟版主呢？</p><p>MM就是人气高哈！呵呵</p>
<p>跟<font color="#cc0033">UCS</font>坐标系，有什么关系？</p><p></p><p>因为程序在WCS世界座标系统运行O.K.</p><p>在UCS座标系统线会偏移喔!</p>
fsxm发表于2010-5-16 14:40:00static/image/common/back.gif这题也不难，为啥就引来了众多高手跟版主呢？MM就是人气高哈！呵呵
<p></p><p></p><p>对你倒是不难，哈</p><p>却难到了我，只好请神仙哥哥来帮忙。</p><p>有实用价值的东西，大家都愿意帮忙，不能不谢谢大家了。</p>
yoyoho发表于2010-5-16 20:07:00static/image/common/back.gif跟UCS坐标系，有什么关系？
<p></p><p>因为程序在WCS世界座标系统运行O.K.</p><p>在UCS座标系统线会偏移喔!</p></div><p>只要投影线与平行线和圆心对应，何苦在UCS中使劲，自找麻烦？</p>
equal函数，我终于能用上了，没有重线，哈哈。