[求助]很长时间没碰程序，帮忙看下。

小妹丁

楼上的很好了，太谢谢每一个帮忙的人。

好像我从来没明白过，member，foreach函数，昨晚查相关资料，也是越看越害怕，越看越头痛。

equal函数可直接比较，就觉得它好懂事，可是当同心圆超过三层时，它总会重复画多一条，有没有办法刮刮它的小鼻子，治治它的调皮劲？

eachy

2. ;;继续完善如下：
3. (defun c:tt (/ ss en sp1 sp2 ep1 ep2 an1 sl i pcen ptl p p1 p2)
4.   (vl-load-com)
5.   (princ "\选取投影圆: ")
6.   (if (and (setq ss (ssget '((0 . "CIRCLE"))))
7.     (setq en  (car (entsel "\n选择第1条边线: "))
8.    sp1 (vlax-curve-getstartpoint en);_针对本例这个更方便
9.    ep1 (vlax-curve-getendpoint en)
10.     )
11.     (setq en  (car (entsel "\n选择第2条边线: "))
12.    sp2 (vlax-curve-getstartpoint en)
13.    ep2 (vlax-curve-getendpoint en)
14.     )
15.       )
16.     (progn
17.       (setq sl (sslength ss)
18.      i -1
19.      an1 (+ (* 0.5 pi) (angle sp1 ep1)) ;_平行线垂线角度
20.       )
21.       (repeat sl
22. (setq
23.    pcen (cdr (assoc 10 (entget (ssname ss (setq i (1+ i))))))
24. ) ;_圆心
25. (if (member pcen ptl)
26.    nil
27.    (setq ptl (cons pcen ptl))
28. ) ;_构造圆心点表
29.       )
30.       (foreach p ptl
31. (setq
32.    p1 (inters sp1 ep1 p (polar p an1 10) nil) ;_圆心向第一条线的交点
33.    p2 (inters sp2 ep2 p (polar p an1 10) nil) ;_圆心向第二条线在交点
34. )
35. (command "_line"
36.    "_non"
37.    (polar p1 (angle p2 p1) 3) ;_交点、圆心方向延长 3
38.    "_non"
39.    (polar p2 (angle p1 p2) 3) ;_交点、圆心方向延长 3
40.    ""
41. )
42.       ) ;_end foreach
43.     )
44.   )
45.   (princ)
46. )

;;继续完善如下： (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) )

yoyoho

各位高手是否可以考虑让程序适用UCS坐标系统呢? 谢谢!

小妹丁

yoyoho发表于2010-5-16 11:33:00各位高手是否可以考虑让程序适用UCS坐标系统呢? 谢谢!

跟UCS坐标系，有什么关系？

飞诗(fsxm)

这题也不难，为啥就引来了众多高手跟版主呢？

MM就是人气高哈！呵呵

yoyoho

跟UCS坐标系，有什么关系？

因为程序在WCS世界座标系统运行O.K.

在UCS座标系统线会偏移喔!

小妹丁

fsxm发表于2010-5-16 14:40:00这题也不难，为啥就引来了众多高手跟版主呢？MM就是人气高哈！呵呵

对你倒是不难，哈

却难到了我，只好请神仙哥哥来帮忙。

有实用价值的东西，大家都愿意帮忙，不能不谢谢大家了。

小妹丁

yoyoho发表于2010-5-16 20:07:00跟UCS坐标系，有什么关系？

因为程序在WCS世界座标系统运行O.K.

在UCS座标系统线会偏移喔!

只要投影线与平行线和圆心对应，何苦在UCS中使劲，自找麻烦？

小妹丁

equal函数，我终于能用上了，没有重线，哈哈。