[求助]快速定义坐标原点的程序
<p><font face="楷体_GB2312" color="#ff0000" size="5">下面图片中的图形为多义线，现求一个程序，通过选择直线1和直线2，坐标原点自动定位到直线1和直线2的交点上。</font></p><p><font face="楷体_GB2312" color="#ff0000" size="5">请高手帮忙！谢谢!!</font></p> 本帖最后由 作者 于 2010-10-14 16:41:24 编辑 <br /><br /> <p><font face="Verdana">(defun c:tt()<br/> (command "ucs" "w" )<br/> (princ "\n选择第一边：")<br/> (setq e1 (entsel))<br/> (setq en1 (car e1)<br/> p01 (cadr e1)<br/> )<br/> (setq pt1 (vlax-curve-getClosestPointTo en1 p01)</font></p>
<p><font face="Verdana"> param (vlax-curve-getParamAtPoint en1 pt1)<br/> pt2 (vlax-curve-getPointAtParam en1 (fix param))</font></p>
<p><font face="Verdana"> )<br/> <br/> (princ "\n选择第二边：")<br/> (setq e2 (entsel))<br/> (setq en2 (car e2)<br/> p02 (cadr e2)<br/> )<br/> (setq pt3 (vlax-curve-getClosestPointTo en2 p02)<br/> param1 (vlax-curve-getParamAtPoint en2 pt3)<br/> <font color="#ff0000">pt4 (vlax-curve-getPointAtParam en2 (fix param1))</font></font></p>
<p><font face="Verdana"> )<br/> <br/> (setq pt5 (inters pt1 pt2 pt3 pt4 nil))<br/> (command "ucs" "n" pt5)<br/> )</font></p> <p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana" size="5">选择多义线的两个直线边后，报错：</font></p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana" size="5"></font> </p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana" color="#ff0000" size="5">ERROR: 参数类型错误: 二维/三维点: nil</font></p>
<p><font color="#ff0000" size="5"></font> </p>
<p><font color="#ff0000" size="5">期待高手解答！！！</font></p> mj520plus发表于2010-10-14 16:30:00static/image/common/back.gif选择多义线的两个直线边后，报错：
ERROR: 参数类型错误: 二维/三维点: nil
期待高手解答！！！
<p>红色区代码有误！楼上已修正！</p> <p><font color="#ff00ff" size="5"><strong>谢谢！果然是高手！</strong></font></p>
<p><font size="5"></font> </p>
<p><font size="5">现在我又遇到新的问题，上面的图形不是多义线的情况，<font style="BACKGROUND-COLOR: #ffffff" face="Verdana" size="5">选择多义线的两个直线边后</font>会出现如下错误：</font></p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana" color="#ff0000" size="5">命令: nil</font></p>
<p><font size="5"></font> </p>
<p><font color="#ff00ff" size="5">不知高手可有什么办法？即就是不管是炸开与否，都可以定义坐标原点!!!</font></p>
<p><font size="5"></font> </p>
<p><font size="5">期待答案！！！</font></p> <p>不是多义线也可以啊！但要保证两条直线是在一个平面上，若高程不同可不行！</p> <p><font face="楷体_GB2312" color="#ff00ff" size="5">刚刚又试用了一下，可以正常使用了！</font></p>
<p><font face="楷体_GB2312" color="#ff00ff" size="5"></font> </p>
<p><font face="楷体_GB2312" color="#ff00ff" size="5">谢谢！以后还请多指点！</font></p>
;选择两线定坐标原点 明经 ZZXXQQ 2010.10.14
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (and (setq s1 (entsel "\n选择一条线 :"))
(setq pt2 (osnap (cadr s1) "NEAR"))
(setq s2 (entsel "\n选择第二条线 :"))
(setq pt4 (osnap (cadr s2) "NEAR"))) (progn
(setq pt1 (polar pt2 (+ (/ pi 2) (angle pt2 (cadr s1))) 10)
pt3 (polar pt4 (+ (/ pi 2) (angle pt4 (cadr s2))) 10)
po (inters pt1 pt2 pt3 pt4 nil))
(command ".UCS" "_O" po)
))
(setvar "CMDECHO" 1)
(princ)
)
我也常須用到這個功能<div>上面程序2002沒法用</div><div>請問有2002版可用的版本嗎?</div><div>謝謝!!</div> lincctw_ccl发表于2010-10-18 9:28:00static/image/common/back.gif我也常須用到這個功能
上面程序2002
页:
[1]
2