蛇形敷设长度系数计算

yjwht

社区内建筑、水工、机械的比较多，咱们变电这个赛道比较冷门，蛇形敷设长度系数的计算虽然简单，但肯定没人写过这个代码。
电缆路径一般比较长，这个系数虽然不大，但还是不能拍脑袋的。之前是用EXCEL表格来算的。


代码中多段线绘制的command分多次书写，至少我感觉有些稀奇。获取多段线长度的这一句刚从本社区学会。

1. (defun c:y_sinx  (/ L1 B1 x y list1 p1 curve tlen)
   
2.   ;绘制正弦函数曲线的蛇形弧
   
3.   (vl-load-com)
   
4.   (setq v1(getvar "osmode"))
   
5.   (setq v2(getvar "cmdecho"))
   
6.   (setq v3(getvar "blipmode"))
   
7.   (setvar "osmode" 0)
   
8.   (setvar "cmdecho" 0)
   
9.   (setvar "blipmode" 0)
   
10.   (setq L1 (getint "\n请输入半个蛇形长度（mm）："))
    
11.   (setq B1 (getint "\n请输入蛇形弧幅宽（mm）："))
    
12.   (setq x 0.0) ;设置x初始值
    
13.   (setq list1 '()) ;设置空列表
    
14.   (while (<= x 360) ;x坐标从0°~360°
    
15.     (setq y (* (sin (* x (/ pi 180))) (* B1 0.5)))
    
16.     (setq p1 (list (/ (* x L1) 180) y))                    
    
17.     (setq list1 (cons p1 list1)) ;将p1点加入到列表中
    
18.     (setq x (1+ x)) ;x加1
    
19.   ) ;结束while
    
20.   (command "pline") ;绘制多段线
    
21.   (foreach point list1 ;从列表中逐个获取的点坐标赋值给point
    
22.     (command point) ;延续pline命令，将point作为直线的下一个端点添加
    
23.   ) ;结束foreach
    
24.   (command "") ;结束当前的AutoCAD命令
    
25.   (setq curve (vlax-ename->vla-object (entlast)))
    
26.   (setq tlen (vlax-curve-getdistatparam
    
27.      curve
    
28.      (vlax-curve-getendparam curve)
    
29.        )
    
30.   )
    
31.   (princ "\n蛇形敷设系数为：")
    
32.   (princ (/ tlen L1 2))
    
33.   (setvar "osmode" v1)
    
34.   (setvar "cmdecho" v2)
    
35.   (setvar "blipmode" v3)
    
36.   (princ)
    
37. )

(defun c:y_sinx  (/ L1 B1 x y list1 p1 curve tlen)<br />   ;绘制正弦函数曲线的蛇形弧<br />   (vl-load-com)<br />   (setq v1(getvar "osmode"))<br />   (setq v2(getvar "cmdecho"))<br />   (setq v3(getvar "blipmode"))<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (setvar "blipmode" 0)<br />   (setq L1 (getint "\n请输入半个蛇形长度（mm）："))<br />   (setq B1 (getint "\n请输入蛇形弧幅宽（mm）："))<br />   (setq x 0.0) ;设置x初始值<br />   (setq list1 '()) ;设置空列表<br />   (while (<= x 360) ;x坐标从0°~360°<br />     (setq y (* (sin (* x (/ pi 180))) (* B1 0.5))) <br />     (setq p1 (list (/ (* x L1) 180) y))                    <br />     (setq list1 (cons p1 list1)) ;将p1点加入到列表中<br />     (setq x (1+ x)) ;x加1<br />   ) ;结束while<br />   (command "pline") ;绘制多段线<br />   (foreach point list1 ;从列表中逐个获取的点坐标赋值给point<br />     (command point) ;延续pline命令，将point作为直线的下一个端点添加<br />   ) ;结束foreach<br />   (command "") ;结束当前的<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>命令<br />   (setq curve (vlax-ename->vla-object (entlast)))<br />   (setq tlen (vlax-curve-getdistatparam<br />      curve<br />      (vlax-curve-getendparam curve)<br />        )<br />   )<br />   (princ "\n蛇形敷设系数为：")<br />   (princ (/ tlen L1 2))<br />   (setvar "osmode" v1)<br />   (setvar "cmdecho" v2)<br />   (setvar "blipmode" v3)<br />   (princ)<br /> )

yjwht

练习二 拾取电缆回路编号 适用变电二次专业
框选拾取电缆回路编号，自动排序、自动复制到系统剪贴板，只需要粘贴到电缆清册的单元格中即可。

1. (defun c:sqbh (/ textList textString ss n i)
   
2. 
   
3.   (setq textList '())
   
4.   (setq textString "")
   
5. ;--------------框选拾取文本的方式-------------------
   
6.   (setq ss (ssget '((0 . "TEXT"))))
   
7.   (setq n (sslength ss))
   
8.   (setq i 0)
   
9.   (while (< i n)
   
10.   (setq obj (ssname ss i))
    
11.   (setq textVal (cdr (assoc 1 (entget obj))))
    
12.   (setq textList (cons textVal textList))
    
13.   (setq i (1+ i))
    
14.   )
    
15.   (setq textList (acad_strlsort textList))
    
16.   (foreach item  textList
    
17.     (if  (not (= textString ""))
    
18.       (setq textString (strcat textString ";" item))
    
19.       (setq textString item)
    
20.     )
    
21.   )
    
22.   (princ textString)
    
23.   (set-clip-string textString)
    
24.   (princ)
    
25. )
    
26. ;;;=================================================================*
    
27. ;;;功能：向系统剪贴板写入文字 ;下面这段代码在本社区复制而来                                     *
    
28. (defun set-clip-string (str / html result)
    
29.     (and (= (type str) 'str)
    
30.    (setq html (vlax-create-object "htmlfile"))
    
31.    (setq result (vlax-invoke
    
32.         (vlax-get (vlax-get html 'parentwindow)
    
33.             'clipboarddata
    
34.         )
    
35.         'setdata
    
36.         "text"
    
37.         str
    
38.           )
    
39.    )
    
40.    (vlax-release-object html)
    
41.     )
    
42. )
    
43. ;;;=================================================================*

(defun c:sqbh (/ textList textString ss n i)<br /> <br />   (setq textList '())<br />   (setq textString "")<br /> ;--------------框选拾取文本的方式-------------------<br />   (setq ss (ssget '((0 . "TEXT"))))<br />   (setq n (sslength ss))<br />   (setq i 0)<br />   (while (< i n)<br />   (setq obj (ssname ss i))<br />   (setq textVal (cdr (assoc 1 (entget obj))))<br />   (setq textList (cons textVal textList))<br />   (setq i (1+ i))<br />   )<br />   (setq textList (acad_strlsort textList))<br />   (foreach item  textList<br />     (if  (not (= textString ""))<br />       (setq textString (strcat textString ";" item))<br />       (setq textString item)<br />     )<br />   )<br />   (princ textString)<br />   (set-clip-string textString)<br />   (princ)<br /> )<br /> ;;;=================================================================*<br /> ;;;功能：向系统剪贴板写入文字 ;下面这段代码在本社区复制而来                                     *<br /> (defun set-clip-string (str / html result)<br />     (and (= (type str) 'str)<br />    (setq html (vlax-create-object "htmlfile"))<br />    (setq result (vlax-invoke<br />         (vlax-get (vlax-get html 'parentwindow)<br />             'clipboarddata<br />         )<br />         'setdata<br />         "text"<br />         str<br />           )<br />    )<br />    (vlax-release-object html)<br />     )<br /> )<br /> ;;;=================================================================*

yjwht

练习三 接头最小接触面积计算 变电一次

1. tou_area:dialog{
   
2.   label="接头最小接触面积计算";
   
3.   :column{
   
4.     :edit_box{
   
5.     label="工作电流（A）";
   
6.     key="Ieg";
   
7.   }
   
8.   :row{
   
9.     :text{label="无镀层接头材质";}
   
10.     :popup_list{key="pop_mat";edit_width=8;
    
11.       list="铜-铜\n铝-铝";}
    
12.   }
    
13.   :concatenation{
    
14.     :text_part{label="电流密度【";}
    
15.     :text{width=6;key="txt_den";}
    
16.     :text_part{label="】（A/mm2）";}
    
17.   }
    
18.   :concatenation{
    
19.     :text_part{label="最小接触面积【";}
    
20.     :text{width=6;key="txt_area";}
    
21.     :text_part{label="】（mm2）";}
    
22.   }
    
23.   spacer_1;
    
24.   :text{label="注：铜-铝接头按铝-铝接头计算。";}
    
25.   }
    
26.   spacer_1;
    
27.   :row{
    
28.     alignment="centered";
    
29.     :button{label="计算";key="but_cal";
    
30.     width=6;fixed_width=true;
    
31.   }
    
32.   cancel_button;
    
33.   }
    
34. }

tou_area:dialog{<br />   label="接头最小接触面积计算";<br />   :column{<br />     :edit_box{<br />     label="工作电流（A）";<br />     key="Ieg";<br />   }<br />   :row{<br />     :text{label="无镀层接头材质";}<br />     :popup_list{key="pop_mat";edit_width=8;<br />       list="铜-铜\n铝-铝";}<br />   }<br />   :concatenation{<br />     :text_part{label="电流密度【";}<br />     :text{width=6;key="txt_den";}<br />     :text_part{label="】（A/mm2）";}<br />   }<br />   :concatenation{<br />     :text_part{label="最小接触面积【";}<br />     :text{width=6;key="txt_area";}<br />     :text_part{label="】（mm2）";}<br />   }<br />   spacer_1;<br />   :text{label="注：铜-铝接头按铝-铝接头计算。";}<br />   }<br />   spacer_1;<br />   :row{<br />     alignment="centered";<br />     :button{label="计算";key="but_cal";<br />     width=6;fixed_width=true;<br />   }<br />   cancel_button;<br />   }<br /> }

1. (defun c:tou_area ()
   
2.   (setq k1 1.0 k2 0.12)
   
3.   (dcl_tou_area)
   
4.   (prin1)
   
5. )
   
6. (defun dcl_tou_area ()
   
7.   (setq dcl_id (load_dialog "我的lisp\\tou_area"))
   
8.   (new_dialog "tou_area" dcl_id)
   
9.   (action_tile "pop_mat" "(sub_pop $value)")
   
10.   (action_tile "but_cal" "(area_cal)")
    
11.   (action_tile "cancel" "(done_dialog 0)")
    
12.   (setq dd (start_dialog))
    
13. )
    
14. (defun area_cal  ()
    
15.   (ini_1)
    
16.   (setq i1 (atof (get_tile "Ieg")))
    
17.   (cond ((< i1 200) (setq k2 0.31))
    
18.     ((<= i1 2000)
    
19.       (setq k2 (- 0.31 (* (- i1 200) 1.05 0.0001))))
    
20.     ((> i1 2000) (setq k2 0.12))
    
21.   )
    
22.   (setq k (* k1 k2))
    
23.   (setq area1 (/ i1 k))
    
24.   (setq str1 (rtos area1 2 0))
    
25.   (set_tile "txt_den" (rtos k 2 2))
    
26.   (set_tile "txt_area" str1)
    
27.   (princ)
    
28. )
    
29. (defun sub_pop (vvs)
    
30.   (ini_1)
    
31.   (cond ((= vvs "0") (setq k1 1.0))
    
32.       ((= vvs "1") (setq k1 0.78))
    
33.   )
    
34. )
    
35. (defun ini_1()
    
36.   (set_tile "txt_den" "")
    
37.   (set_tile "txt_area" "")
    
38. )
    
39.   (princ)

(defun c:tou_area ()<br />   (setq k1 1.0 k2 0.12)<br />   (dcl_tou_area)<br />   (prin1)<br /> )<br /> (defun dcl_tou_area ()<br />   (setq dcl_id (load_dialog "我的lisp\\tou_area"))<br />   (new_dialog "tou_area" dcl_id)<br />   (action_tile "pop_mat" "(sub_pop $value)")<br />   (action_tile "but_cal" "(area_cal)")<br />   (action_tile "cancel" "(done_dialog 0)")<br />   (setq dd (start_dialog))<br /> )<br /> (defun area_cal  ()<br />   (ini_1)<br />   (setq i1 (atof (get_tile "Ieg")))<br />   (cond ((< i1 200) (setq k2 0.31))<br />     ((<= i1 2000)<br />       (setq k2 (- 0.31 (* (- i1 200) 1.05 0.0001))))<br />     ((> i1 2000) (setq k2 0.12))<br />   )<br />   (setq k (* k1 k2))<br />   (setq area1 (/ i1 k))<br />   (setq str1 (rtos area1 2 0))<br />   (set_tile "txt_den" (rtos k 2 2))<br />   (set_tile "txt_area" str1)<br />   (princ)<br /> )<br /> (defun sub_pop (vvs)<br />   (ini_1)<br />   (cond ((= vvs "0") (setq k1 1.0))<br />       ((= vvs "1") (setq k1 0.78))<br />   )<br /> )<br /> (defun ini_1()<br />   (set_tile "txt_den" "")<br />   (set_tile "txt_area" "")<br /> )<br />   (princ)

yjwht

练习4 绘制灯具的配光曲线图

1. ;绘制配光曲线
   
2. (defun c:tt()
   
3.   (setq v1(getvar "osmode"))
   
4.   (setq v2(getvar "cmdecho"))
   
5.   (setq v3(getvar "blipmode"))
   
6.   (setvar "osmode" 0)
   
7.   (setvar "cmdecho" 0)
   
8.   (setvar "blipmode" 0)
   
9.   (setq d1 (/ pi 36))
   
10.   (setq list1 '(278 280 290 306 323 339 344 328 288 214
    
11.     131 57 23 10 5 2 1 0 0))
    
12.   (setq list2 '(278 277 269 259 248 234 218 200 181 160
    
13.     138 114 90 66 44 28 16 7 1))
    
14.   (setq p1 '(0 0))
    
15.   (setq i 0)
    
16.   (command "pline")
    
17.   (while (< i (length list2))
    
18.     (if (= (nth i list2) 0)
    
19.       (setq p2 '(0 0))
    
20.       (setq p2 (polar p1 (+ (* pi -0.5) (* d1 i)) (nth i list2)))
    
21.     )
    
22.     (command p2)
    
23.     (setq i (1+ i))
    
24.   )
    
25.   (command "")
    
26.   (command "mirror" (entlast) "" '(0 0) '(0 100) "N")
    
27.   (setvar "osmode" v1)
    
28.   (setvar "cmdecho" v2)
    
29.   (setvar "blipmode" v3)
    
30.   (princ)
    
31. )

;绘制配光曲线<br /> (defun c:tt()<br />   (setq v1(getvar "osmode"))<br />   (setq v2(getvar "cmdecho"))<br />   (setq v3(getvar "blipmode"))<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (setvar "blipmode" 0)<br />   (setq d1 (/ pi 36))<br />   (setq list1 '(278 280 290 306 323 339 344 328 288 214<br />     131 57 23 10 5 2 1 0 0))<br />   (setq list2 '(278 277 269 259 248 234 218 200 181 160<br />     138 114 90 66 44 28 16 7 1))<br />   (setq p1 '(0 0))<br />   (setq i 0)<br />   (command "pline")<br />   (while (< i (length list2))<br />     (if (= (nth i list2) 0)<br />       (setq p2 '(0 0))<br />       (setq p2 (polar p1 (+ (* pi -0.5) (* d1 i)) (nth i list2)))<br />     )<br />     (command p2)<br />     (setq i (1+ i))<br />   )<br />   (command "")<br />   (command "mirror" (entlast) "" '(0 0) '(0 100) "N")<br />   (setvar "osmode" v1)<br />   (setvar "cmdecho" v2)<br />   (setvar "blipmode" v3)<br />   (princ)<br /> )

lea丶丶

我现在也在做变电一次设计，之前做配电、输电线路

只会艾迪西

楼主 同电力设计行业，能群探讨下，变配电这块如何二次开发吗

lea丶丶

这是按一次手册做的等高避雷，按50064不知道怎么通过查表来，我看天正是按50064来的。

yjwht

lea丶丶 发表于 2025-4-16 17:21
我现在也在做变电一次设计，之前做配电、输电线路

我之前做变电二次，现在做变电一次，另外电缆设计也做。幸会

yjwht

双针等高，绘制防雷保护范围

1. ;根据双针距离D、实际计算出的bx、rx,绘制等高避雷针保护范围
   
2. (defun c:EE17()  ;szdg即双针等高
   
3.   (setq p1 (getpoint "\n指定1#避雷针的位置："))
   
4.   (setq p2 (getpoint "\n指定2#避雷针的位置："))
   
5.   (setq D1 (distance p1 p2))
   
6.   (setq p3 (polar p1 (angle p1 p2) (/ D1 2)))
   
7.   (setq bx (getdist p3 "\n输入双针保护最小宽度bx："))
   
8.   (setq rx (getdist p1 "\n输入单针保护半径rx："))
   
9.   (setq p4 (polar p3 (+ (angle p3 p1) (/ pi 2)) bx))
   
10.   (setq p5 (polar p3 (+ (angle p3 p2) (/ pi 2)) bx))
    
11.   (if (< rx (distance p1 p4))
    
12.   (progn
    
13.     (setq p6 (polar p1 (- (angle p1 p4) (acos (/ rx (distance p1 p4)))) rx))
    
14.     (setq p7 (polar p1 (+ (angle p1 p5) (acos (/ rx (distance p1 p5)))) rx))
    
15.     (command "pline" p5 p7 "a" p6 "l" p4 "")
    
16.     (command "mirror" (ssget "L") "" p5 p4 "n")
    
17.   )
    
18.   (princ "\n双针不能联合，请检查输入数据是否有误！")
    
19.   )
    
20.   (princ)
    
21. )
    
22. ;定义反余弦函数，返回角度的弧度值
    
23. ;反余弦函数的定义域为[-1, 1]，值域为[0, π]
    
24. (defun acos(x)
    
25.   (cond
    
26.   ((= x 0.0) (* pi 0.5))
    
27.   ((and (> x 0.0) (<= x 1.0))
    
28.     (atan (/ (sqrt (- 1 (* x x))) x)))
    
29.   ((and (>= x -1.0) (< x 0.0))
    
30.     (+ (atan (/ (sqrt (- 1 (* x x))) x)) pi)
    
31.     )
    
32.   (T (progn
    
33.      (princ "输入值超出反余弦函数的定义域。")
    
34.      nil))
    
35.   )
    
36. )

;根据双针距离D、实际计算出的bx、rx,绘制等高避雷针保护范围<br /> (defun c:EE17()  ;szdg即双针等高<br />   (setq p1 (getpoint "\n指定1#避雷针的位置："))<br />   (setq p2 (getpoint "\n指定2#避雷针的位置："))<br />   (setq D1 (distance p1 p2))<br />   (setq p3 (polar p1 (angle p1 p2) (/ D1 2)))<br />   (setq bx (getdist p3 "\n输入双针保护最小宽度bx："))<br />   (setq rx (getdist p1 "\n输入单针保护半径rx："))<br />   (setq p4 (polar p3 (+ (angle p3 p1) (/ pi 2)) bx))<br />   (setq p5 (polar p3 (+ (angle p3 p2) (/ pi 2)) bx))<br />   (if (< rx (distance p1 p4))<br />   (progn<br />     (setq p6 (polar p1 (- (angle p1 p4) (acos (/ rx (distance p1 p4)))) rx))<br />     (setq p7 (polar p1 (+ (angle p1 p5) (acos (/ rx (distance p1 p5)))) rx))<br />     (command "pline" p5 p7 "a" p6 "l" p4 "")<br />     (command "mirror" (ssget "L") "" p5 p4 "n")<br />   )<br />   (princ "\n双针不能联合，请检查输入数据是否有误！")<br />   )<br />   (princ)<br /> )<br /> ;定义反余弦函数，返回角度的弧度值<br /> ;反余弦函数的定义域为[-1, 1]，值域为[0, π]<br /> (defun acos(x)<br />   (cond<br />   ((= x 0.0) (* pi 0.5))<br />   ((and (> x 0.0) (<= x 1.0))<br />     (atan (/ (sqrt (- 1 (* x x))) x)))<br />   ((and (>= x -1.0) (< x 0.0))<br />     (+ (atan (/ (sqrt (- 1 (* x x))) x)) pi)<br />     )<br />   (T (progn <br />      (princ "输入值超出反余弦函数的定义域。")<br />      nil))<br />   )<br /> )

yjwht

只会艾迪西 发表于 2025-4-17 09:18
楼主 同电力设计行业，能群探讨下，变配电这块如何二次开发吗

我也只是业余爱好lsp，做设计的都很忙，按需学习才是现实的