[原创]二维点/三维点的错误
<p>画任意直线的垂线，可是结果是二维点/三维点的错误，请高手指点</p><p>(defun c:cx()<br/>(setvar "cmdecho" 0)<br/>(setq en(entsel "选择一条直线:"))<br/>(setq pp(getpoint "选择该直线上一点"))<br/>(setq l(getreal "输入垂线的长度"))<br/>(setq en_data(entget(car en)))<br/>(setq pts(assoc 10 en_data))<br/>(setq pte(assoc 11 en_data))<br/>(setq px1(car pts))<br/>(setq py1(cadr pts))<br/>(setq px2(car pte))<br/>(setq py2(cadr pte))<br/>(setq mp1(list pxi py1))<br/>(setq mp2(list px2 py2))<br/>(setq a(angle mp1 mp2))<br/>(setq pppp(polar pp (+ (/ pi 2) a) l))<br/>(setq ppp(polar pp (- (/ pi 2) a) l))<br/>(command "line" pppp ppp "")<br/>(princ)<br/>)</p> (defun c:cx ()(setvar "cmdecho" 0)
(if (setq en (entsel "选择一条直线:"))
(if (setq pp (getpoint "选择该直线上一点"))
(if (setq l (getreal "输入垂线的长度"))
(progn
(setq en_data (entget (car en)))
(setq pts (CDR (assoc 10 en_data)))
(setq pte (CDR (assoc 11 en_data)))
(setq Perpt (vlax-curve-getClosestPointTo (car en) pp T));找出垂点
(setq a (angle pts pte))
(setq pppp (polar Perpt (+ (* pi 0.5) a) l))
(setq ppp (polar Perpt (+ (* pi 1.5) a) l))
(entmake (APPEND '((0 . "LINE")
(100 . "AcDbEntity")
(100 . "AcDbLine")
(8 . "0")
)
(LIST (CONS 10 pppp) (CONS 11 ppp))
)
)
)
)
)
)
(princ)
)
<p>代码是楼主自己的吗？</p><p>(setq mp1(list px<font color="#ff0000">i</font> py1))</p><p>-》</p><p>(setq mp1(list px<font color="#0909f7">1</font> py1))</p> 谢谢BDYCAD，你的代码很好用，非常感谢！也谢谢caoyin指出错误，可是我改了后画出来的是水平线，我的代码还是由问题。 本帖最后由 作者 于 2009-1-13 9:20:54 编辑
;;;(defun c:cx ()
;;;(setvar "cmdecho" 0)
;;;(setq en (entsel "选择一条直线:"))
;;;(setq pp (getpoint "选择该直线上一点"))
;;;(setq l (getreal "输入垂线的长度"))
;;;(setq en_data (entget (car en)))
;;;(setq pts (assoc 10 en_data));此处取值错误，assoc返回的不是二维或三维点
;;;(setq pte (assoc 11 en_data));此处取值错误，assoc返回的不是二维或三维点
;;;(setq px1 (car pts));这里是什么意思？
;;;(setq py1 (cadr pts));这里是什么意思？
;;;(setq px2 (car pte))
;;;(setq py2 (cadr pte))
;;;(setq mp1 (list pxi py1));此处变量名称错误，此处的mp1不就是pts点么？
;;;(setq mp2 (list px2 py2))
;;;(setq a (angle mp1 mp2))
;;;(setq pppp (polar pp (+ (/ pi 2) a) l))
;;;(setq ppp (polar pp (- (/ pi 2) a) l))
;;;(command "line" pppp ppp "")
;;;(princ)
;;;)
;;更正如下：
(defun c:test ()
;;;(setvar "cmdecho" 0)
(setq en (entsel "选择一条直线:"))
(setq pp (getpoint "选择该直线上一点"))
(setq l (getreal "输入垂线的长度"))
(setq en_data (entget (car en)))
(setq pts (cdr(assoc 10 en_data)))
(setq pte (cdr(assoc 11 en_data)))
(setq a (angle pts pte))
(setq pppp (polar pp (+ a (/ pi 2)) l))
(setq ppp (polar pp (- a (/ pi 2)) l));;此处就是你画出来时水平线的原因，变量换个方向即可，否则ppp点可能不是所要的点
(command "pline" pppp pp ppp "")
(princ)
)
更简洁的代码如下：
(defun c:test ()
(setq en (entsel "选择一条直线:")
pp (getpoint "选择该直线上一点")
l (getreal "输入垂线的长度")
en_data (entget (car en))
pts (cdr (assoc 10 en_data))
pte (cdr (assoc 11 en_data))
a (angle pts pte)
pppp (polar pp (+ a (/ pi 2)) l)
ppp (polar pp (- a (/ pi 2)) l);;此处就是你画出来的是水平线的原因，变量换个方向即可，否则ppp点可能不是所要的点
)
(command "pline" pppp pp ppp "")
(princ)
)
BDYCAD的代码画不出线。 本帖最后由 作者 于 2009-1-13 11:09:01 编辑
以下代码可以在直线上连续画其垂线，如果是曲线，能取得曲线所点击处的斜率，那么就可以适用于曲线上画其垂线了。
请大家看看，修改成对于任意的直线、曲线均适用的程序！
还有就是，在选取直线（曲线）上的点时，加入一个函数，用以只能限制在直线上来选点。
;; 选取直线画其垂直线
(defun c:test2 (/ en l en_data pts pte a pp Perpt pt1 pt2)
(if (setq en (entsel "选择一条直线:"))
(progn
(setq l (getreal "输入垂线的长度")
en_data (entget (car en))
pts (cdr (assoc 10 en_data))
pte (cdr (assoc 11 en_data))
a (angle pts pte)
)
(while (setq pp (getpoint "点选该曲线上一点"))
(setq Perpt (vlax-curve-getClosestPointTo (car en) pp T);找出垂点
pt1 (polar Perpt (+ a (/ pi 2)) l)
pt2 (polar Perpt (- a (/ pi 2)) l)
;;此处就是你画出来的是水平线的原因，变量换个方向即可，否则ppp点可能不是所要的点
)
(command "pline" pt1 Perpt pt2 "")
)
)
)
(princ)
)作曲线上一点切线 http://zml84.blog.sohu.com/64440094.htmlAutoCAD中特定角度及长度捕捉的实现方法 http://zml84.blog.sohu.com/104345923.html
已经完成，对于任意曲线的垂线均适用，见下面代码：
(defun c:test (/ en len OBJ pt Perpt LST ANG pt1 pt2 OBJ)
(if (setq en (entsel "选择一条曲线:"))
(if (setq len (getreal "输入垂线长度\n")) ;此处要加入非法输入的控制
(progn
(setq OBJ (vlax-ename->vla-object (car en)))
(while (setq pt (getpoint "选择该直线上一点"))
(setq Perpt (vlax-curve-getClosestPointTo OBJ pt T)
LST (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
ANG (atan (/ (cadr LST) (car LST)))
pt1 (polar Perpt (+ ANG (* 0.5 pi)) len)
pt2 (polar Perpt (- ANG (* 0.5 pi)) len)
;;此处就是你画出来的是水平线的原因，变量换个方向即可
)
(command "pline" pt1 Perpt pt2 "")
)
)
)
)
(princ)
)
页:
[1]