求助完善(管线专用)长途杆路生成插件
本帖最后由 jhzxj 于 2021-11-7 22:39 编辑求助：
插件能根据多段线长度自动生成约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 于 2021-11-10 08:51 编辑
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\\") ;檔案路徑存放位置
即可
晚上再细看了下，档距的关键在于
(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))
再研究下为何设这条件原因 请附上你的测试文件和源码，大家共同来研究 第一次发贴，忘记上传，见谅！ 本帖最后由 lee50310 于 2021-11-10 05:28 编辑
每檔距離改成輸入+記憶功能比較方便
最新好用的 修改版 在 16 樓
lee50310 发表于 2021-11-8 17:20
每檔距離改成輸入+記憶功能比較方便
谢谢大神相助 lee50310 发表于 2021-11-8 17:20
每檔距離改成輸入+記憶功能比較方便
大神，我今天测试了下，将NTG和NLX图名更改自己喜欢名XJLX和XLGL，同时程序相应替换成相同名，测试时说函数错误。程序不能改对应的名称吗？ jhzxj 发表于 2021-11-8 22:50
大神，我今天测试了下，将NTG和NLX图名更改自己喜欢名XJLX和XLGL，同时程序相应替换成相同名，测试时说函 ...
是我弄错了，没加双引号下替换，结果将带有相应字母函数也替换了。我改了再试试。 都1202年了，還在用command xg2010 发表于 2021-11-7 22:25
请附上你的测试文件和源码，大家共同来研究
收到你的加好友信息，我的权限不够，论坛上加不了好友。加VX吧zxj700617