荒野孤行 发表于 2013-9-8 20:40:18

[源码]批量绘制直线中垂线

本帖最后由 荒野孤行 于 2023-7-12 18:50 编辑

;;;***********绘制直线的中垂线 程序开始************
(defun c:zcx ()
(setvar "pickadd" 1)
(setvar "osmode" 15359)
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n★功能:批量绘制直线的中垂线.")
(setq ss (ssget '((0 . "LINE"))))
(if (null ss)
    (progn (princ "\n★提示:未选取直线!") (exit))
)
(setq n (sslength ss))
(setq i 0)
(setvar "osmode" 0)
(while (< i n)
    (setq entname (ssname ss i))
    (setq entdata (entget entname))
    (setq i (+ i 1))
    (setq ptqd (cdr (assoc 10 entdata)))
    (setq ptzd (cdr (assoc 11 entdata)))
    (setq dist (distance ptqd ptzd))
    (setq ang (angle ptqd ptzd))
    (setq ptqdx (car ptqd))
    (setq ptqdy (cadr ptqd))
    (setq ptzdx (car ptzd))
    (setq ptzdy (cadr ptzd))
    (setq ptzxx (/ (+ ptqdx ptzdx) 2))
    (setq ptzxy (/ (+ ptqdy ptzdy) 2))
    (setq
      pt1 (polar (list ptzxx ptzxy) (+ ang (angtof "90")) (/ dist 2))
    )
    (setq
      pt2 (polar (list ptzxx ptzxy) (+ ang (angtof "-90")) (/ dist 2))
    )
    (command "LAYER" "M" "中垂线" "C" "RED" "中垂线" "")
    (command "COLOR" "Bylayer")
    (command "LINE" pt1 pt2 "")
)
(command "undo" "e")
(setvar "osmode" 15359)
(princ)
)
;;;**************绘制直线的中垂线 程序结束**************

恕放之生命 发表于 2014-8-20 19:28:23

谢谢分享。

lucas_3333 发表于 2014-8-20 19:30:36

本帖最后由 lucas_3333 于 2014-8-20 19:48 编辑

只支持直线
http://bbs.mjtd.com/thread-95149-1-1.html

lgflysnow 发表于 2018-1-14 03:40:02

如果多些选择就更好了

yoyoho 发表于 2018-1-14 08:49:23

谢谢! 荒野孤行 分向程序!!!

zhangkui9070 发表于 2023-5-3 18:37:05

感谢分享，正好需要

ninja37 发表于 2023-5-5 18:56:42

谢谢分享{:1_1:}{:1_1:}{:1_1:}
页: [1]
查看完整版本: [源码]批量绘制直线中垂线