xyp1964发表于2010-5-12 13:24:00static/image/common/back.gif51773(defun c:tt () (prompt \"\选取投影圆: \") (if (and (setq ss (ssget '((0 . \"CIRCLE\")))) (setq s1 (car (entsel \"\n选择投影中心线第1条边线: \"))
<p><strong><font color="#da2549" face="Verdana">选取投影圆:<br/>选择对象: 指定对角点: 找到 4 个<br/>选择对象:<br/>选择投影中心线第1条边线:<br/>选择投影中心线第2条边线: ; 错误: no function definition: VLAX-CURVE-GETCLOSESTPOINTTO</font></strong></p><p><strong><font color="#da2549" face="Verdana"></font></strong></p><p><strong><font color="#da2549" face="Verdana"></font></strong></p>
<p>(VL-LOAD-COM)</p><p>看上去好像捕捉点，还要补全。</p><p></p>
(command "line" "non" p1 "non" p2 "")
liu_kunlun发表于2010-5-12 16:48:00static/image/common/back.gif(command \"line\" \"non\" p1 \"non\" p2 \"\")
<p></p><p>还是有点问题：</p><p></p>
<p>在xyp1964基础上完善一下：</p><p>(defun c:tt ( / ss ea pa1 pa2 aga eb pb1 pb2 agb i e pt p1 p2)<br/> (prompt "\选取投影圆: ")<br/> (if (and (setq ss (ssget '((0 . "CIRCLE"))))<br/> (setq ea (car (entsel "\n选择投影中心线第1条边线: "))) <br/> (= "LINE" (cdr (assoc 0 (setq ea (entget ea)))))<br/> (setq pa1 (cdr (assoc 10 ea))<br/> pa2 (cdr (assoc 11 ea))<br/> aga (angle pa1 pa2)<br/> ) <br/> (setq eb (car (entsel "\n选择投影中心线第2条边线: ")))<br/> (= "LINE" (cdr (assoc 0 (setq eb (entget eb)))))<br/> (setq pb1 (cdr (assoc 10 eb))<br/> pb2 (cdr (assoc 11 eb))<br/> agb (angle pb1 pb2)<br/> )<br/> )<br/> (progn<br/> (setq i -1)<br/> (while (setq e (ssname ss (setq i (1+ i))))<br/> (setq pt (cdr (assoc 10 (entget e)))<br/> p1 (inters pa1 pa2 pt (polar pt (+ aga (/ pi 2.)) 1.) nil)<br/> p2 (inters pb1 pb2 pt (polar pt (+ agb (/ pi 2.)) 1.) nil)<br/> )<br/> (command "line" "non" (polar p1 (angle p2 p1) 3.) "non" (polar p2 (angle p1 p2) 3.) "")<br/> )<br/> )<br/> )<br/> (princ)<br/>)</p>
<p>你改的很好了，谢谢。</p><p>现在这个程序，只在处理同心圆上，还有不足，可以应对绝大多数的情况。</p>
此时，如果用equal来排除同心圆，该如何写？
小妹丁发表于2010-5-15 0:16:00static/image/common/back.gif此时，如果用equal来排除同心圆，该如何写？分步骤来，不要急于绘制。
;;继续完善如下：
(defun c:tt (/ ss ea pa1 pa2 aga eb pb1 pb2 agb i e pt p1 p2)
(princ "\选取投影圆: ")
(if (and (setq ss (ssget '((0 . "CIRCLE"))))
;;
(setq en (car (entsel "\n选择第1条边线: ")))
(setq ent (entget en))
(setq pt10 (cdr (assoc 10 ent)))
(setq pt11 (cdr (assoc 11 ent)))
(setq ang1 (+(angle pt10 pt11)(* 0.5 pi)))
;;
(setq en (car (entsel "\n选择第2条边线: ")))
(setq ent (entget en))
(setq pt20 (cdr (assoc 10 ent)))
(setq pt21 (cdr (assoc 11 ent)))
(setq ang2 (+ (angle pt20 pt21)(* 0.5 pi)))
)
(progn
;;
(setq lst_pt '()
i 0
)
(repeat (sslength ss)
(setq en (ssname ss i)
ent (entget en)
)
(setq pt (cdr (assoc 10 ent)))
(if (member pt lst_pt)
()
(setq lst_pt (cons pt lst_pt))
)
(setq i (1+ i))
)
;;绘制
(foreach pt lst_pt
(setq
pt1 (inters pt10 pt11 pt (polar pt ang1 10) nil)
pt2 (inters pt20 pt21 pt (polar pt ang2 10) nil)
)
(command "line"
"non"
(polar pt1 (angle pt2 pt1) 3)
"non"
(polar pt2 (angle pt1 pt2) 3)
""
)
)
)
)
(princ)
)