[原创]：架空线路排位用的模版绘制程序

zhang8755

架空线路排位用的模版绘制程序

2. 
   
3.   [FONT=courier new]
   
4. (defun c:mb (/ dclfn dcl_id c k l ptl ptj cenx ceny cancel x y ddjl str1)
   
5.   (setq c 2)
   
6.   (setq dclfn (findfile "mb.dcl"))
   
7.   (if        (not dclfn)
   
8.          (progn
   
9.                 (alert "未找到文件 mb.dcl !!")
   
10.                 (exit)
    
11.          )
    
12.   )
    
13.   (setq dcl_id (load_dialog dclfn))
    
14.   (if        (not (new_dialog "mb" dcl_id))
    
15.          (progn
    
16.                 (alert "无法加载此文件 mb.dcl !!")
    
17.                 (exit)
    
18.          )
    
19.   )
    
20.   (action_tile "bl5" "(setq c 2)")
    
21.   (action_tile "bl2" "(setq c 5)")
    
22.   (action_tile "accept" "(base_accept)(setq cancel 0)")
    
23.   (action_tile "cancel" "(done_dialog)(setq cancel 1)")
    
24.   (start_dialog)
    
25.   (unload_dialog dcl_id)
    
26.   (if        (= cancel 0)
    
27.          (progn
    
28.                 (setq x (- (/ l 2)))
    
29.                 (while (<= x (/ l 2))
    
30.                   (setq y (/ (- (/ (+ (exp (* 2 k x)) (exp (- (* 2 k x)))) 2) 1)
    
31.                                                  (* 2 k)
    
32.                                          )
    
33.                   )
    
34.                   (setq ptl (append ptl (list (list (* (/ x 10) c) (* y c)))))
    
35.                   (setq x (+ 20 x))
    
36.                 )
    
37.                 (setq cenx (* l 0.05 c))
    
38.                 (setq ptj (mapcar '(lambda (x) (mapcar '+ (list cenx 0) x)) ptl))
    
39.                 (setq ceny (/ (- (cadr (car ptj)) 0) 3))
    
40.                 (command "pline")
    
41.                 (foreach n ptj (command n))
    
42.                 (command "")
    
43.                 (command "copy" (entlast) "" '(0 0) (list 0 (* ddjl c)))
    
44.                 (command "line" (list cenx -20)(list cenx (+ (cadr(car ptj)) (* ddjl c))) "")
    
45.                 (command "line" (list 0 ceny)(list (car (car (reverse ptj))) ceny) "")
    
46.                 (setq str1 (strcat "K=" (rtos (* k 10000)) "E-04,h=" (rtos ddjl 2 1) "m"))
    
47.                 (command "text" "j" "m" (list cenx (+ ceny 2.5)) "4" "0" str1)
    
48.                 (if (= c 2)
    
49.                         (command "text" "" "500/5000")
    
50.                         (command "text" "" "200/2000")
    
51.                 )
    
52.          )
    
53.   )
    
54. )
    
55. 
    
56. (defun base_accept ()
    
57.   (setq k (/ (atof (get_tile "k")) 10000))
    
58.   (setq l (atoi (get_tile "mbl")))
    
59.   (setq ddjl (atof (get_tile "ddjl")))
    
60.   (done_dialog)
    
61. )  
    
62. mb:dialog{
    
63.         label="模版绘制";
    
64.         :column{
    
65.                 fixed_width=true;
    
66.                 children_alignment=centered;
    
67.                 :edit_box{
    
68.                         label="本图K值(E-4):";
    
69.                         key="k";
    
70.                         edit_width=7;
    
71.                         edit_limit=6;
    
72.                         value="3.1000";
    
73.                         height=1.1;
    
74.                 }
    
75.                 :edit_box{
    
76.                         label="模版档距(米):";
    
77.                         key="mbl";
    
78.                         edit_width=7;
    
79.                         edit_limit=4;
    
80.                         value="1500";
    
81.                         height=1.1;
    
82.                 }
    
83.                 :edit_box{
    
84.                         label="对地距离(米):";
    
85.                         key="ddjl";
    
86.                         edit_width=7;
    
87.                         edit_limit=4;
    
88.                         value="7.5";
    
89.                         height=1.1;
    
90.                 }
    
91.                 :row{
    
92.                         children_alignment=top;
    
93.                         :text{label="制图比例:";}
    
94.                         :column{
    
95.                                 :radio_button{
    
96.                                         label="1/5000,1/500";
    
97.                                         key="bl5";
    
98.                                         value=1;
    
99.                                 }
    
100.                                 :radio_button{
     
101.                                         label="1/2000,1/200";
     
102.                                         key="bl2";
     
103.                                 }
     
104.                         }
     
105.                 }       
     
106.                 ok_cancel;
     
107.         }
     
108. }
     
109. [/FONT]
     

<br />   [FONT=courier new]<br /> (defun c:mb (/ dclfn dcl_id c k l ptl ptj cenx ceny cancel x y ddjl str1)<br />   (setq c 2)<br />   (setq dclfn (findfile "mb.dcl"))<br />   (if        (not dclfn)<br />          (progn<br />                 (alert "未找到文件 mb.dcl !!")<br />                 (exit)<br />          )<br />   )<br />   (setq dcl_id (load_dialog dclfn))<br />   (if        (not (new_dialog "mb" dcl_id))<br />          (progn<br />                 (alert "无法加载此文件 mb.dcl !!")<br />                 (exit)<br />          )<br />   )<br />   (action_tile "bl5" "(setq c 2)")<br />   (action_tile "bl2" "(setq c 5)")<br />   (action_tile "accept" "(base_accept)(setq cancel 0)")<br />   (action_tile "cancel" "(done_dialog)(setq cancel 1)")<br />   (start_dialog)<br />   (unload_dialog dcl_id)<br />   (if        (= cancel 0)<br />          (progn<br />                 (setq x (- (/ l 2)))<br />                 (while (<= x (/ l 2))<br />                   (setq y (/ (- (/ (+ (exp (* 2 k x)) (exp (- (* 2 k x)))) 2) 1)<br />                                                  (* 2 k)<br />                                          )<br />                   )<br />                   (setq ptl (append ptl (list (list (* (/ x 10) c) (* y c)))))<br />                   (setq x (+ 20 x))<br />                 )<br />                 (setq cenx (* l 0.05 c))<br />                 (setq ptj (mapcar '(lambda (x) (mapcar '+ (list cenx 0) x)) ptl))<br />                 (setq ceny (/ (- (cadr (car ptj)) 0) 3))<br />                 (command "pline")<br />                 (foreach n ptj (command n))<br />                 (command "")<br />                 (command "copy" (entlast) "" '(0 0) (list 0 (* ddjl c)))<br />                 (command "line" (list cenx -20)(list cenx (+ (cadr(car ptj)) (* ddjl c))) "")<br />                 (command "line" (list 0 ceny)(list (car (car (reverse ptj))) ceny) "")<br />                 (setq str1 (strcat "K=" (rtos (* k 10000)) "E-04,h=" (rtos ddjl 2 1) "m"))<br />                 (command "text" "j" "m" (list cenx (+ ceny 2.5)) "4" "0" str1)<br />                 (if (= c 2)<br />                         (command "text" "" "500/5000")<br />                         (command "text" "" "200/2000")<br />                 )<br />          )<br />   )<br /> )<br /> <br /> (defun base_accept ()<br />   (setq k (/ (atof (get_tile "k")) 10000))<br />   (setq l (atoi (get_tile "mbl")))<br />   (setq ddjl (atof (get_tile "ddjl")))<br />   (done_dialog)<br /> )  <br /> mb:dialog{<br />         label="模版绘制";<br />         :column{<br />                 fixed_width=true;<br />                 children_alignment=centered;<br />                 :edit_box{<br />                         label="本图K值(E-4):";<br />                         key="k";<br />                         edit_width=7;<br />                         edit_limit=6;<br />                         value="3.1000";<br />                         height=1.1;<br />                 }<br />                 :edit_box{<br />                         label="模版档距(米):";<br />                         key="mbl";<br />                         edit_width=7;<br />                         edit_limit=4;<br />                         value="1500";<br />                         height=1.1;<br />                 }<br />                 :edit_box{<br />                         label="对地距离(米):";<br />                         key="ddjl";<br />                         edit_width=7;<br />                         edit_limit=4;<br />                         value="7.5";<br />                         height=1.1;<br />                 }<br />                 :row{<br />                         children_alignment=top;<br />                         :text{label="制图比例:";}<br />                         :column{<br />                                 :radio_button{<br />                                         label="1/5000,1/500";<br />                                         key="bl5";<br />                                         value=1;<br />                                 }<br />                                 :radio_button{<br />                                         label="1/2000,1/200";<br />                                         key="bl2";<br />                                 }<br />                         }<br />                 }        <br />                 ok_cancel;<br />         }<br /> }<br /> [/FONT]<br />

jianly

晕，看不懂，是不是用AUTOCAD的LISP程序写的

mailhu

能传给我用吗?Mailhu@163.com

zhang8755

楼上的直接从帖子上拷贝下来存成文件就可以用了，还需要我给你传一份？

scan_2008

如何使用？请说明一下。

zhang8755

将前两个函数保存成MB.LSP,从‘mb:dialog{‘这一句开始到完保存成MB.DCL,在ACAD中用APPLOAD加载后键入MB执行。

scan_2008

出现这些：用的是ACAD2005
命令: _appload 已成功加载 MB.LSP。
命令: ; 错误: 参数类型错误: numberp: nil

mailhu

不错！很好用的，谢谢了

xwhh1314

scan_2008兄，mb.dcl文件应copy到ACAD的support目录下,顺便感谢张8755斑竹提供这么好用的东东。请教一下，你怎么把弧垂曲线和两基杆子精确相交，然后再一一切除剩余的曲线条呢？

sunpengyan

刚开始命名颠倒了，搞了半天：）还是很好用的。不过现在不是软件排杆更方便吗？

zhang8755

9楼的兄弟说的不是这个程序吧，而是我提供的排位程序中的功能吧，那个程序用的公式和这个不一样，上述的模板程序用的是以弧垂最低点为座标原点的公式，排位程序中用的是以悬挂点为座标原点的公式，所以不存在修剪多余部分的问题。

xwhh1314

zhang8755兄，我说的就是你提供的这个ｌｓｐ程序，用它生成模版曲线后，套在杆位上，多余的线条怎么办呢？

zhang8755

现在排位不用这个程序，模板程序是用在手工排位时的，用这个模板套在杆位上，多余的线条只好自己修剪掉了，可能会不准确，建议你试用我的排位程序。

xwhh1314

zhang8755兄，你的程序在哪里？

zhang8755

就在我的签名的链接--架空送电线路电气设计软件