求助完善(管线专用)长途杆路生成插件

jhzxj

求助：
插件能根据多段线长度自动生成约50米档距电杆杆路。但我想生成约65米左右距离一档，但不懂lisp语言，没有看懂程度上哪地方修改。只看明白修改字体高度、线条颜色修改。烦请论坛高手给予指点。

源程序如下：
;;;=========================================================================
;;;长途杆路绘制程序。根据一定比例绘制的光缆路由图，测量出某一直线档间的距
;;;离，再根据测量出的距离自动分配好杆距，并绘出杆路。杆路转角处根据偏转角
;;;度自动增加拉线。                        
;;;=========================================================================

;;;设定比例系数函数
(DEFUN bili()
(if (= r1 nil)
        (progn
        ;;;当没有比例系数
        (while (= r1 nil)
                (setq r0 (GETINT "\n输入比例,1:"))                                
                (if (> r0 0)(setq r1 r0))
                (if (= r0 nil)(setq r1 3721))
                (if (and(<= r0 0)(/= r0 nil))
                        (progn
                                (prompt "比例必须是大于“0”的整数，请重新输入！")
                                (setq r1 nil)
                        );end progn
                );endif
        );endwhile
        (if (= r1 3721)(setq r1 nil))
        );end progn
        
        (progn
        ;;;当已经有比例系数
        (setq r0 nil)
        (while (= r0 nil)
                (SETQ r0 (GETREAL (STRCAT "\n输入比例 1:<"(RTOS r1 2 0) ">")))                                
                (if (> r0 0)(setq r1 r0))
                (if (= r0 nil)(setq r0 r1))
                (if (and(<= r0 0)(/= r0 nil))
                        (progn
                                (prompt "比例必须是大于“0”的整数，请重新输入！")
                                (setq r0 nil)
                        );end progn
                );endif
        );endwhile
        );end progn
);endif
)

;;;生成杆路的函数
(DEFUN scgl(/ d p2 xp1 xp2 dis pm tang ta pd)
(SETQ d (/ (atof (rtos gju 2 4)) r0))                ;计算实际插入点R        
(SETQ p2 ( POLAR p1 a d))                                ;计算第二电杆插入点
(COMMAND "insert" "ntg" p2 "" "" "")                        ;插入电杆
(SETQ xp1( POLAR p1 (ANGLE p1 p2) 2.0))                        ;计算吊线起点
(SETQ xp2( POLAR p2 (ANGLE p2 p1) 2.0))                        ;计算吊线终点
(COMMAND "pline" xp1 xp2 "")                                ;画吊线
                                                        ;========================
(SETQ dis (DISTANCE P1 P2))                                ;计算吊线中点
(SETQ pm (POLAR p1 a (/ dis 2)))                        ;pm为吊线中点
(SETQ tang (REM (ATOI (ANGTOS a)) 360))                        ;计算标注文字方向(角度)
(IF (< tang 0 )(SETQ tang ( + 360 tang)))                ;如果角度是负值转化为正值
(SETQ ta (ANGTOF (RTOS tang)))                                ;将方向角度转换为弧度        
(IF (AND (> tang 90) (< tang 270))                        ;如果标注方向在90 -- 270度之间
        (PROGN                                                ;转换到-90 -- 90度之间        
                (SETQ tang (- tang 180))
                (SETQ ta (ANGTOF (RTOS tang)))
        );end of progn
);endif
(SETQ pd (POLAR pm (+ 1.5707963 ta) 2.5))                ;计算文字插入点
(COMMAND "text" "J" "M" pd "3" tang (RTOS gju 2 0))        ;以中点对齐方式标注距离
(setq p1 p2)
);end defun   



;;;主程序
(defun ctgl(/ ss ssb pt_b a osmo pt1 ent pt2 dist subdist a gdang subgdang gju cgdang ceco pw)
(SETVAR "cmdecho" 0)
(bili)
(if (/= nil r1)
(progn
(SETQ osmo (GETVAR "osmode"))
(setq ang nil)
(if (setq ss1(ssget '((0 . "LWPOLYLINE"))))
        (progn
          (setq ss ss1)
                (setq ssb(entget(ssname ss 0)))
                (setq pt_b(assoc '10 ssb))
                (setq pt1(cdr pt_b))
               (setq ent (ssget "w" (polar pt1 0.785 4) (polar pt1 3.927 4) '((2 . "ntg"))))
                (if (= ent nil)(COMMAND "insert" "ntg" pt1 "" "" ""))
                (setq ssb(cdr(member pt_b ssb)))
                (setq pt_b(assoc '10 ssb))
                (setq pt2(cdr pt_b))
                (setq subdist 0 subgdang 0)
                (while pt2
                        (SETVAR "osmode" 0)
                        (setq dist (distance pt1 pt2))
                        (setq a(angle pt1 pt2))
                        (setq dist (rtos (* dist r0) 2 0))
                        (prompt (strcat "\n此直线段长度为" dist "米；"))
                        (setq dist (atoi dist))
                        ;;;－－－－先计算杆档数
                        (if(> dist 408)
                                (progn
                                (setq gdang(/ dist 50))
                                (if (> (/ dist gdang) 50)(setq gdang (1+ gdang)))
                                );end progn
                        );end if
                        (if (and(> dist 364)(<= dist 408))(setq gdang 8))
                        (if (and(> dist 318)(<= dist 364))(setq gdang 7))
                        (if (and(> dist 270)(<= dist 318))(setq gdang 6))
                               (if (and(> dist 224)(<= dist 270))(setq gdang 5))
                        (if (and(> dist 180)(<= dist 224))(setq gdang 4))
                        (if (and(> dist 134)(<= dist 180))(setq gdang 3))
                        (if (and(> dist 76)(<= dist 134))(setq gdang 2))
                        (if (and(> dist 0)(<= dist 76))(setq gdang 1))
                        ;;;－－－－杆档数保存在gdang中
                        (setq gju(/ dist gdang))(setq cgdang(rem dist gdang))
                        (if (= 0 cgdang)
                                (prompt (strcat "可分成" (rtos gdang 2 0) "档，" "每档距离为" (rtos gju 2 0) "米。"))
                                (progn
                                        (prompt (strcat "距离为" (rtos gju 2 0) "米的" (rtos (- gdang cgdang) 2 0) "档，"))
                                        (prompt (strcat "距离为" (rtos (+ 1 gju) 2 0) "米的" (rtos cgdang 2 0) "档，"))
                                        (prompt (strcat "共" (rtos gdang 2 0) "档。"))
                                );end progn
                        );endif
                        (setq subdist (+ dist subdist) subgdang (+ gdang subgdang))
                        (prompt (strcat "\n－－累计总长度为" (rtos subdist 2 0) "米；" "共" (rtos subgdang 2 0) "档。"))
                        (SETQ ceco (GETVAR "cecolor"))
                        (SETQ pw (GETVAR "plinewid"))
                        (setvar "plinewid" 0.6)
                        (command "cecolor" "150")
                        (command "-style" "" "" 0.0 0.7 "" "" "")
                        (setq p1 pt1)
                        (repeat (- gdang cgdang)(scgl))
                        (setq gju(1+ gju))
                        (repeat cgdang (scgl))
                        (setvar "plinewid" pw)
                        (setvar "cecolor" ceco)
        ;;;插入拉线
                        (if ang
                                (progn
                                (setq an (angle pt2 pt1))
                                (if (/= (abs (- ang an)) pi)
                                        (progn
                                                (if (> (abs (- ang an)) pi)
                                                          (setq ann(+ pi (+ an(/ (- ang an) 2))))
                                                          (setq ann(+ an(/ (- ang an) 2)))
                                                  );end if
                                                (if (< (abs (- pi (abs(- an ang))))(* 0.25 pi))
                                                        (command "-insert" "nlx" pt1 "" "" (angtos ann 0 4))
                                                        (progn
                                                                (command "-insert" "nlx" pt1 "" "" (angtos ang 0 4))
                                                                (command "-insert" "nlx" pt1 "" "" (angtos an 0 4))
                                                        );end progn
                                                );end if
                                        );end progn
                                        (prompt "\n转角为零，不需要增加拉线！")
                                )
                                );end progn
                        );end if ang
                        ;;;结束插入拉线               
                                                
                        (setq ang (angle pt1 pt2))
                        (setq pt1 pt2)
                        
                        (setq ssb(cdr(member pt_b ssb)))
                        (setq pt_b(assoc '10 ssb))
                        (setq pt2(cdr pt_b))
                );end while pt2
       (command "erase" ss1 "" )
          );end progn
        (prompt "没有选取光缆路由，请重新选取！")
);end if
(SETVAR "osmode" osmo )
);end progn
(prompt "没有比例系数，程序无法执行！")
);end if
(princ)
);end program


(defun c:tt ( )
        (ctgl)
)

lee50310

jhzxj 发表于 2021-11-8 22:34
谢谢大神相助

改成這樣會比原先好用
1.去除 距離 取樣規則   (如果這規則你還需要再自行由舊版本 把規則項複製貼上)
2.新增前後 杆路的 圖例 (BLOCK)
3.新增判別若圖檔 無 NTG.DWG 及 NLX.DWG 兩圖塊 時則自動由目錄夾 BLK 載入
4.新增每檔距離改成 輸入詢問 並增加 記憶功能


程式執行指令:TT

程式路徑 設定 D:槽 的 Pole_road 資料夾內
假設你的  Pole_road 資料夾 是放 E槽
則須修改 长途杆路生成tt2.lsp  程式內的路徑設定
    (setq PATH "D:\\Pole_road\\")                        ;檔案路徑存放位置
改為
    (setq PATH "E:\\Pole_road\\")                        ;檔案路徑存放位置
即可

jhzxj

晚上再细看了下，档距的关键在于
(if (and(> dist 364)(<= dist 408))(setq gdang 8))
                        (if (and(> dist 318)(<= dist 364))(setq gdang 7))
                        (if (and(> dist 270)(<= dist 318))(setq gdang 6))
                               (if (and(> dist 224)(<= dist 270))(setq gdang 5))
                        (if (and(> dist 180)(<= dist 224))(setq gdang 4))
                        (if (and(> dist 134)(<= dist 180))(setq gdang 3))
                        (if (and(> dist 76)(<= dist 134))(setq gdang 2))
                        (if (and(> dist 0)(<= dist 76))(setq gdang 1))
再研究下为何设这条件原因

xg2010

请附上你的测试文件和源码，大家共同来研究

jhzxj

第一次发贴，忘记上传，见谅！

lee50310

每檔距離改成輸入+記憶功能比較方便

最新好用的 修改版 在 16 樓

jhzxj

lee50310 发表于 2021-11-8 17:20
每檔距離改成輸入+記憶功能比較方便

谢谢大神相助

jhzxj

lee50310 发表于 2021-11-8 17:20
每檔距離改成輸入+記憶功能比較方便

大神，我今天测试了下，将NTG和NLX图名更改自己喜欢名XJLX和XLGL，同时程序相应替换成相同名，测试时说函数错误。程序不能改对应的名称吗？

jhzxj

jhzxj 发表于 2021-11-8 22:50
大神，我今天测试了下，将NTG和NLX图名更改自己喜欢名XJLX和XLGL，同时程序相应替换成相同名，测试时说函 ...

是我弄错了，没加双引号下替换，结果将带有相应字母函数也替换了。我改了再试试。

烟盒迷唇

都1202年了，還在用command

jhzxj

xg2010 发表于 2021-11-7 22:25
请附上你的测试文件和源码，大家共同来研究

收到你的加好友信息，我的权限不够，论坛上加不了好友。加VX吧zxj700617