[原创]二维点/三维点的错误

fedd

画任意直线的垂线，可是结果是二维点/三维点的错误，请高手指点

(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))
(setq pte(assoc 11 en_data))
(setq px1(car pts))
(setq py1(cadr pts))
(setq px2(car pte))
(setq py2(cadr pte))
(setq mp1(list pxi py1))
(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)
)

BDYCAD

2. (defun c:cx ()
3.   (setvar "cmdecho" 0)
4.   (if (setq en (entsel "选择一条直线:"))
5.     (if (setq pp (getpoint "选择该直线上一点"))
6.       (if (setq l (getreal "输入垂线的长度"))
7. (progn
8.    (setq en_data (entget (car en)))
9.    (setq pts (CDR (assoc 10 en_data)))
10.    (setq pte (CDR (assoc 11 en_data)))
11.    (setq Perpt (vlax-curve-getClosestPointTo (car en) pp T));找出垂点
12.    (setq a (angle pts pte))
13.    (setq pppp (polar Perpt (+ (* pi 0.5) a) l))
14.    (setq ppp (polar Perpt (+ (* pi 1.5) a) l))
15.    (entmake (APPEND '((0 . "LINE")
16.         (100 . "AcDbEntity")
17.         (100 . "AcDbLine")
18.         (8 . "0")
19.        )
20.       (LIST (CONS 10 pppp) (CONS 11 ppp))
21.      )
22.    )
23. )
24.       )
25.     )
26.   )
27.   (princ)
28. )

(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) )

caoyin

代码是楼主自己的吗？

(setq mp1(list pxi py1))

-》

(setq mp1(list px1 py1))

fedd

谢谢BDYCAD，你的代码很好用，非常感谢！也谢谢caoyin指出错误，可是我改了后画出来的是水平线，我的代码还是由问题。

jxphklibin

;;;(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)
;;;)

3. ;;更正如下：
4. (defun c:test ()
5. ;;;  (setvar "cmdecho" 0)
6.   (setq en (entsel "选择一条直线:"))
7.   (setq pp (getpoint "选择该直线上一点"))
8.   (setq l (getreal "输入垂线的长度"))
9.   (setq en_data (entget (car en)))
10.   (setq pts (cdr(assoc 10 en_data)))
11.   (setq pte (cdr(assoc 11 en_data)))
12.   (setq a (angle pts pte))
13.   (setq pppp (polar pp (+ a (/ pi 2)) l))
14.   (setq ppp (polar pp (- a (/ pi 2)) l));;此处就是你画出来时水平线的原因，变量换个方向即可，否则ppp点可能不是所要的点
15.   (command "pline" pppp pp ppp "")
16.   (princ)
17. )

;;更正如下： (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) )

更简洁的代码如下：

2. [CODE]
3. (defun c:test ()
4.   (setq en (entsel "选择一条直线:")
5. pp (getpoint "选择该直线上一点")
6. l (getreal "输入垂线的长度")
7. en_data (entget (car en))
8. pts (cdr (assoc 10 en_data))
9. pte (cdr (assoc 11 en_data))
10. a (angle pts pte)
11. pppp (polar pp (+ a (/ pi 2)) l)
12. ppp (polar pp (- a (/ pi 2)) l);;此处就是你画出来的是水平线的原因，变量换个方向即可，否则ppp点可能不是所要的点
13.   )
14.   (command "pline" pppp pp ppp "")
15.   (princ)
16. )

[CODE] (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) )

[/code]

1. BDYCAD的代码画不出线。

复制代码

jxphklibin

以下代码可以在直线上连续画其垂线，如果是曲线，能取得曲线所点击处的斜率，那么就可以适用于曲线上画其垂线了。
请大家看看，修改成对于任意的直线、曲线均适用的程序！
还有就是，在选取直线（曲线）上的点时，加入一个函数，用以只能限制在直线上来选点。

2. ;; 选取直线画其垂直线
3. (defun c:test2 (/ en l en_data pts pte a pp Perpt pt1 pt2)
4.   (if (setq en (entsel "选择一条直线:"))
5.     (progn
6.       (setq l     (getreal "输入垂线的长度")
7.      en_data (entget (car en))
8.      pts     (cdr (assoc 10 en_data))
9.      pte     (cdr (assoc 11 en_data))
10.      a     (angle pts pte)
11.       )
12.       (while (setq pp (getpoint "点选该曲线上一点"))
13. (setq Perpt (vlax-curve-getClosestPointTo (car en) pp T);找出垂点
14.        pt1   (polar Perpt (+ a (/ pi 2)) l)
15.        pt2   (polar Perpt (- a (/ pi 2)) l)
16.       ;;此处就是你画出来的是水平线的原因，变量换个方向即可，否则ppp点可能不是所要的点
17. )
18. (command "pline" pt1 Perpt pt2 "")
19.       )
20.     )
21.   )
22.   (princ)
23. )

;; 选取直线画其垂直线 (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

已经完成，对于任意曲线的垂线均适用，见下面代码：

2. (defun c:test (/ en len OBJ pt Perpt LST ANG pt1 pt2 OBJ)
3.   (if (setq en (entsel "选择一条曲线:"))
4.     (if (setq len (getreal "输入垂线长度\n")) ;此处要加入非法输入的控制
5.       (progn
6. (setq OBJ (vlax-ename->vla-object (car en)))
7. (while (setq pt (getpoint "选择该直线上一点"))
8.    (setq Perpt (vlax-curve-getClosestPointTo OBJ pt T)
9.     LST   (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
10.     ANG   (atan (/ (cadr LST) (car LST)))
11.     pt1   (polar Perpt (+ ANG (* 0.5 pi)) len)
12.     pt2   (polar Perpt (- ANG (* 0.5 pi)) len)
13.     ;;此处就是你画出来的是水平线的原因，变量换个方向即可
14.    )
15.    (command "pline" pt1 Perpt pt2 "")
16. )
17.       )
18.     )
19.   )
20.   (princ)
21. )

(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) )