;;;=================================================================(vl-load-com);;;=================================================================;;;功能:绘制曲线上一点的切线或法线;;;日期:zml84 于 2007-08-06 11:40
;;;=================================================================
(vl-load-com)
;;;=================================================================
;;;功能:绘制曲线上一点的切线或法线
;;;日期:zml84 于 2007-08-06 11:40
(defun C:QQ (/ SS PT1 PT2 ANG LST OBJ ORT_OLD PT3 PT4 PT5)
(if (and (setq PT1 (getpoint "\n点取线上一点: "))
(setq SS (ssget PT1
’((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))
)
)
)
(progn
(princ "\n选择到了对象。")
;;将图元名转换为 VLA对象
(setq OBJ (vlax-ename->vla-object (ssname SS 0)))
;;距pt1最近的曲线上的点pt2
(setq PT2 (vlax-curve-getclosestpointto OBJ PT1))
;;pt2点的切线方向矢量
(setq LST (vlax-curve-getfirstderiv
OBJ
(vlax-curve-getparamatpoint
OBJ
PT2
)
)
)
;;计算切线方位角
(setq ANG (atan (/ (cadr LST) (car LST))))
;;计算切线上的一点
(setq PT3 (polar PT2 ANG 10))
;;计算垂线上一点
(setq PT4 (polar PT2 (+ ANG (* 0.5 pi)) 10))
;;设置用户坐标系
(command "_.UCS" "n" "3" PT2 PT3 PT4)
;;设置正交
(setq ORT_OLD (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 1) ;_打开正交模式
(if (setq PT5 (getpoint ’(0 0 0) "\n指定距离: "))
(command "_.line" "non" ’(0 0 0) "non" PT5 "")
)
;;恢复正交模式
(setvar "ORTHOMODE" ORT_OLD)
;;恢复用户坐标系
(command "_.UCS" "p")
)
)
(princ)
)
;;;=================================================================