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

绘制垂线

这是论坛上一个绘制垂线的代码，可以选择垂足和垂线长度，但是只能往垂足的一边绘制，是否可以选择垂足后往两边绘制指定长度的垂线呀
;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"垂线长度"))
(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:20

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

不错不错，很好。

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

感谢楼主分享,收下了


                                 

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

感谢楼主分享,收下了

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

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

解决了，win 10系统的问题

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

感谢楼主分享！！

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

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


程序真不错，学习了。

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

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

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

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


怎么我复制到来用就不行呢？
页: [1] 2
查看完整版本: 绘制垂线