(defun c:tt(/ e p d)
(setq d(getreal"垂线长度"))
(setq d(if d d 10.0))
(while(setq e(car(entsel"\n拾取基准线")))
(while(setq p(getpoint"\n垂足位置"))
(entmakex(list'(0 . "line")(cons 10(setq p(vlax-curve-getclosestpointto e p)))
(cons 11(polar p(+(angle p(mapcar'+(vlax-curve-getfirstDeriv e(vlax-curve-getParamAtPoint e p))p))(* pi 0.5))d))))
))
(princ))
(defun c:csline (/ ENT PT SS X Y)
(while (and (setq ss (ssget ":S" '((0 . "line"))))
(setq pt (getpoint))
)
(setq ent (vlax-ename->vla-object (ssname ss 0)))
(setq ent (vla-copy ent))
(vla-Rotate ent (vlax-3d-point pt) (* 0.5 pi))
(vla-move ent
(vlax-3d-point
(mapcar '(lambda (x y)
(* 0.5 (+ x y))
)
(VLAX-SAFEARRAY->list
(VLAX-VARIANT-VALUE (vla-get-startpoint ent))
)
(VLAX-SAFEARRAY->list
(VLAX-VARIANT-VALUE (vla-get-endpoint ent))
)
)
)
(vlax-3d-point pt)
)
)
)
以该点为原点,以已有直线为X轴做坐标系,经过原点画Y轴方向直线
llsheng_73 发表于 2015-10-14 11:48 static/image/common/back.gif
谢谢关注，很好用！
lijiao 发表于 2015-10-14 14:33 static/image/common/back.gif
谢谢兄弟啦，正是我想要的
lijiao 发表于 2015-10-14 14:33 static/image/common/back.gif
拾取点改成拾取曲线, 自动计算交点, 不更好?
;;;*************************************
;;; No.2绘制垂线(任意曲线之垂线) 函数
;;; ---- By Ayunger Studio
;;;*************************************
(defun C:ayPerCurve1(/ xEntPick entName pickPt entData startPt endPt p1 p2 tempPT angofLine lenPerLine tanAngle)
(while (not (and (setq xEntPick (entsel "\n选择曲线: ")))))
(setq entName (car xEntPick))
(setq pickPt (cadr xEntPick))
(setq entData (entget entName))
(redraw entName 3)
(grdraw pickPt pickPt -1 1)
(setq startPt (getpoint (strcat "\n指定垂足点<默认拾取点>: " )))
(if (null startPt) (setq startPt pickPt))
(setq startPt (vlax-curve-getClosestPointTo entName (trans startPt 1 0)nil))
(setq lenPerLine (getdist (trans startPt 0 1) "\n指定垂线长: "))
(setq tanAngle (angle (trans '(0.0 0.0 0.0) 0 1)(trans (vlax-curve-getFirstDeriv entName
(vlax-curve-getparamatpoint entName
(vlax-curve-getclosestpointto entNamestartPt))) 0 1)))
(setq p1 (polar (trans startPt 0 1) (+ tanAngle (* PI 0.5)) lenPerLine))
(setq p2 (polar (trans startPt 0 1) (- tanAngle (* PI 0.5)) lenPerLine))
(ayOSMode nil);关闭捕捉.
(vl-cmdf "_.Line" P1 P2 "")
(redraw entName 4)
(princ)
);end_defun
;;;**************************
;;; No.0 对象捕捉开关 函数
;;;**************************
(defun ayOSMode (isOpenSnap)
(if isOpenSnap
(setvar "osmode" (rem (getvar "osmode") 703));打开捕捉.
(setvar "osmode" (+ (rem (getvar "osmode") 703) 703));关闭捕捉.
);end_if
);end_defun
adc 发表于 2015-10-15 11:24 static/image/common/back.gif
;;;*************************************
;;; No.2绘制垂线(任意曲线之垂线) 函数
;;; --- ...
程序给力，如果再支持块中实体，将更完美。
好不西，学习了！