CAD中心线命令zx加载程序语言.pdf

CAD 中心线命令“zx ” 加载程序 将以下程序字段复制粘贴到文本中，把文本格式改为.lsp 格式， 然后 CAD 进行加载（工具-AUTOLISP-加载应用程序，）选中文件 加载即可。程序段中文字标明可修改的部分，可以根据需要进行 修改。Q 1105532703 留言解决问题。CAD 命令”zx”, 回车，选中图 块确认，（单个或多个可选）效果如图： ;主程序 (defun c:zx ; 中心线 v1.3 （命令“zx ”可以修改的） (/ ss ss2 ss3 sslen ll entype minp maxp cen_po cen_u cen_d cen_fx cen_zx en en1 n si_si col lt lay sc1 sc2 sc3 sc4 p1 p2 p3 p4 p5 p6 p7 p8 p9 ang1 ang2 p5 p6 rr obj cr dr lst ptlst sscir lst2 d1 d2 d3 d4 sameptlen lst3 lst4 p55) (defun fy-LineFormat ;线的格式 (obj lay lt sc col / qm40) ; 图元名/obj 对象 图层 线型 圆0.8/线0.4 颜色 (vl-load-com) (if (= (type obj) ENAME) (setq obj (vlax-ename-vla-object obj))) (vla-put-layer obj lay) (vla-put-Linetype obj lt) (vla-put-Color obj col) (setq qm40 (cdr (assoc 40 (tblsearch ltype lt)))) (if (and (/= qm40 0) (/= sc 0)) (vla-put-LinetypeScale obj (* (vla-get-Length obj) (/ sc qm40 (getvar LTSCALE)))) ) (vla-update obj) (princ) ) (defun 2Line-center ;两线中心线 (en1 en2 / p1 p2 p3 p4 p5 p6 ang1 ang2 p1_2 p3_4) (setq p1 (vlax-curve-getstartpoint en1) p2 (vlax-curve-getendpoint en1) p3 (vlax-curve-getstartpoint en2) p4 (vlax-curve-getendpoint en2) p5 (inters p1 p2 p3 p4 nil) ) (cond (p5 ;不平行 (if si_si ;交叉线 (progn ;点选 (setq d1 (vlax-curve-getclosestpointto en1 (cadr (nth 3 (car ssx))))) (setq d2 (vlax-curve-getclosestpointto en2 (cadr (nth 3 (cadr ssx))))) (if (= (rtos (angle p5 d1) 2 8) (rtos (angle p5 p1) 2 8)) (setq d3 p1) (setq d3 p2)) (if (= (rtos (angle p5 d2) 2 8) (rtos (angle p5 p3) 2 8)) (setq d4 p3) (setq d4 p4)) (setq ang1 (angle p5 d3)) (setq ang2 (angle p5 d4)) (setq p6 (po