关于画垂线的，哪位大佬给优化一下啊，拜托了

xj6019

caiqs 发表于 2019-12-18 12:38
恩明白你的意思了，晚上给你改一下吧

嗯 好的 拜托了，我说的捕捉不是你那个a切换捕捉中点，是根据需要捕捉到自己想要放的任何位置，先谢了！

xj6019

xyp1964 发表于 2019-12-18 00:54

谢谢版主，您给的关联函数，已经可以用了，已经满足了大部分情况的需要了，可不可以执行命令后能开启捕捉模式啊，现在如果想放到一个特定位置只能模糊放置，再手动移动一下，最好是可以自动捕捉需要放置的点，现在打开命令后鼠标就变成一个小矩形，我试着改了改代码，但是不会换成+可以捕捉的模式，麻烦您稍加修改可以吗，谢谢了

xj6019

caiqs 发表于 2019-12-18 19:51
;;;师兄QQ361865648，只是单纯的把你两个函数合并了
;;作了优化，原命令保留
;;用右键或回车切换中垂线和 ...

您好  我试了一下  不行呢  可出现切换  但是画不出线（确认一下 全部加载，命令是test是吧）

xj6019

caiqs 发表于 2019-12-18 19:51
;;;师兄QQ361865648，只是单纯的把你两个函数合并了
;;作了优化，原命令保留
;;用右键或回车切换中垂线和 ...

您好  这样切换确实挺得劲，就用现在这个模式吧，现在连普通直线的垂线都画不出来，您看看哪个代码环节出问题了啊，你代码问的为什么要用四个点， 这代码不是我写的，我也不懂，不过我也觉得没啥意义，您顺道给改了吧，我不知道怎么改，两个点定一条直线就好，麻烦了！！

caiqs

xj6019 发表于 2019-12-18 20:06
您好  这样切换确实挺得劲，就用现在这个模式吧，现在连普通直线的垂线都画不出来，您看看哪个代码环节出 ...

我只是给你合并了，其它原函数没动

xj6019

caiqs 发表于 2019-12-18 21:04
我只是给你合并了，其它原函数没动

也就是说对块，多段线，尺寸线等还是不行的是吧，运行不了，我也不知道效果哦，不过你这个切换模式非常好，期待您能在这个切换模式下完善一下呗

caiqs

;;试试这个吧，应该可以用了只要是曲线就行
;;圆椭圆多段线样条构造线射线都可以,按A可以锁定中点;;块可以了
(vl-load-com)
;;求两点之中点
(defun getmidpt        (p1 p2)
  (mapcar '(lambda (x)
             (* 0.5 x)
           )
          (mapcar '+ p1 p2)
  )
)
(defun getprep (spt ept p3 / tmppt intpt)
  (setq tmppt (polar p3 (+ (angle spt ept) (* 0.5 pi)) 10))
  (setq intpt (inters tmppt p3 spt ept nil))
)

;;;用A键切换中垂线和智能捕捉中点垂线
(defun c:ts2 (/              ang     ang1    endpt   ent     entdat  entpick
              etype   intpt   len     midpt   mode    p1      p2
              pickpt  pt      ret     startpt tmppt
             )
  (while (and
           (setq entpick (vl-catch-all-apply 'entsel '("\n選取直線 :")))
           (not (VL-CATCH-ALL-ERROR-P entpick))
         )

    (setq ent (car entpick))

    (setq entdat (entget ent)
          etype         (cdr (assoc 0 entdat))
    )
    (setq pickpt (cadr entpick)) ;_点取的点
    (cond
      ((member etype
               '("CIRCLE" "ELLIPSE" "RAY" "LINE" "XLINE" "SPLINE"
                 "LWPOLYLINE")
       )
       (setq intpt (vlax-curve-getClosestPointTo ent pickpt)) ;_最近点
      )
      (t (setq intpt (osnap pickpt "_nea")))
    )


    (setq ang1 (angle pickpt intpt))
    (setq
      ;;startpt (cdr (assoc 10 entdat))
      startpt (polar intpt (+ ang1 (* 0.5 PI)) 10)
      endpt   (polar intpt (- ang1 (* 0.5 PI)) 10)
      ;;  endpt          (cdr (assoc 11 entdat))
      ;;midpt          (getmidpt startpt endpt)
      midpt   (osnap intpt "_mid")
      ;;len          (DISTANCE startpt endpt)

      len     1000.0
      ang     (angle startpt endpt)
      mode    nil
    )
    (while (and
             (setq ret (grread t 12))
             (member (car ret) '(2 5))
           )
      (redraw)
      (cond
        ((= (car ret) 2) (setq mode (not mode)))
        (mode
         (cond
           ((member etype '("CIRCLE" "ELLIPSE" "RAY"))
            (setq intpt (cdr (assoc 10 entdat)))
           )
           (t
            (if        midpt
              (setq intpt midpt)
              (setq intpt (osnap pt "_mid"))
            )
           )
         )
        )
        ((= (car ret) 5)
         (setq pt (cadr ret))
;;;         (setq intpt (getprep startpt endpt pt))
         (setq intpt (osnap pt "_nea,_int,End,_mid,_cen,_qua,_tan"))
        )
      )
      (if (null intpt)
        (progn
          (setq tmppt (polar pt ang1 10))
          (setq intpt (INTERS pt tmppt startpt endpt nil))
        )
      )
      (setq p1 (polar intpt (+ ang (* 0.5 PI)) (* 0.5 len))
            p2 (polar intpt (- ang (* 0.5 pi)) (* 0.5 len))
      )
      (grdraw p1 p2 3 1)
    )
    (redraw)
    (if        (= (car ret) 3)
      (entmake (list '(0 . "LINE")
                     (cons 10 P1)
                     (cons 11 P2)
               )
      )
    )
  )

)

xj6019

caiqs 发表于 2019-12-18 21:11
;;试试这个吧，应该可以用了只要是曲线就行
;;圆椭圆多段线样条构造线射线都可以,按A可以锁定中点
(vl-lo ...

试了，可是还是不是我想要的结果，谢谢您的再次回复。
你试试加载版主回复的那个函数，我要的基本就是那个效果的，对尺寸线，块内的线，构造线都要起作用，那个函数也是不能指定垂足，如果可以指定垂足就完美了

xj6019

caiqs 发表于 2019-12-18 19:51
;;;师兄QQ361865648
;;;好人做到底，送佛送到西，好吧，现在块可以使用了，尺寸也可以了，不过要多响应一 ...

修改之后无比完美，请收下我的膝盖，太感谢了！！

panliang9

好贴标记一下。