取直线上任意一点画垂线

llsheng_73

1. (defun c:tt(/ e p d)
   
2.   (setq d(getreal"垂线长度[10.0]"))
   
3.   (setq d(if d d 10.0))
   
4.   (while(setq e(car(entsel"\n拾取基准线")))
   
5.     (while(setq p(getpoint"\n垂足位置"))
   
6.       (entmakex(list'(0 . "line")(cons 10(setq p(vlax-curve-getclosestpointto e p)))
   
7.                 (cons 11(polar p(+(angle p(mapcar'+(vlax-curve-getfirstDeriv e(vlax-curve-getParamAtPoint e p))p))(* pi 0.5))d))))
   
8.       ))
   
9.   (princ))

(defun c:tt(/ e p d)<br />   (setq d(getreal"垂线长度[10.0]"))<br />   (setq d(if d d 10.0))<br />   (while(setq e(car(entsel"\n拾取基准线")))<br />     (while(setq p(getpoint"\n垂足位置"))<br />       (entmakex(list'(0 . "line")(cons 10(setq p(vlax-curve-getclosestpointto e p)))<br />                 (cons 11(polar p(+(angle p(mapcar'+(vlax-curve-getfirstDeriv e(vlax-curve-getParamAtPoint e p))p))(* pi 0.5))d))))<br />       ))<br />   (princ))

lijiao

2. (defun c:csline        (/ ENT PT SS X Y)
   
3.   (while (and (setq ss (ssget ":S" '((0 . "line"))))
   
4.               (setq pt (getpoint))
   
5.          )
   
6.     (setq ent (vlax-ename->vla-object (ssname ss 0)))
   
7.     (setq ent (vla-copy ent))
   
8.     (vla-Rotate ent (vlax-3d-point pt) (* 0.5 pi))
   
9.     (vla-move ent
   
10.               (vlax-3d-point
    
11.                 (mapcar        '(lambda (x y)
    
12.                            (* 0.5 (+ x y))
    
13.                          )
    
14.                         (VLAX-SAFEARRAY->list
    
15.                           (VLAX-VARIANT-VALUE (vla-get-startpoint ent))
    
16.                         )
    
17.                         (VLAX-SAFEARRAY->list
    
18.                           (VLAX-VARIANT-VALUE (vla-get-endpoint ent))
    
19.                         )
    
20.                 )
    
21.               )
    
22.               (vlax-3d-point pt)
    
23.     )
    
24.   )
    
25. )

(defun c:csline        (/ ENT PT SS X Y)<br />   (while (and (setq ss (ssget ":S" '((0 . "line"))))<br />               (setq pt (getpoint))<br />          )<br />     (setq ent (vlax-ename->vla-object (ssname ss 0)))<br />     (setq ent (vla-copy ent))<br />     (vla-Rotate ent (vlax-3d-point pt) (* 0.5 pi))<br />     (vla-move ent<br />               (vlax-3d-point<br />                 (mapcar        '(lambda (x y)<br />                            (* 0.5 (+ x y))<br />                          )<br />                         (VLAX-SAFEARRAY->list<br />                           (VLAX-VARIANT-VALUE (vla-get-startpoint ent))<br />                         )<br />                         (VLAX-SAFEARRAY->list<br />                           (VLAX-VARIANT-VALUE (vla-get-endpoint ent))<br />                         )<br />                 )<br />               )<br />               (vlax-3d-point pt)<br />     )<br />   )<br /> )

mjz521yy

以该点为原点,以已有直线为X轴做坐标系,经过原点画Y轴方向直线

cj52000

llsheng_73 发表于 2015-10-14 11:48

谢谢关注，很好用！

cj52000

lijiao 发表于 2015-10-14 14:33

谢谢兄弟啦，正是我想要的

jltx123456

lijiao 发表于 2015-10-14 14:33

拾取点改成拾取曲线, 自动计算交点, 不更好?

adc

;;;*************************************
;;; 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 entName  startPt))) 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

USER2128

adc 发表于 2015-10-15 11:24
;;;*************************************
;;; No.2  绘制垂线(任意曲线之垂线) 函数
;;;          --- ...

程序给力，如果再支持块中实体，将更完美。

xiaolong1487

好不西，学习了！