作曲线上一点切线

分类:lisp函数 | 标签: lisp   曲线   切线  
2007-09-19 10:44 阅读(?)评论(0)

作曲线上一点切线.LSP


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

   阅读(?)评论(0)
 
表  情:
加载中...
 

请各位遵纪守法并注意语言文明