设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 3896|回复: 40

[曲线] 电气回路连线/创建/统计/增删

[复制链接]

签到天数: 1031 天

连续签到: 3 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 1256个

财富等级: 财源广进

发表于 2014-11-20 17:32:25 | 显示全部楼层 |阅读模式
  • 插件名称 : 回路连线
  • 作  者 : st788796
  • 运行环境 :XDRX API OpenDCL 
  • 发布时间 :2014-12-01(2018.4.23更新)
  • 命令名称 :XDTB_Drawcircuit
  • 插件介绍 :回路连线
  • 备  注 : (点击图片可以放大)
    XDTB_Drawcircuit 绘制
    XDTB_CreateCircuit 现有线创建
    XDTB_CalCircuit 统计制表
(点击图片可以放大)

晓东温馨提示 1、运行环境为 晓东工具箱XDRX API 的插件,请下载最新版本的 晓东工具箱XDRX API开发环境 一键安装
2、在ACAD中如何加载插件,请看 论坛插件使用方法
3、如果您有要求需要定制插件,请到 编程申请 论坛发帖求助

插件详细内容

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
本帖最后由 newer 于 2018-4-23 16:47 编辑

  1. (defun _Excel:getFromFile (fn / lst)
  2.   (setq lst (xd::excel:getFromFile (findfile fn) 0)
  3.         lst (mapcar '(lambda (x) (mapcar '(lambda (a) (cadr a)) x)) lst)
  4.   )
  5.   (list (mapcar 'car lst)
  6.         (mapcar 'cadr lst)
  7.         (mapcar 'caddr lst)
  8.         (mapcar 'cadddr lst)
  9.   )
  10. )
  11. ;;===================================================;
  12. ;;          对话框控制                               ;
  13. ;;===================================================;
  14. (defun _Circuit:Control (/ strl)
  15.   (setq strl '("YWt6A+xBAADGLmvOBuKT5SUSaitmuYElBOec/HtTKD6jrPRWaAXB9mxdyNwuJKVWODKWCAXroBJ1"
  16.                "096qFtxaK487Sqs6oYq/dVignP3plP3Ah5b9XwNKL5oz82mUCcAjRA3AJxnNow8I9M2zkrABsLLn"
  17.                "TZkCwYFHDRgkygYfb/dbWfQQ+n4CKX7SKFXKz8JwM9Y8URRWz/SoVW47Y9Rv3cskiu4U3ssQpCy1"
  18.                "FfPKqDUBq9qUrzk5uhaX9+EaL5smM9TsiNDaoViEK0eoLeAD4h1z4zubrToVq+osP6XVlsnpjNfZ"
  19.                "HQSXckuKJfkc+itfUf2EEvhvPHBsYUQzIHU4T/AfRKaGeJVR2FoIT0TudbW55p9VmbHxKjIdYAck"
  20.                "hARNg23bKfuKnUFIrScBVoo5PAFeym+0MdL4KjNnAfeM6xdp6QWI/42x4UOLh3edJRNF8hMYwJPK"
  21.                "GIJzQ6Gp+kBUik/fafuAP5ZXMxHynyhynnZ4Tzqh+R5IvF/KH3qJrkz2NyTcyrle8C8FZFH1QuFt"
  22.                "RCGqs+FcAySpH6sMKcygWt1cwfv0bdt8134zaGlHTuiUwrPStRM0mRUnm7IJ8Itk1bMILEWlnBg6"
  23.                "RVii9DA6FmfefHKvIXoJrwnBaCFZqw+7XKCkM4P0rInnJGumxiCWg9hA3YogbxGF+hBrhCDfb6zR"
  24.                "Lbijc9xgUg+G3Kw9NZfCo0ZSio6sgN8hawHdXINvIw1lIbCk1/PVIkEPGE/txR+YybCxGJlwBG9J"
  25.                "YnnoxqdtrJ2Yc4ZFEKDcW9KIIL0M+dPjiT+LJtQ87AXCyyPawZn0hMjKpU3OzdCks0ZdQocDLwjJ"
  26.                "pIotzVKZKidTEyLajKdQjMvKB0+KSKFXpMIyl+E6ZSYcHnWKZkZzaRxe80hRL0RSgkMxhoEFXINj"
  27.                "36FrhBPfo8j6J++Bx9uV85V1mIACw8H2nQE4/9i1u4+Zs4zWURgcUxVZWNT99DIv71AEOGmS4K+k"
  28.                "/2dZsR6T/xlWhQqMcksqzAS4E7xNtC0GuCCW4E9ykUP95/ZJ2G1tS39toE8veUVtCQppiNH6ACqr"
  29.                "/+v3I/z301fm5v6wOk3MurpLUuPm1nPmjvD3Gh21nfGxYCZ3MrI9GZx7ljJi+4G56LK6y1Lj5tZ1"
  30.                "5o7w973OTY8Euc1tgXlYEPmwug8a9/eVJkRPL2FOn2NtkzYMQa9InAZBn2lYwPqwuleWMjK/5/d5"
  31.                "302v+1JPbx+Xujo9vvoJMkq+sLrlz4Tw67462IO63a7nxmUnHNzq221t839toE/f2H9bbXlwAEHJ"
  32.                "bOaGfERtguK2vLpK4ufm/bD6ZKgFsDpfA9MdJxcdXLQrq/APi+7NIbqmpIFG2HH2ghvyaRfEqpe/"
  33.                "04tEnPEPRUdyCK1vLyyD2gQeQpJR9FLqqlYT5u/WCEnUsopgxjb6+34AZA0kmqXyzujR+/Y0ljo6"
  34.                "FrOm7ga9n5yAIXfMU7rWWRg44zZRa2/DvWyPXxm8uN5tyHlQbui/bT+bdh9rGjtSCaf25b5aOxf8"
  35.                "RqeV2pQbClzJRm8fQzHi9hh0XIsc/R68E9TFO+cxdFPXkTOffNF0k0u9A5wCV+bAO7oIm8HBu435"
  36.                "lkfHxmgxBjaXMuGw0g3XqRJqmcsGdkFv62DMIyIpVHHHJ04mX4oznILXQri/LQDhD4jqaJbgTHBp"
  37.                "Qts36glH4GwJG8XZ8m6DvbqLb1TU+Y+HaqLzMZCN/IYyZ+FC9Mq6WfFMzWLhZwgbP0nqGEm6AA57"
  38.                "FcVhViZ4d+x/lJNDin1LdgqtcSi/YQDOfqNxBrKX3GGOIxZ4AI5sCkFWPQiD3nX/YQaQeZSW1Sah"
  39.                "FgWxwuG4e91KRGY1BSC5PEnBBRcFmY6VbSCyrVpbSPOJNjUsojuMhbRo/FwO/14HaccrRjJkOo/2"
  40.                "OjAn0MfK2GIH4NRaD8dM/PmW8ItPdOaqnSWnYSeYKoZTTWGw10o88SDwqEqYKkYE45kqdAntf3Ld"
  41.                "5cCR2hskw/DiuFL1WQLav73tNIUFxKyNYP+Hx+TL8+GiN9wZsoENwgDg3wNkJm9NynU2TCQzvTMG"
  42.                "SpScchN6xAnO6RqvRcTuHhtdNQUhTTh4R2uRFXwk6DW1fnwkbJsw9ejjrhcHfEDfG201ZVP43Btc"
  43.                "j3Ht3WZ35idATYVvTu1WCSSyonHj52YCvLIY6EgYdBwytFqh63F7uiKEMbNpnlEcgoiqwlWPhXEo" "c6ri"
  44.               )
  45.   )
  46.   (setq *allPres*     (acad_strlsort
  47.                         (vl-remove-if
  48.                           '(lambda (x) (= x "cPrefix"))
  49.                           (mapcar 'car (vlax-ldata-list "XD_Circuit_Dict"))
  50.                         )
  51.                       )
  52.         *circuitdict* (_excel:getfromfile "circuitdict.xls")
  53.   )
  54.   (dcl_project_import strl)
  55.   (dcl_form_show ab/Form1)
  56. )
  57. (defun _Odcl:AddList (ctrl lst default /)
  58.   (dcl_ComboBox_AddList ctrl lst)
  59.   (dcl_combobox_setcursel ctrl default)
  60. )
  61. (defun c:ab/form1/OnInitialize (/ lst)
  62.   (dcl_combobox_addlist
  63.     ab/form1/type
  64.     (mapcar 'vl-princ-to-string
  65.             (cdr (assoc "类型" *circuitdict*))
  66.     )
  67.   )
  68.   (dcl_combobox_setcursel ab/form1/type 0)
  69.   (dcl_combobox_addlist
  70.     ab/form1/power
  71.     (mapcar 'vl-princ-to-string
  72.             (cdr (assoc "功率" *circuitdict*))
  73.     )
  74.   )
  75.   (dcl_combobox_setcursel ab/form1/power 0)
  76.   (dcl_combobox_addlist
  77.     ab/form1/position
  78.     (mapcar 'vl-princ-to-string
  79.             (cdr (assoc "位置" *circuitdict*))
  80.     )
  81.   )
  82.   (dcl_combobox_setcursel ab/form1/position 0)
  83.   (dcl_combobox_addlist
  84.     ab/form1/control
  85.     (mapcar 'vl-princ-to-string
  86.             (cdr (assoc "控制" *circuitdict*))
  87.     )
  88.   )
  89.   (dcl_combobox_setcursel ab/form1/control 0)
  90.   (apply 'dcl_control_setpos
  91.          (cons ab/form1 (last (xdrx_document_pixelbox)))
  92.   )
  93.   (_Odcl:Addlist
  94.     ab/form1/allPre
  95.     *allpres*
  96.     (vl-position
  97.       (vlax-ldata-get "XD_Circuit_Dict" "cPrefix")
  98.       *allPres*
  99.     )
  100.   )
  101.   (dcl_control_settext
  102.     ab/form1/numCur
  103.     (itoa (vlax-ldata-get
  104.             "XD_Circuit_Dict"
  105.             (vlax-ldata-get "XD_Circuit_Dict" "cPrefix")
  106.           )
  107.     )
  108.   )
  109.   (dcl_control_settext
  110.     ab/form1/strPre
  111.     (vlax-ldata-get "XD_Circuit_Dict" "cPrefix")
  112.   )
  113.   (dcl_combobox_setcursel
  114.     ab/form1/layer
  115.     (vl-position
  116.       (getvar "clayer")
  117.       (mapcar 'car (xd::object:get "layer"))
  118.     )
  119.   )
  120.   (dcl_Control_SetJustification ab/form1/height 1)
  121.   (dcl_control_settext ab/form1/height "2.5")
  122. )
  123. (defun c:ab/form1/strPre_OnEditChanged (NewValue /)
  124.   (if (not (member newvalue *allpres*))
  125.     (progn (setq *allPres* (acad_strlsort (cons newvalue *allpres*)))
  126.            (vlax-ldata-put "XD_Circuit_Dict" newvalue 1)
  127.            (_Odcl:Addlist
  128.              ab/form1/allPre
  129.              *allpres*
  130.              (vl-position
  131.                (vlax-ldata-get "XD_Circuit_Dict" "cPrefix")
  132.                *allPres*
  133.              )
  134.            )
  135.            (dcl_control_settext ab/form1/numCur "1")
  136.            (vlax-ldata-put "XD_Circuit_Dict" "cPrefix" newvalue)
  137.     )
  138.   )
  139. )
  140. (defun c:ab/form1/numCur_OnEditChanged (NewValue /)
  141.   (vlax-ldata-put
  142.     "XD_Circuit_Dict"
  143.     (dcl_control_gettext ab/form1/strPre)
  144.     (atoi newvalue)
  145.   )
  146. )
  147. (defun c:ab/form1/allPre_OnSelChanged (ItemIndexOrCount Value /)
  148.   (dcl_control_settext ab/form1/strPre value)
  149.   (dcl_control_settext
  150.     ab/form1/numCur
  151.     (vlax-ldata-get "XD_Circuit_Dict" value)
  152.   )
  153.   (vlax-ldata-put "XD_Circuit_Dict" "cPrefix" value)
  154. )
  155. ;;===================================================;
  156. ;;            建立回路数据                           ;
  157. ;;===================================================;
  158. (defun _Circuit:Create (txt blk pl pl1 / ctype cposition cpower ccontrol lyr)
  159.   (setq ctype     (nth (dcl_combobox_getcursel ab/form1/type)
  160.                        (cdr (assoc "类型" *circuitdict*))
  161.                   )
  162.         cposition (nth (dcl_combobox_getcursel ab/form1/position)
  163.                        (cdr (assoc "位置" *circuitdict*))
  164.                   )
  165.         cpower    (nth (dcl_combobox_getcursel ab/form1/power)
  166.                        (cdr (assoc "功率" *circuitdict*))
  167.                   )
  168.         ccontrol  (nth (dcl_combobox_getcursel ab/form1/control)
  169.                        (cdr (assoc "控制" *circuitdict*))
  170.                   )
  171.   )
  172.   (vlax-ldata-put txt "Type" ctype)
  173.   (vlax-ldata-put txt "Power" cpower)
  174.   (vlax-ldata-put txt "Control" ccontrol)
  175.   (vlax-ldata-put txt "Position" cposition)
  176.   (if (/= (setq lyr (nth (dcl_combobox_getcursel ab/form1/layer)
  177.                          (dcl_control_getlist ab/form1/layer)
  178.                     )
  179.           )
  180.           (getvar "clayer")
  181.       )
  182.     (xdrx_entity_setlayer txt lyr)
  183.   )
  184.   (if (not blk)
  185.     (setq blk (car
  186.                 (xdrx_entsel "\n拾取图块或文字: " '((0 . "insert,*text")))
  187.               )
  188.     )
  189.   )
  190.   (if (eq (type blk) 'ENAME)
  191.     (if (= (xdrx_getpropertyvalue blk "IsA") "AcDbBlockReference")
  192.       (setq blk (car (xdrx_getpropertyvalue blk "BlockTableRecord")))
  193.       (setq blk (xdrx_getpropertyvalue blk "textString"))
  194.     )
  195.   )
  196.   (if blk
  197.     (xdrx_xdata_setbyproperty txt "XDCircuit" "String" blk)
  198.   )
  199.   (if (= (dcl_control_getvalue ab/form1/group) 1)
  200.     (if pl1
  201.       (xdrx_group_make "*" pl txt pl1)
  202.       (xdrx_group_make "*" pl txt)
  203.     )
  204.   )
  205.   (vlax-ldata-put
  206.     txt
  207.     "Circuit"
  208.     (xdrx_getpropertyvalue pl "Handle")
  209.   )
  210.   (vlax-ldata-put
  211.     "XD_Circuit_Dict"
  212.     (dcl_control_gettext ab/form1/strPre)
  213.     (1+ (atoi (dcl_control_gettext ab/form1/numCur)))
  214.   )
  215.   (dcl_control_settext
  216.     ab/form1/numCur
  217.     (itoa (vlax-ldata-get
  218.             "xd_circuit_dict"
  219.             (dcl_control_gettext ab/form1/strPre)
  220.           )
  221.     )
  222.   )
  223. )
  224. ;;===================================================;
  225. ;;              初始数据                             ;
  226. ;;===================================================;
  227. (defun _Circuit:CheckDict (/ tf str num)
  228.   (if (and (not (setq tf (vlax-ldata-list "XD_Circuit_Dict")))
  229.            (progn (princ "\n**当前图形未包含初始数据**") t)
  230.            (setq str (getstring "\n前缀: "))
  231.            (setq num (getint "\n编号: "))
  232.       )
  233.     (progn (vlax-ldata-put "XD_Circuit_Dict" str num)
  234.            (vlax-ldata-put "XD_Circuit_Dict" "cPrefix" str)
  235.            (setq tf t)
  236.     )
  237.   )
  238.   tf
  239. )
  240. ;;===================================================;
  241. ;;              绘制连接                             ;
  242. ;;===================================================;
  243. (defun c:XDTB_DrawCircuit (/ myerr olderr tf str num maxnums cPrefix p pts p d pl pl1 p1 str tf strl
  244.                            tf1 tf3 tf2 txt blklst blk
  245.                           )
  246.   (defun myerr (msg)
  247.     (princ "\n*cancel*")
  248.     (setq *error* olderr)
  249.     (if (dcl_form_isactive ab/form1)
  250.       (dcl_form_close ab/form1)
  251.     )
  252.     (xdrx_sysvar_pop)
  253.     (princ)
  254.   )
  255.   (if (_Circuit:CheckDict)
  256.     (progn (setq olderr  *error*
  257.                  *error* myerr
  258.                  tf1     t
  259.            )
  260.            (_Circuit:Control)
  261.            (xdrx_sysvar_push '("osmode" 64))
  262.            (while (and tf1 (dcl_form_isactive ab/form1))
  263.              (setq tf2 t
  264.                    pts nil
  265.                    pl nil
  266.                    blklst nil
  267.              )
  268.              (while (and tf2
  269.                          (progn (initget 128 "E U")
  270.                                 (setq p (if pts
  271.                                           (getpoint (car pts) "\r下一点[回退(U)/退出(E)]: ")
  272.                                           (getpoint "\r起点[退出(E)]: ")
  273.                                         )
  274.                                 )
  275.                          )
  276.                          (dcl_form_isactive ab/form1)
  277.                     )
  278.                (if (listp p)
  279.                  (progn (setq pts (cons p pts))
  280.                         (if (= (length pts) 2)
  281.                           (progn (setq p (getpoint (apply 'xdrx_line_midp pts) "\n弦高: ")
  282.                                        d (* 2 (xdrx_point_dist2line p (cadr pts) (car pts)))
  283.                                  )
  284.                                  (setq pl (xdrx_polyline_make (cadr pts) (car pts)))
  285.                                  (xdrx_polyline_setbulgeat pl 0 (/ d (apply 'distance pts)))
  286.                           )
  287.                         )
  288.                         (if (setq ss (xdrx_pickset_getatpoint (car pts) '((0 . "insert"))))
  289.                           (setq blklst (mapcar '(lambda (x)
  290.                                                   (car (xdrx_getpropertyvalue x "BlockTableRecord"))
  291.                                                 )
  292.                                                (xdrx_pickset->ents ss)
  293.                                        )
  294.                           )
  295.                         )
  296.                         (if (and pl (> (length pts) 2))
  297.                           (progn (setq n (xdrx_polyline_numverts pl))
  298.                                  (xdrx_polyline_setpointat pl (1- n) (car pts))
  299.                                  (xdrx_polyline_addvertexat pl (1- n) (cadr pts))
  300.                                  (xdrx_polyline_setbulgeat
  301.                                    pl
  302.                                    (- n 2)
  303.                                    (/ d (distance (cadr pts) (caddr pts)))
  304.                                  )
  305.                                  (xdrx_polyline_setbulgeat
  306.                                    pl
  307.                                    (1- n)
  308.                                    (/ d (distance (car pts) (cadr pts)))
  309.                                  )
  310.                           )
  311.                         )
  312.                         (setq tf3 t)
  313.                  )
  314.                  (cond ((= p "E")
  315.                         (setq tf1 nil
  316.                               tf2 nil
  317.                         )
  318.                        )
  319.                        ((= p "U")
  320.                         (if pl
  321.                           (progn (xdrx_polyline_removevertexat
  322.                                    pl
  323.                                    (1- (xdrx_polyline_numverts pl))
  324.                                  )
  325.                                  (setq pts (cdr pts))
  326.                           )
  327.                         )
  328.                         (setq tf3 nil)
  329.                        )
  330.                        (t
  331.                         (setq tf2 nil
  332.                               tf3 t
  333.                         )
  334.                        )
  335.                  )
  336.                )
  337.              )
  338.              (if (and tf1
  339.                       tf3
  340.                       pl
  341.                       (dcl_form_isactive ab/form1)
  342.                       (if (setq p (getpoint "\n引出点<回车端点>: "))
  343.                         (progn (setq tf nil) p)
  344.                         (setq tf t
  345.                               p  (xdrx_curve_getendpoint pl)
  346.                         )
  347.                       )
  348.                       (setq p1 (getpoint p "\n标注点: "))
  349.                       (dcl_form_isactive ab/form1)
  350.                       (setq str (strcat (dcl_control_gettext ab/form1/strPre)
  351.                                         (xd::string:strpad
  352.                                           (atoi (dcl_control_gettext ab/form1/numCur))
  353.                                           2
  354.                                           "0"
  355.                                           0
  356.                                         )
  357.                                 )
  358.                       )
  359.                  )
  360.                (progn (setq txt (xdrx_text_make
  361.                                   p1
  362.                                   (strcase str)
  363.                                   (distof (dcl_control_gettext ab/form1/height))
  364.                                   0.0
  365.                                 )
  366.                             pl1 (xdrx_polyline_make p p1)
  367.                       )
  368.                       (xdrx_polyline_setbulgeat pl1 0 0.5)
  369.                       (if (and blklst (apply '= blklst))
  370.                         (setq blk (car blklst))
  371.                       )
  372.                       (_Circuit:Create txt blk pl pl1)
  373.                )
  374.              )
  375.            )
  376.            (dcl_form_close ab/form1)
  377.            (xdrx_sysvar_pop)
  378.            (setq *error* olderr)
  379.     )
  380.   )
  381.   (princ)
  382. )
  383. ;;===================================================;
  384. ;;            处理旧图                               ;
  385. ;;===================================================;
  386. (defun c:xdtb_createCircuit (/ myerr olderr allpres circuitdict strl pl txt blk)
  387.   (defun myerr (msg)
  388.     (princ "\n*cancel*")
  389.     (setq *error* olderr)
  390.     (if (dcl_form_isactive ab/form1)
  391.       (dcl_form_close ab/form1)
  392.     )
  393.     (xdrx_sysvar_pop)
  394.     (princ)
  395.   )
  396.   (setq olderr  *error*
  397.         *error* myerr
  398.   )
  399.   (if (_Circuit:Control)
  400.     (while (and (setq pl (car (xdrx_entsel
  401.                                 "\n拾取回路Pline<退出>: "
  402.                                 '((0 . "LWPOLYLINE"))
  403.                               )
  404.                          )
  405.                 )
  406.                 (setq txt (car (xdrx_entsel "\n拾取回路编号<退出>: " '((0 . "*TEXT")))
  407.                           )
  408.                 )
  409.                 (progn (setq str    (xdrx_getpropertyvalue txt "textstring")
  410.                              curPre (xdrx_string_trimright str "0123456789")
  411.                              num    (substr str (1+ (strlen curpre)))
  412.                        )
  413.                        (distof num)
  414.                        (princ (strcat "\n前缀 =" str " ; " "编号 = " num))
  415.                        (setq num (atoi num))
  416.                        (if (= (xdrx_yesorno "\n接受") 1)
  417.                          t
  418.                          (and (setq str (getstring "\n前缀: "))
  419.                               (setq num (getint "\n编号: "))
  420.                          )
  421.                        )
  422.                 )
  423.                 (setq blk (car (xdrx_entsel
  424.                                  "\n拾取图块或文字<退出>: "
  425.                                  '((0 . "INSERT,*TEXT"))
  426.                                )
  427.                           )
  428.                 )
  429.                 (dcl_form_isactive ab/form1)
  430.            )
  431.       (if (not (member str *allPres*))
  432.         (progn (setq *allPres* (acad_strlsort (cons str *allpres*)))
  433.                (vlax-ldata-put "XD_Circuit_Dict" str num)
  434.                (_Odcl:Addlist
  435.                  ab/form1/allPre
  436.                  *allpres*
  437.                  (vl-position
  438.                    (vlax-ldata-get "XD_Circuit_Dict" "cPrefix")
  439.                    *allPres*
  440.                  )
  441.                )
  442.         )
  443.         (progn (dcl_control_settext ab/form1/strPre str)
  444.                (dcl_control_settext ab/form1/numCur (itoa num))
  445.                (dcl_combobox_setcursel
  446.                  ab/form1/allPre
  447.                  (vl-position str *allPres*)
  448.                )
  449.         )
  450.       )
  451.       (_Circuit:Create txt blk pl nil)
  452.     )
  453.   )
  454.   (dcl_form_close ab/form1)
  455.   (xdrx_sysvar_pop)
  456.   (setq *error* olderr)
  457.   (princ)
  458. )
  459. ;;===================================================;
  460. ;;             统计回路                              ;
  461. ;;===================================================;
  462. (defun c:XDTB_CalCircuit (/ ss nl height)
  463.   (if (setq ss (ssget '((0 . "text") (-3 ("XDCircuit")))))
  464.     (progn (setq height (xdrx_getpropertyvalue (ssname ss 0) "height")
  465.                  nl     (mapcar '(lambda (x / pl)
  466.                                    (if (setq pl (handent (vlax-ldata-get x "Circuit")))
  467.                                      (list (xdrx_getpropertyvalue x "textstring")
  468.                                            (vlax-ldata-get x "Power")
  469.                                            (xdrx_xdata_get x "XDCircuit")
  470.                                            (vlax-ldata-get x "Type")
  471.                                            (vlax-ldata-get x "Power")
  472.                                            (itoa (xdrx_getpropertyvalue pl "numVerts"))
  473.                                            (* (vlax-ldata-get x "Power")
  474.                                               (xdrx_getpropertyvalue pl "numVerts")
  475.                                            )
  476.                                            (vlax-ldata-get x "Position")
  477.                                            " "
  478.                                            " "
  479.                                      )
  480.                                    )
  481.                                  )
  482.                                 (xdrx_pickset->ents ss)
  483.                         )
  484.                  nl     (cons "统计表"
  485.                               (cons '("回路" "控制" "编号" "类型" "功率" "数量" "总功率" "位置"
  486.                                       "备注" " "
  487.                                      )
  488.                                     (vl-sort nl '(lambda (x1 x2) (< (car x1) (car x2))))
  489.                               )
  490.                         )
  491.            )
  492.            (if (setq p (getpoint "\n插入点<回车显示>: "))
  493.              (xd::table:make
  494.                (reverse (cons '(" ") (reverse nl)))
  495.                p
  496.                (* 3 height)
  497.                height
  498.              )
  499.              (foreach x nl (princ "\n") (princ x))
  500.            )
  501.            (xd::excel:createToFile
  502.              (strcat (getvar "dwgprefix")
  503.                      (vl-filename-base (getvar "dwgname"))
  504.                      ".xls"
  505.              )
  506.              (cdr nl)
  507.            ) ;_写出 excel 文件
  508.            (xdrx_system_shellexecute
  509.              (strcat (getvar "dwgprefix")
  510.                      (vl-filename-base (getvar "dwgname"))
  511.                      ".xls"
  512.              )
  513.            )
  514.     )
  515.   )
  516.   (princ)
  517. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

签到天数: 1031 天

连续签到: 3 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 1256个

财富等级: 财源广进

 楼主| 发表于 2014-11-28 14:44:07 | 显示全部楼层
更新
将块名记录到文字的 xdata

点评

回路连线XDTB_DRAWCIRCUIT [attachimg]11800[/attachimg] [attachimg]11801[/attachimg] 增加减少回路点 XDTB_CIRCUITNODE [attachimg]11802[/attachimg] 统计数据。XDTB_CALCIRCUIT [attachimg]11804[  详情 回复 发表于 2014-12-2 21:43
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1031 天

连续签到: 3 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 1256个

财富等级: 财源广进

 楼主| 发表于 2014-11-28 20:43:16 | 显示全部楼层
更新,回路连线保存到 文字词典

点评

能支持自定义字典就好了,就是有的回路号可以预置几个进去,画的时候就自带上去,可以选,对了字体的高度是哪个参数。。是(getvar "textsize") 后边的0.0吗?  详情 回复 发表于 2014-11-29 00:07
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 114 天

连续签到: 1 天

[LV.6]常住居民II

发表于 2014-11-29 00:07:39 | 显示全部楼层
st788796 发表于 2014-11-28 20:43
更新,回路连线保存到 文字词典

能支持自定义字典就好了,就是有的回路号可以预置几个进去,画的时候就自带上去,可以选,对了字体的高度是哪个参数。。是(getvar "textsize")
                        后边的0.0吗?

点评

现在几乎是完美了,再加上我说的能自定义预置字典内容,回路字体大小可以设置的话,可以说是没有什么挑剔了,我会准备个完整的图纸在此贴将动画整理发布一下。。在此感谢st788796[/backcolor]老师的耐心梳理我  详情 回复 发表于 2014-11-29 00:29
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 114 天

连续签到: 1 天

[LV.6]常住居民II

发表于 2014-11-29 00:29:22 | 显示全部楼层
grs432 发表于 2014-11-29 00:07
能支持自定义字典就好了,就是有的回路号可以预置几个进去,画的时候就自带上去,可以选,对了字体的高度 ...

      现在几乎是完美了,再加上我说的能自定义预置字典内容,回路字体大小可以设置的话,可以说是没有什么挑剔了,我会准备个完整的图纸在此贴将动画整理发布一下。。在此感谢st788796老师的耐心梳理我对程序的调试意见,并给出了正确的程序执行方式,真的在工作上方便了好多呀!完成今天的成果,我真是无法用语言来表达对st788796老师的感激之情,再次感谢呀!!
         后期我个人会自己加强自己对lisp的学习,希望能自己读懂st788796老师所写的内容!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1031 天

连续签到: 3 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 1256个

财富等级: 财源广进

 楼主| 发表于 2014-12-2 17:04:47 | 显示全部楼层
2014.12.02 updata
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1191 天

连续签到: 50 天

[LV.10]以坛为家III

已领礼包: 40个

财富等级: 招财进宝

发表于 2014-12-2 17:20:08 | 显示全部楼层
赞一个,很成功的一次完善过程。程序最终也很牛。

点评

是的,,ST老师的思路很清析,可以说比我这个做这个专业的人都了解绘制的过程,特别是UI的页面制作,很漂亮。。赞1个。我也在学习,通过与ST老师沟通这个程序的过程,可以让我对lisp入门些。。  详情 回复 发表于 2014-12-2 17:36
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 114 天

连续签到: 1 天

[LV.6]常住居民II

发表于 2014-12-2 17:36:30 | 显示全部楼层
newer 发表于 2014-12-2 17:20
赞一个,很成功的一次完善过程。程序最终也很牛。

是的,,ST老师的思路很清析,可以说比我这个做这个专业的人都了解绘制的过程,特别是UI的页面制作,很漂亮。。赞1个。我也在学习,通过与ST老师沟通这个程序的过程,可以让我对lisp入门些。。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1031 天

连续签到: 3 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 1256个

财富等级: 财源广进

 楼主| 发表于 2014-12-2 17:41:32 | 显示全部楼层
grs432 发表于 2014-12-2 17:36
是的,,ST老师的思路很清析,可以说比我这个做这个专业的人都了解绘制的过程,特别是UI的页面制作,很漂 ...

抽空做几个 动画 补到这个帖子吧
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1031 天

连续签到: 3 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 1256个

财富等级: 财源广进

 楼主| 发表于 2014-12-2 17:48:43 | 显示全部楼层
另外一个配套程序也转过来
  1. ;;对回路连线增删顶点
  2. (defun c:XDTB_CircuitNode (/               _removevertexat
  3.                            _addvertexat                   _pnt:toline
  4.                            e               tf           p
  5.                            key               pr
  6.                           )
  7.   (defun _pnt:toline (p p1 p2)
  8.     (last (trans (mapcar '- p p1) 0 (mapcar '- p2 p1)))
  9.   )
  10.   (defun _removevertexat (e p / n bulge p p1 p2 d)
  11.     (setq n (fix (xdrx_curve_getparamatpoint e p)))
  12.     (if        (or (zerop n) (= n (1- (xdrx_polyline_numverts e))))
  13.       (xdrx_polyline_removevertexat e n)
  14.       (progn
  15.         (setq bulge (xdrx_polyline_getbulgeat e n)
  16.               p            (xdrx_curve_getpointatparam e (+ n 0.5))
  17.               p1    (xdrx_polyline_getpointat e (1- n))
  18.               p2    (xdrx_polyline_getpointat e (1+ n))
  19.               d            (distance
  20.                       p
  21.                       (xdrx_line_midp
  22.                         (xdrx_polyline_getpointat e n)
  23.                         p2
  24.                       )
  25.                     )
  26.         )
  27.         (xdrx_polyline_removevertexat e n)
  28.         (xdrx_polyline_setbulgeat
  29.           e
  30.           (1- n)
  31.           (if (minusp bulge)
  32.             (- (/ (* 2.0 d) (distance p1 p2)))
  33.             (/ (* 2.0 d) (distance p1 p2))
  34.           )
  35.         )
  36.       )
  37.     )
  38.   )
  39.   (defun _addvertexat (e p / n p1 p2 pm d bulge p0 tf1 tmp tf)
  40.     (setq p0 (xdrx_curve_getclosestpoint e p)
  41.           n  (fix (xdrx_curve_getparamatpoint e p0))
  42.     )
  43.     (if        (setq tf1 (= n (1- (xdrx_polyline_numverts e))))
  44.       (setq p1          (xdrx_curve_getpointatparam e (1- n))
  45.             p2          (xdrx_curve_getpointatparam e n)
  46.             pm          (xdrx_curve_getpointatparam e (- n 0.5))
  47.             bulge (xdrx_polyline_getbulgeat e (1- n))
  48.       )
  49.       (setq p1          (xdrx_curve_getpointatparam e n)
  50.             p2          (xdrx_curve_getpointatparam e (1+ n))
  51.             pm          (xdrx_curve_Getpointatparam e (+ n 0.5))
  52.             bulge (xdrx_polyline_getbulgeat e n)
  53.       )
  54.     )
  55.     (setq d  (distance pm (xdrx_line_midp p1 p2))
  56.           tf (_pnt:toline p p1 p2)
  57.     )
  58.     (cond
  59.       ((and (zerop n) (minusp tf))
  60.        (xdrx_polyline_setpointat e 0 p)
  61.        (setq tmp p1
  62.              p1         p
  63.              p         tmp
  64.        )
  65.       )
  66.       ((and tf1 (>= (_pnt:toline p p1 p2) (distance p1 p2)))
  67.        (xdrx_polyline_setpointat e n p)
  68.        (setq tmp p2
  69.              p2         p
  70.              p         tmp
  71.              n         (1- n)
  72.        )
  73.       )
  74.       (t)
  75.     )
  76.     (xdrx_polyline_addvertexat e (1+ n) p)
  77.     (xdrx_polyline_setbulgeat
  78.       e
  79.       n
  80.       (if (minusp bulge)
  81.         (- (/ (* 2.0 d) (distance p p1)))
  82.         (/ (* 2.0 d) (distance p p1))
  83.       )
  84.     )
  85.     (xdrx_polyline_setbulgeat
  86.       e
  87.       (1+ n)
  88.       (if (minusp bulge)
  89.         (- (/ (* 2.0 d) (distance p p2)))
  90.         (/ (* 2.0 d) (distance p p2))
  91.       )
  92.     )
  93.   )
  94.   ;;main program
  95.   (if (setq e (car (xdrx_entsel "\n选择回路线: " '((0 . "lwpolyline")))))
  96.     (progn
  97.       (setq tf        t
  98.             key        "D"
  99.             pr        "\r"
  100.       )
  101.       (while tf
  102.         (initget 128 "A D")
  103.         (setq p
  104.                (getpoint (strcat pr "拾取点[删点(D)/增点(A)]<" key ">: "))
  105.         )
  106.         (cond
  107.           ((and (not (null p)) (listp p))
  108.            (if (= key "D")
  109.              (_removevertexat e p)
  110.              (_addvertexat e p)
  111.            )
  112.            (setq pr "\r")
  113.           )
  114.           ((= p "A") (setq key "A") (setq pr "\n"))
  115.           ((= p "D") (setq key "D") (setq pr "\n"))
  116.           (t (setq tf nil))
  117.         )
  118.       )
  119.     )
  120.   )
  121.   (princ)
  122. )

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 114 天

连续签到: 1 天

[LV.6]常住居民II

发表于 2014-12-2 21:43:50 | 显示全部楼层
st788796 发表于 2014-11-28 14:44
更新
将块名记录到文字的 xdata

回路连线XDTB_DRAWCIRCUIT
XDTB_DRAWCIRCUIT1.gif

XDTB_DRAWCIRCUIT2.gif

增加减少回路点
XDTB_CIRCUITNODE
XDTB_CIRCUITNODE.gif

统计数据。XDTB_CALCIRCUIT
XDTB_CALCIRCUIT.gif

点评

相当专业的几个插件了,演示也做的相当专业,以后还有需要,还如此的交互吧,相信你能学到很多东西。这是论坛比群更适合讨论问题的地方。  详情 回复 发表于 2014-12-2 22:00
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1191 天

连续签到: 50 天

[LV.10]以坛为家III

已领礼包: 40个

财富等级: 招财进宝

发表于 2014-12-2 22:00:24 | 显示全部楼层
grs432 发表于 2014-12-2 21:43
回路连线XDTB_DRAWCIRCUIT

相当专业的几个插件了,演示也做的相当专业,以后还有需要,还如此的交互吧,相信你能学到很多东西。这是论坛比群更适合讨论问题的地方。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1031 天

连续签到: 3 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 1256个

财富等级: 财源广进

 楼主| 发表于 2014-12-3 07:56:09 | 显示全部楼层
grs432 发表于 2014-12-2 21:43
回路连线XDTB_DRAWCIRCUIT

引出点时直接回车就在端点处引出,单独指定是为了在中间节点处引出(不知道专业是否需要,如果没有这种情况可以简化掉这一步)

点评

鼠标引出是需要的,可以不在端点引出。这样子也方便,毕竟做图时有的位置不适合放的。。  详情 回复 发表于 2014-12-3 10:01
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1031 天

连续签到: 3 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 1256个

财富等级: 财源广进

 楼主| 发表于 2014-12-3 09:23:30 来自手机 | 显示全部楼层
有两处细节下次完善,当图中存在编号时,随便取一个的图层和字高作默认值

点评

这个功能加入会更好的。。  详情 回复 发表于 2014-12-3 10:02
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 114 天

连续签到: 1 天

[LV.6]常住居民II

发表于 2014-12-3 10:01:15 | 显示全部楼层
st788796 发表于 2014-12-3 07:56
引出点时直接回车就在端点处引出,单独指定是为了在中间节点处引出(不知道专业是否需要,如果没有这种情 ...

鼠标引出是需要的,可以不在端点引出。这样子也方便,毕竟做图时有的位置不适合放的。。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2018-12-11 01:17 , Processed in 0.242914 second(s), 63 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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