绘制垂线

yangchao2005090 · 发表于 2020-7-27 08:51

这是论坛上一个绘制垂线的代码，可以选择垂足和垂线长度，但是只能往垂足的一边绘制，是否可以选择垂足后往两边绘制指定长度的垂线呀

;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=169824&extra=&highlight=%B4%B9%CF%DF&page=2
(defun c:CCX(/ e p d)
(setq d(getreal"垂线长度[500]"))
(setq d(if d d 500));;改长度
(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)
)

zjy2999 · 发表于 2020-7-27 08:51

;画垂线cxx
(defun c:CCX(/ e p d)
  (setq d (getreal "垂线长度[50]" ))
  (setq d(if d d 50))  ;;改长度
  (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))  ))
   (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)
)

xmq1103 · 发表于 2020-7-28 13:31

不错不错，很好。

maiko · 发表于 2020-7-29 22:36

感谢楼主分享,收下了

maiko · 发表于 2020-7-29 22:40

感谢楼主分享,收下了

sunny_8848 · 发表于 2020-8-1 13:11

本帖最后由 sunny_8848 于 2020-8-1 13:32 编辑

解决了，win 10系统的问题

松树石头哥 · 发表于 2020-11-19 10:14

感谢楼主分享！！

20060510412 · 发表于 2021-2-22 11:39

zjy2999 发表于 2020-7-27 08:51
;画垂线cxx
(defun c:CCX(/ e p d)
(setq d (getreal "垂线长度[50]" ))

程序真不错，学习了。

疯球 · 发表于 2022-6-11 16:40

为啥我提示：输入的字符串有缺陷

下文没句号。 · 发表于 2022-6-15 11:48

zjy2999 发表于 2020-7-27 08:51
;画垂线cxx
(defun c:CCX(/ e p d)
(setq d (getreal "垂线长度[50]" ))

怎么我复制到来用就不行呢？

账号		自动登录	找回密码
密码			注册

绘制垂线

最佳答案