求高手修改下程序 实现批量在2条直线的交点处画垂线 如何 ？

spp_wall

(defun C:qxcx (/ 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)
)
;;;=================================================================

xyp1964

2. 
   
3. (defun c:tt ()
   
4.   (setq dist (udist 3 "" "距离<输入或鼠标直接量取>" dist nil))
   
5.   (if (and (setq s1 (car (entsel "\n选择: ")))
   
6.            (xyp-curve-check s1)
   
7.       )
   
8.     (progn
   
9.       (redraw s1 3)
   
10.       (while (setq p1 (getpoint "\n基点<退出>: "))
    
11.         (setq pt (vlax-curve-getclosestpointto s1 p1))
    
12.         (xyp-faxian s1 pt dist)
    
13.       )
    
14.       (redraw s1 4)
    
15.     )
    
16.   )
    
17.   (princ)
    
18. )
    

<br /> (defun c:tt ()<br />   (setq dist (udist 3 "" "距离<输入或鼠标直接量取>" dist nil))<br />   (if (and (setq s1 (car (entsel "\n选择: ")))<br />            (xyp-curve-check s1)<br />       )<br />     (progn<br />       (redraw s1 3)<br />       (while (setq p1 (getpoint "\n基点<退出>: "))<br />         (setq pt (vlax-curve-getclosestpointto s1 p1))<br />         (xyp-faxian s1 pt dist)<br />       )<br />       (redraw s1 4)<br />     )<br />   )<br />   (princ)<br /> )<br />

JEJEming