yangchao2005090 发表于 2017-12-27 11:23:27

论坛上动态垂线源码，求高手帮忙修改一下，回车直接退出程序

;;; Draw perpendicular line
;;; Alan J. Thompson, 10.15.09
(defun c:LPer (/ #Ent #Read)
(and
    (setq #Ent (car (entsel "\nSelect curve: ")))
    (vl-position (cdr (assoc 0 (entget #Ent))) '("LWPOLYLINE" "ARC" "LINE" "CIRCLE" "ELLIPSE"))
    (while (not (eq 25 (car (setq #Read (grread T 15 0)))))
      (princ "\rSpecify point for line: ")
      (redraw)
      (if (vl-consp (cadr #Read))
      (grdraw (vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T)
                (trans (cadr #Read) 1 0)
                1
      ) ;_ grdraw
      ) ;_ if
      (if (eq 3 (car #Read))
      (entmake (list '(0 . "LINE")
                     (cons 10 (vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T))
                     (cons 11 (trans (cadr #Read) 1 0))
               ) ;_ list
      ) ;_ entmake
      ) ;_ if
    ) ;_ while
) ;_ and
(redraw)
(princ)
) ;_ defun
论坛上动态垂线源码，求高手修改一下，回车直接退出程序

tianying307 发表于 2021-3-28 20:01:53

;;; Draw perpendicular line
;;; Alan J. Thompson, 10.15.09
(defun c:LPer (/ #Ent #Read)
(and
    (setq #Ent (car (entsel "\nSelect curve: ")))
    (vl-position (cdr (assoc 0 (entget #Ent))) '("LWPOLYLINE" "ARC" "LINE" "CIRCLE" "ELLIPSE"))
    (while (not (eq 2 (car (setq #Read (grread T 15 0)))))
      (princ "\rSpecify point for line: ")
      (redraw)
      (if (vl-consp (cadr #Read))
      (grdraw (vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T)
                (trans (cadr #Read) 1 0)
                1
      ) ;_ grdraw
      ) ;_ if
      (if (eq 3 (car #Read))
      (entmake (list '(0 . "LINE")
                     (cons 10 (vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T))
                     (cons 11 (trans (cadr #Read) 1 0))
               ) ;_ list
      ) ;_ entmake
      ) ;_ if
    ) ;_ while
) ;_ and
(redraw)
(princ)
)

sunny_8848 发表于 2021-3-30 12:52:13

挺好用的，多谢分享

LinBinFen 发表于 2024-4-25 16:25:16


好用，感谢分享！
页: [1]
查看完整版本: 论坛上动态垂线源码，求高手帮忙修改一下，回车直接退出程序