设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 模仿天正电气低压系统图
123下一页
返回列表 发新帖
查看: 4618|回复: 22

[讨论] 模仿天正电气低压系统图

[复制链接]
lea丶丶
发表于 2016-7-27 12:46 | 显示全部楼层 |阅读模式
本帖最后由 lea丶丶 于 2016-7-27 12:52 编辑

模仿天正低压系统图

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复

使用道具 举报

lea丶丶
 楼主| 发表于 2017-8-4 09:22 | 显示全部楼层
  2. (defun c:lea-dyxtt (/ dcl_id Dcl_File k1 lst n show_lst lst1 lst2 lst3 rb1 rb2 tempname dclname filen lea-dyxtt lea-lst2lst)

  4. ;函数功能：生成低压系统图
  5. (defun lea-dyxtt (lst flag /  insert lea-Rectange insertionPnt i item minp maxp PLOT_BL PLOT_TR pdx pdy emkText)
  6.        
  7. (defun insert(insertionPnt  blockname  )
  8.         (vl-load-com)
  9.   (setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))
  10.         (setq whatspace (vla-get-ActiveSpace AcadDocument))
  11.   (setq mSpace (vla-get-ModelSpace acadDocument))
  12.   (setq pSpace (vla-get-PaperSpace acadDocument))
  13.   (setq DwgProps (vla-Get-SummaryInfo acadDocument))
  14.         (if (null (findfile blockname)) (progn (alert "文件没有相应出线数量的馈线柜，请添加") (exit)) blockname)
  15.         (if (= whatspace 1)
  16.                 (vla-InsertBlock mSpace insertionPnt blockname 1 1 1 0)
  17.                 (vla-InsertBlock pSpace insertionPnt blockname 1 1 1 0)
  18.         )
  19. )

  21. (defun lea-Rectange (pt1 pt2)
  22.         (entmake
  23.                 (list
  24.                         '(0 . "LWPOLYLINE")                          ;轻多段线
  25.                         '(100 . "AcDbEntity")
  26.                         '(100 . "AcDbPolyline")
  27.                         '(90 . 4)                                  ;四个顶点
  28.                         '(70 . 1)                                  ;闭合
  29.                         (cons 38 (caddr pt1))                          ;高程
  30.                         (cons 10 (list (car pt1) (cadr pt1)))          ;左下角
  31.                         (cons 10 (list (car pt2) (cadr pt1)))          ;右下角
  32.                         (cons 10 (list (car pt2) (cadr pt2)))          ;右上角
  33.                         (cons 10 (list (car pt1) (cadr pt2)))          ;左上角
  34.                         (cons 210 '(0 0 1))                          ;法线方向
  35.                 )
  36.         )
  37. )

  39.         (setq        insertionPnt(vlax-3d-point(getpoint "\n请输入图框插入位置点: "))
  40.                 i    0         
  41.                 ;lst  '("BYQ-Z.DWG" "GCS-ZJX.DWG" "GCS-7.DWG")
  42.         )
  43.         (repeat (length lst)
  44.                 (insert insertionPnt (nth i lst))
  45.                 (setq item (vlax-ename->vla-object (entlast)))
  46.                 (vla-getboundingbox
  47.                         item
  48.                         'minp
  49.                         'maxp
  50.                 )
  51.                 (setq PLOT_BL (vlax-safearray->list minp)
  52.                         PLOT_TR (vlax-safearray->list maxp)
  53.                 )
  54.                 (setq PDX (ABS (- (caR PLOT_BL) (caR PLOT_TR)))
  55.                         PDY  (ABS (- (caDR PLOT_BL) (caDR PLOT_TR)))
  56.                 )
  57.                 (setq PLOT_BL (list (- (car PLOT_TR) pdx) (- (cadr PLOT_TR) 90) (last PLOT_BL)))
  58.                 (lea-Rectange PLOT_BL PLOT_TR)
  59.                 (defun emkText (pt str h)
  60.                         (entmake (list '(0 . "TEXT") (cons 1 str) (cons 8 "DM_文字表格") (cons 10 pt) (cons 40 h) (cons 11 pt) (cons 72 1) (cons 73 2)))
  61.                 )
  62.                 ;绘制眉头
  63.                 (setq p1 (lea-point-pt PLOT_TR '(0 4 0))
  64.                         p0 (lea-point-pt PLOT_BL '(0 90 0))
  65.                 )
  66.                 (lea-Rectange p0 p1)
  67.                 (if (= flag "抽屉式") (setq flag1 "GCS") (setq flag1 "GGD"))
  68.                 (if (or (= i 0) (= i (1-(length lst)))) (emkText (lea-point-mid p0 p1) "低压柜型号" 2) (emkText (lea-point-mid p0 p1) flag1 2))
  69.                 (setq p2 (lea-point-pt p0 '(0 4 0))
  70.                         p3 (lea-point-pt p1 '(0 4 0))
  71.                 )
  72.                 (lea-Rectange p2 p3)
  73.                 (if (or (= i 0) (= i (1-(length lst)))) (emkText (lea-point-mid p2 p3) "低压柜编号" 2) (emkText (lea-point-mid p2 p3) (strcat "AA" (rtos i 2 0)) 2))
  74.                 ;眉头结束
  75.                 (setq insertionPnt (vlax-3d-point PLOT_TR)
  76.                         i  (1+ i)
  77.                 )
  78.         )
  79. )

  81. ;删除列表里其中某个位置的元素
  82. (defun lea-lst2lst (n lst / lst1 n1 i)
  83.         (setq n1 (length lst)
  84.                 i 0
  85.                 lst1 '()
  86.         )
  87.         (repeat n1
  88.                 (if (/= i n )(setq lst1 (cons (nth i lst) lst1)) (setq i n))
  89.                 (setq i (1+ i))
  90.         )
  91.         (reverse lst1)
  92. )

  94.         (vl-load-com)
  95.         (lea-start)
  96.         (defun show_lst( key lst)
  97.                 (start_list key)
  98.                 (mapcar 'add_list lst)
  99.                 (end_list)
  100.         )
  101.         (setq dclname
  102.                 (cond
  103.                         ((setq tempname (vl-filename-mktemp "temp.dcl")
  104.                                  filen (open tempname "w")
  105.                          )
  106.                                 (foreach stream '(
  107.                                                                                                          "RENAME:dialog {"                                                                       
  108.                                                                                                          "    :boxed_column {label = "lea低压系统图" ;"       
  109.                                                                                                          "                :row {:radio_button { key = "krb1" ; label = "抽屉式" ; width = 20 ; }"
  110.                                                                                                          "                                                                             :radio_button { key = "krb2" ; label = "固定式" ;width = 20 ; }}"
  111.                                                                                                          "        :row {"
  112.                                                                                                          "                 :list_box { key = "klst1" ; label = "插入顺序从下往上" ; width = 20 ; }"
  113.                                                                                                          "        :column {"
  114.                                                                                                          "                :row {:button { key = "kb1" ; label = "变压器左" ; width = 20 ; }"
  115.                                                                                                          "                                                                            :button { key = "kb2" ; label = "变压器右" ; width = 20 ; }}"
  116.                                                                                                          "                :row {:button { key = "kb3" ; label = "进线柜左" ; width = 20 ; }"
  117.                                                                                                          "                                                                            :button { key = "kb4" ; label = "进线柜右" ; width = 20 ; }}"                                                                          
  118.                                                                                                          "                :row {:button { key = "kb5" ; label = "电容柜" ; width = 20 ; }"
  119.                                                                                                          "                                                                            :button { key = "kb6" ; label = "联络柜" ; width = 20 ; }}"
  120.                                                                                                          "                :row {:button { key = "kb7" ; label = "馈线柜" ; width = 20 ; }"
  121.                                                                                                          "                                                                            :edit_box { key = "k1" ;  width = 20 ; }}"
  122.                                                                                                          "                :button { key = "kb8" ; label = "删除" ; width = 20 ; }"       
  123.                                                                                                          "                }"       
  124.                                                                                                          "             }"
  125.                                                                                                          "             }"
  126.                                                                                                          " spacer_1;"
  127.                                                                                                          " ok_cancel;"
  128.                                                                                                          "             }"                                                                         
  129.                                                                                                  )
  130.                                         (write-line stream filen)
  131.                                 )
  132.                                 (close filen)
  133.                                 tempname
  134.                         )
  135.                 )
  136.         )
  137.         (setq Dcl_Id (load_dialog dclname))  
  138.         (new_dialog "RENAME" Dcl_Id)
  139.         (setq lst '()
  140.                 lst1 '("GCS变压器左进.DWG" "GCS变压器右进.DWG" "GCS进线柜左进.DWG" "GCS进线柜右进.DWG" "GCS电容柜.DWG" "GCS联络柜.DWG" "GCS出线柜-");GCS柜
  141.                 lst2 '("GGD变压器左进.DWG" "GGD变压器右进.DWG" "GGD进线柜左进.DWG" "GGD进线柜右进.DWG" "GGD电容柜.DWG" "GGD联络柜.DWG" "GGD出线柜-");GGD柜
  142.         )
  143.         (set_tile "k1" (setq na1 "1"))
  144.         (set_tile "krb1" "1")
  145.         (setq k1(get_attr "krb1" "label"));预设起始值
  146.         (action_tile "krb1" "(setq k1(get_attr $key "label"))")
  147.         (action_tile "krb2" "(setq k1(get_attr $key "label"))")
  148.         ;(cond
  149.         ;        ((= k1 "抽屉式") (setq lst3 lst1))
  150.         ;        ((= k1 "固定式") (setq lst3 lst2))
  151.         ;)
  152.         (action_tile "kb1" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 0 lst3) lst))(show_lst "klst1" lst)")
  153.         (action_tile "kb2" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 1 lst3) lst))(show_lst "klst1" lst)")
  154.         (action_tile "kb3" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 2 lst3) lst))(show_lst "klst1" lst)")
  155.         (action_tile "kb4" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 3 lst3) lst))(show_lst "klst1" lst)")
  156.         (action_tile "kb5" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 4 lst3) lst))(show_lst "klst1" lst)")
  157.         (action_tile "kb6" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 5 lst3) lst))(show_lst "klst1" lst)")
  158.         (action_tile "k1" "(setq na1 $value)")
  159.         (action_tile "kb7" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq na2 (strcat (nth 6 lst3) na1 ".DWG"))(setq lst (cons na2 lst))(show_lst "klst1" lst)")
  160.         (action_tile "klst1" "(setq n (atoi $value) )")
  161.         (action_tile "kb8" "(setq lst (lea-lst2lst n lst))(show_lst "klst1" lst)")
  162.         (action_tile "accept" "(done_dialog)")
  163.         (start_dialog)
  164.         (lea-dyxtt (reverse lst) k1)
  165.         (unload_dialog Dcl_Id)
  166.   (vl-file-delete  tempname)
  167.         (lea-end)
  168. )
回复 支持 0 反对 1

使用道具 举报

lea丶丶
 楼主| 发表于 2017-8-4 09:21 | 显示全部楼层
我爱lisp 发表于 2017-8-3 15:56
应该收费，劳动所得，简单适用。
建议放出试用版给大家用，这样可以帮着你完善程序。
说明，我不是搞电的 ...

以前写的、比较乱，就没乱发，其实原理很简单插入块，只要你把dcl做好就OK了
回复 支持 反对

使用道具 举报

edsion24
发表于 2016-7-27 14:10 | 显示全部楼层
我也是做电气设计的。。。。源码可以分享吗？
回复 支持 反对

使用道具 举报

我爱lisp
发表于 2017-8-3 15:56 | 显示全部楼层
本帖最后由 我爱lisp 于 2017-8-3 15:59 编辑

应该收费，劳动所得，简单适用。
建议放出试用版给大家用，这样可以帮着你完善程序。
说明，我不是搞电的，用不上
回复 支持 反对

使用道具 举报

xinxirong
发表于 2017-8-3 18:33 来自手机 | 显示全部楼层
系统图每个院要求不同，给你也没用。这是要定制的
回复 支持 反对

使用道具 举报

lea丶丶
 楼主| 发表于 2017-8-4 09:23 | 显示全部楼层
xinxirong 发表于 2017-8-3 18:33
系统图每个院要求不同，给你也没用。这是要定制的

是的，其实也可以发的，只要你把块做好了就OK了
回复 支持 反对

使用道具 举报

我爱lisp
发表于 2017-8-4 15:14 | 显示全部楼层
鼓励开源，楼主是做电的吗？可以考虑加入些电流、线径计算之类的小函数。一点点做强
回复 支持 反对

使用道具 举报

jun353835273
发表于 2017-8-11 23:26 | 显示全部楼层
运行不了呢  输入的点错误
回复 支持 反对

使用道具 举报

lea丶丶
 楼主| 发表于 2017-9-20 21:59 来自手机 | 显示全部楼层
我爱lisp 发表于 2017-8-4 15:14
鼓励开源，楼主是做电的吗？可以考虑加入些电流、线径计算之类的小函数。一点点做强

嗯，做电的
回复 支持 反对

使用道具 举报

123下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-4-20 02:52 , Processed in 0.156336 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表