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

st788796 · 发表于 2014-11-20 17:32:25

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

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

×

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

(defun _Excel:getFromFile (fn / lst)
(setq lst (xd::excel:getFromFile (findfile fn) 0)
lst (mapcar '(lambda (x) (mapcar '(lambda (a) (cadr a)) x)) lst)
)
(list (mapcar 'car lst)
(mapcar 'cadr lst)
(mapcar 'caddr lst)
(mapcar 'cadddr lst)
)
)
;;===================================================;
;; 对话框控制 ;
;;===================================================;
(defun _Circuit:Control (/ strl)
(setq strl '("YWt6A+xBAADGLmvOBuKT5SUSaitmuYElBOec/HtTKD6jrPRWaAXB9mxdyNwuJKVWODKWCAXroBJ1"
"096qFtxaK487Sqs6oYq/dVignP3plP3Ah5b9XwNKL5oz82mUCcAjRA3AJxnNow8I9M2zkrABsLLn"
"TZkCwYFHDRgkygYfb/dbWfQQ+n4CKX7SKFXKz8JwM9Y8URRWz/SoVW47Y9Rv3cskiu4U3ssQpCy1"
"FfPKqDUBq9qUrzk5uhaX9+EaL5smM9TsiNDaoViEK0eoLeAD4h1z4zubrToVq+osP6XVlsnpjNfZ"
"HQSXckuKJfkc+itfUf2EEvhvPHBsYUQzIHU4T/AfRKaGeJVR2FoIT0TudbW55p9VmbHxKjIdYAck"
"hARNg23bKfuKnUFIrScBVoo5PAFeym+0MdL4KjNnAfeM6xdp6QWI/42x4UOLh3edJRNF8hMYwJPK"
"GIJzQ6Gp+kBUik/fafuAP5ZXMxHynyhynnZ4Tzqh+R5IvF/KH3qJrkz2NyTcyrle8C8FZFH1QuFt"
"RCGqs+FcAySpH6sMKcygWt1cwfv0bdt8134zaGlHTuiUwrPStRM0mRUnm7IJ8Itk1bMILEWlnBg6"
"RVii9DA6FmfefHKvIXoJrwnBaCFZqw+7XKCkM4P0rInnJGumxiCWg9hA3YogbxGF+hBrhCDfb6zR"
"Lbijc9xgUg+G3Kw9NZfCo0ZSio6sgN8hawHdXINvIw1lIbCk1/PVIkEPGE/txR+YybCxGJlwBG9J"
"YnnoxqdtrJ2Yc4ZFEKDcW9KIIL0M+dPjiT+LJtQ87AXCyyPawZn0hMjKpU3OzdCks0ZdQocDLwjJ"
"pIotzVKZKidTEyLajKdQjMvKB0+KSKFXpMIyl+E6ZSYcHnWKZkZzaRxe80hRL0RSgkMxhoEFXINj"
"36FrhBPfo8j6J++Bx9uV85V1mIACw8H2nQE4/9i1u4+Zs4zWURgcUxVZWNT99DIv71AEOGmS4K+k"
"/2dZsR6T/xlWhQqMcksqzAS4E7xNtC0GuCCW4E9ykUP95/ZJ2G1tS39toE8veUVtCQppiNH6ACqr"
"/+v3I/z301fm5v6wOk3MurpLUuPm1nPmjvD3Gh21nfGxYCZ3MrI9GZx7ljJi+4G56LK6y1Lj5tZ1"
"5o7w973OTY8Euc1tgXlYEPmwug8a9/eVJkRPL2FOn2NtkzYMQa9InAZBn2lYwPqwuleWMjK/5/d5"
"302v+1JPbx+Xujo9vvoJMkq+sLrlz4Tw67462IO63a7nxmUnHNzq221t839toE/f2H9bbXlwAEHJ"
"bOaGfERtguK2vLpK4ufm/bD6ZKgFsDpfA9MdJxcdXLQrq/APi+7NIbqmpIFG2HH2ghvyaRfEqpe/"
"04tEnPEPRUdyCK1vLyyD2gQeQpJR9FLqqlYT5u/WCEnUsopgxjb6+34AZA0kmqXyzujR+/Y0ljo6"
"FrOm7ga9n5yAIXfMU7rWWRg44zZRa2/DvWyPXxm8uN5tyHlQbui/bT+bdh9rGjtSCaf25b5aOxf8"
"RqeV2pQbClzJRm8fQzHi9hh0XIsc/R68E9TFO+cxdFPXkTOffNF0k0u9A5wCV+bAO7oIm8HBu435"
"lkfHxmgxBjaXMuGw0g3XqRJqmcsGdkFv62DMIyIpVHHHJ04mX4oznILXQri/LQDhD4jqaJbgTHBp"
"Qts36glH4GwJG8XZ8m6DvbqLb1TU+Y+HaqLzMZCN/IYyZ+FC9Mq6WfFMzWLhZwgbP0nqGEm6AA57"
"FcVhViZ4d+x/lJNDin1LdgqtcSi/YQDOfqNxBrKX3GGOIxZ4AI5sCkFWPQiD3nX/YQaQeZSW1Sah"
"FgWxwuG4e91KRGY1BSC5PEnBBRcFmY6VbSCyrVpbSPOJNjUsojuMhbRo/FwO/14HaccrRjJkOo/2"
"OjAn0MfK2GIH4NRaD8dM/PmW8ItPdOaqnSWnYSeYKoZTTWGw10o88SDwqEqYKkYE45kqdAntf3Ld"
"5cCR2hskw/DiuFL1WQLav73tNIUFxKyNYP+Hx+TL8+GiN9wZsoENwgDg3wNkJm9NynU2TCQzvTMG"
"SpScchN6xAnO6RqvRcTuHhtdNQUhTTh4R2uRFXwk6DW1fnwkbJsw9ejjrhcHfEDfG201ZVP43Btc"
"j3Ht3WZ35idATYVvTu1WCSSyonHj52YCvLIY6EgYdBwytFqh63F7uiKEMbNpnlEcgoiqwlWPhXEo" "c6ri"
)
)
(setq *allPres* (acad_strlsort
(vl-remove-if
'(lambda (x) (= x "cPrefix"))
(mapcar 'car (vlax-ldata-list "XD_Circuit_Dict"))
)
)
*circuitdict* (_excel:getfromfile "circuitdict.xls")
)
(dcl_project_import strl)
(dcl_form_show ab/Form1)
)
(defun _Odcl:AddList (ctrl lst default /)
(dcl_ComboBox_AddList ctrl lst)
(dcl_combobox_setcursel ctrl default)
)
(defun c:ab/form1/OnInitialize (/ lst)
(dcl_combobox_addlist
ab/form1/type
(mapcar 'vl-princ-to-string
(cdr (assoc "类型" *circuitdict*))
)
)
(dcl_combobox_setcursel ab/form1/type 0)
(dcl_combobox_addlist
ab/form1/power
(mapcar 'vl-princ-to-string
(cdr (assoc "功率" *circuitdict*))
)
)
(dcl_combobox_setcursel ab/form1/power 0)
(dcl_combobox_addlist
ab/form1/position
(mapcar 'vl-princ-to-string
(cdr (assoc "位置" *circuitdict*))
)
)
(dcl_combobox_setcursel ab/form1/position 0)
(dcl_combobox_addlist
ab/form1/control
(mapcar 'vl-princ-to-string
(cdr (assoc "控制" *circuitdict*))
)
)
(dcl_combobox_setcursel ab/form1/control 0)
(apply 'dcl_control_setpos
(cons ab/form1 (last (xdrx_document_pixelbox)))
)
(_Odcl:Addlist
ab/form1/allPre
*allpres*
(vl-position
(vlax-ldata-get "XD_Circuit_Dict" "cPrefix")
*allPres*
)
)
(dcl_control_settext
ab/form1/numCur
(itoa (vlax-ldata-get
"XD_Circuit_Dict"
(vlax-ldata-get "XD_Circuit_Dict" "cPrefix")
)
)
)
(dcl_control_settext
ab/form1/strPre
(vlax-ldata-get "XD_Circuit_Dict" "cPrefix")
)
(dcl_combobox_setcursel
ab/form1/layer
(vl-position
(getvar "clayer")
(mapcar 'car (xd::object:get "layer"))
)
)
(dcl_Control_SetJustification ab/form1/height 1)
(dcl_control_settext ab/form1/height "2.5")
)
(defun c:ab/form1/strPre_OnEditChanged (NewValue /)
(if (not (member newvalue *allpres*))
(progn (setq *allPres* (acad_strlsort (cons newvalue *allpres*)))
(vlax-ldata-put "XD_Circuit_Dict" newvalue 1)
(_Odcl:Addlist
ab/form1/allPre
*allpres*
(vl-position
(vlax-ldata-get "XD_Circuit_Dict" "cPrefix")
*allPres*
)
)
(dcl_control_settext ab/form1/numCur "1")
(vlax-ldata-put "XD_Circuit_Dict" "cPrefix" newvalue)
)
)
)
(defun c:ab/form1/numCur_OnEditChanged (NewValue /)
(vlax-ldata-put
"XD_Circuit_Dict"
(dcl_control_gettext ab/form1/strPre)
(atoi newvalue)
)
)
(defun c:ab/form1/allPre_OnSelChanged (ItemIndexOrCount Value /)
(dcl_control_settext ab/form1/strPre value)
(dcl_control_settext
ab/form1/numCur
(vlax-ldata-get "XD_Circuit_Dict" value)
)
(vlax-ldata-put "XD_Circuit_Dict" "cPrefix" value)
)
;;===================================================;
;; 建立回路数据 ;
;;===================================================;
(defun _Circuit:Create (txt blk pl pl1 / ctype cposition cpower ccontrol lyr)
(setq ctype (nth (dcl_combobox_getcursel ab/form1/type)
(cdr (assoc "类型" *circuitdict*))
)
cposition (nth (dcl_combobox_getcursel ab/form1/position)
(cdr (assoc "位置" *circuitdict*))
)
cpower (nth (dcl_combobox_getcursel ab/form1/power)
(cdr (assoc "功率" *circuitdict*))
)
ccontrol (nth (dcl_combobox_getcursel ab/form1/control)
(cdr (assoc "控制" *circuitdict*))
)
)
(vlax-ldata-put txt "Type" ctype)
(vlax-ldata-put txt "Power" cpower)
(vlax-ldata-put txt "Control" ccontrol)
(vlax-ldata-put txt "Position" cposition)
(if (/= (setq lyr (nth (dcl_combobox_getcursel ab/form1/layer)
(dcl_control_getlist ab/form1/layer)
)
)
(getvar "clayer")
)
(xdrx_entity_setlayer txt lyr)
)
(if (not blk)
(setq blk (car
(xdrx_entsel "\n拾取图块或文字: " '((0 . "insert,*text")))
)
)
)
(if (eq (type blk) 'ENAME)
(if (= (xdrx_getpropertyvalue blk "IsA") "AcDbBlockReference")
(setq blk (car (xdrx_getpropertyvalue blk "BlockTableRecord")))
(setq blk (xdrx_getpropertyvalue blk "textString"))
)
)
(if blk
(xdrx_xdata_setbyproperty txt "XDCircuit" "String" blk)
)
(if (= (dcl_control_getvalue ab/form1/group) 1)
(if pl1
(xdrx_group_make "*" pl txt pl1)
(xdrx_group_make "*" pl txt)
)
)
(vlax-ldata-put
txt
"Circuit"
(xdrx_getpropertyvalue pl "Handle")
)
(vlax-ldata-put
"XD_Circuit_Dict"
(dcl_control_gettext ab/form1/strPre)
(1+ (atoi (dcl_control_gettext ab/form1/numCur)))
)
(dcl_control_settext
ab/form1/numCur
(itoa (vlax-ldata-get
"xd_circuit_dict"
(dcl_control_gettext ab/form1/strPre)
)
)
)
)
;;===================================================;
;; 初始数据 ;
;;===================================================;
(defun _Circuit:CheckDict (/ tf str num)
(if (and (not (setq tf (vlax-ldata-list "XD_Circuit_Dict")))
(progn (princ "\n**当前图形未包含初始数据**") t)
(setq str (getstring "\n前缀: "))
(setq num (getint "\n编号: "))
)
(progn (vlax-ldata-put "XD_Circuit_Dict" str num)
(vlax-ldata-put "XD_Circuit_Dict" "cPrefix" str)
(setq tf t)
)
)
tf
)
;;===================================================;
;; 绘制连接 ;
;;===================================================;
(defun c:XDTB_DrawCircuit (/ myerr olderr tf str num maxnums cPrefix p pts p d pl pl1 p1 str tf strl
tf1 tf3 tf2 txt blklst blk
)
(defun myerr (msg)
(princ "\n*cancel*")
(setq *error* olderr)
(if (dcl_form_isactive ab/form1)
(dcl_form_close ab/form1)
)
(xdrx_sysvar_pop)
(princ)
)
(if (_Circuit:CheckDict)
(progn (setq olderr *error*
*error* myerr
tf1 t
)
(_Circuit:Control)
(xdrx_sysvar_push '("osmode" 64))
(while (and tf1 (dcl_form_isactive ab/form1))
(setq tf2 t
pts nil
pl nil
blklst nil
)
(while (and tf2
(progn (initget 128 "E U")
(setq p (if pts
(getpoint (car pts) "\r下一点[回退(U)/退出(E)]: ")
(getpoint "\r起点[退出(E)]: ")
)
)
)
(dcl_form_isactive ab/form1)
)
(if (listp p)
(progn (setq pts (cons p pts))
(if (= (length pts) 2)
(progn (setq p (getpoint (apply 'xdrx_line_midp pts) "\n弦高: ")
d (* 2 (xdrx_point_dist2line p (cadr pts) (car pts)))
)
(setq pl (xdrx_polyline_make (cadr pts) (car pts)))
(xdrx_polyline_setbulgeat pl 0 (/ d (apply 'distance pts)))
)
)
(if (setq ss (xdrx_pickset_getatpoint (car pts) '((0 . "insert"))))
(setq blklst (mapcar '(lambda (x)
(car (xdrx_getpropertyvalue x "BlockTableRecord"))
)
(xdrx_pickset->ents ss)
)
)
)
(if (and pl (> (length pts) 2))
(progn (setq n (xdrx_polyline_numverts pl))
(xdrx_polyline_setpointat pl (1- n) (car pts))
(xdrx_polyline_addvertexat pl (1- n) (cadr pts))
(xdrx_polyline_setbulgeat
pl
(- n 2)
(/ d (distance (cadr pts) (caddr pts)))
)
(xdrx_polyline_setbulgeat
pl
(1- n)
(/ d (distance (car pts) (cadr pts)))
)
)
)
(setq tf3 t)
)
(cond ((= p "E")
(setq tf1 nil
tf2 nil
)
)
((= p "U")
(if pl
(progn (xdrx_polyline_removevertexat
pl
(1- (xdrx_polyline_numverts pl))
)
(setq pts (cdr pts))
)
)
(setq tf3 nil)
)
(t
(setq tf2 nil
tf3 t
)
)
)
)
)
(if (and tf1
tf3
pl
(dcl_form_isactive ab/form1)
(if (setq p (getpoint "\n引出点<回车端点>: "))
(progn (setq tf nil) p)
(setq tf t
p (xdrx_curve_getendpoint pl)
)
)
(setq p1 (getpoint p "\n标注点: "))
(dcl_form_isactive ab/form1)
(setq str (strcat (dcl_control_gettext ab/form1/strPre)
(xd::string:strpad
(atoi (dcl_control_gettext ab/form1/numCur))
2
"0"
0
)
)
)
)
(progn (setq txt (xdrx_text_make
p1
(strcase str)
(distof (dcl_control_gettext ab/form1/height))
0.0
)
pl1 (xdrx_polyline_make p p1)
)
(xdrx_polyline_setbulgeat pl1 0 0.5)
(if (and blklst (apply '= blklst))
(setq blk (car blklst))
)
(_Circuit:Create txt blk pl pl1)
)
)
)
(dcl_form_close ab/form1)
(xdrx_sysvar_pop)
(setq *error* olderr)
)
)
(princ)
)
;;===================================================;
;; 处理旧图 ;
;;===================================================;
(defun c:xdtb_createCircuit (/ myerr olderr allpres circuitdict strl pl txt blk)
(defun myerr (msg)
(princ "\n*cancel*")
(setq *error* olderr)
(if (dcl_form_isactive ab/form1)
(dcl_form_close ab/form1)
)
(xdrx_sysvar_pop)
(princ)
)
(setq olderr *error*
*error* myerr
)
(if (_Circuit:Control)
(while (and (setq pl (car (xdrx_entsel
"\n拾取回路Pline<退出>: "
'((0 . "LWPOLYLINE"))
)
)
)
(setq txt (car (xdrx_entsel "\n拾取回路编号<退出>: " '((0 . "*TEXT")))
)
)
(progn (setq str (xdrx_getpropertyvalue txt "textstring")
curPre (xdrx_string_trimright str "0123456789")
num (substr str (1+ (strlen curpre)))
)
(distof num)
(princ (strcat "\n前缀 =" str " ; " "编号 = " num))
(setq num (atoi num))
(if (= (xdrx_yesorno "\n接受") 1)
t
(and (setq str (getstring "\n前缀: "))
(setq num (getint "\n编号: "))
)
)
)
(setq blk (car (xdrx_entsel
"\n拾取图块或文字<退出>: "
'((0 . "INSERT,*TEXT"))
)
)
)
(dcl_form_isactive ab/form1)
)
(if (not (member str *allPres*))
(progn (setq *allPres* (acad_strlsort (cons str *allpres*)))
(vlax-ldata-put "XD_Circuit_Dict" str num)
(_Odcl:Addlist
ab/form1/allPre
*allpres*
(vl-position
(vlax-ldata-get "XD_Circuit_Dict" "cPrefix")
*allPres*
)
)
)
(progn (dcl_control_settext ab/form1/strPre str)
(dcl_control_settext ab/form1/numCur (itoa num))
(dcl_combobox_setcursel
ab/form1/allPre
(vl-position str *allPres*)
)
)
)
(_Circuit:Create txt blk pl nil)
)
)
(dcl_form_close ab/form1)
(xdrx_sysvar_pop)
(setq *error* olderr)
(princ)
)
;;===================================================;
;; 统计回路 ;
;;===================================================;
(defun c:XDTB_CalCircuit (/ ss nl height)
(if (setq ss (ssget '((0 . "text") (-3 ("XDCircuit")))))
(progn (setq height (xdrx_getpropertyvalue (ssname ss 0) "height")
nl (mapcar '(lambda (x / pl)
(if (setq pl (handent (vlax-ldata-get x "Circuit")))
(list (xdrx_getpropertyvalue x "textstring")
(vlax-ldata-get x "Power")
(xdrx_xdata_get x "XDCircuit")
(vlax-ldata-get x "Type")
(vlax-ldata-get x "Power")
(itoa (xdrx_getpropertyvalue pl "numVerts"))
(* (vlax-ldata-get x "Power")
(xdrx_getpropertyvalue pl "numVerts")
)
(vlax-ldata-get x "Position")
" "
" "
)
)
)
(xdrx_pickset->ents ss)
)
nl (cons "统计表"
(cons '("回路" "控制" "编号" "类型" "功率" "数量" "总功率" "位置"
"备注" " "
)
(vl-sort nl '(lambda (x1 x2) (< (car x1) (car x2))))
)
)
)
(if (setq p (getpoint "\n插入点<回车显示>: "))
(xd::table:make
(reverse (cons '(" ") (reverse nl)))
p
(* 3 height)
height
)
(foreach x nl (princ "\n") (princ x))
)
(xd::excel:createToFile
(strcat (getvar "dwgprefix")
(vl-filename-base (getvar "dwgname"))
".xls"
)
(cdr nl)
) ;_写出 excel 文件
(xdrx_system_shellexecute
(strcat (getvar "dwgprefix")
(vl-filename-base (getvar "dwgname"))
".xls"
)
)
)
)
(princ)
)

(defun _Excel:getFromFile (fn / lst) 
  (setq lst (xd::excel:getFromFile (findfile fn) 0) 
        lst (mapcar '(lambda (x) (mapcar '(lambda (a) (cadr a)) x)) lst) 
  ) 
  (list (mapcar 'car lst) 
        (mapcar 'cadr lst) 
        (mapcar 'caddr lst) 
        (mapcar 'cadddr lst) 
  ) 
) 
;;===================================================; 
;;          对话框控制                               ; 
;;===================================================; 
(defun _Circuit:Control (/ strl) 
  (setq strl '("YWt6A+xBAADGLmvOBuKT5SUSaitmuYElBOec/HtTKD6jrPRWaAXB9mxdyNwuJKVWODKWCAXroBJ1" 
               "096qFtxaK487Sqs6oYq/dVignP3plP3Ah5b9XwNKL5oz82mUCcAjRA3AJxnNow8I9M2zkrABsLLn" 
               "TZkCwYFHDRgkygYfb/dbWfQQ+n4CKX7SKFXKz8JwM9Y8URRWz/SoVW47Y9Rv3cskiu4U3ssQpCy1" 
               "FfPKqDUBq9qUrzk5uhaX9+EaL5smM9TsiNDaoViEK0eoLeAD4h1z4zubrToVq+osP6XVlsnpjNfZ" 
               "HQSXckuKJfkc+itfUf2EEvhvPHBsYUQzIHU4T/AfRKaGeJVR2FoIT0TudbW55p9VmbHxKjIdYAck" 
               "hARNg23bKfuKnUFIrScBVoo5PAFeym+0MdL4KjNnAfeM6xdp6QWI/42x4UOLh3edJRNF8hMYwJPK" 
               "GIJzQ6Gp+kBUik/fafuAP5ZXMxHynyhynnZ4Tzqh+R5IvF/KH3qJrkz2NyTcyrle8C8FZFH1QuFt" 
               "RCGqs+FcAySpH6sMKcygWt1cwfv0bdt8134zaGlHTuiUwrPStRM0mRUnm7IJ8Itk1bMILEWlnBg6" 
               "RVii9DA6FmfefHKvIXoJrwnBaCFZqw+7XKCkM4P0rInnJGumxiCWg9hA3YogbxGF+hBrhCDfb6zR" 
               "Lbijc9xgUg+G3Kw9NZfCo0ZSio6sgN8hawHdXINvIw1lIbCk1/PVIkEPGE/txR+YybCxGJlwBG9J" 
               "YnnoxqdtrJ2Yc4ZFEKDcW9KIIL0M+dPjiT+LJtQ87AXCyyPawZn0hMjKpU3OzdCks0ZdQocDLwjJ" 
               "pIotzVKZKidTEyLajKdQjMvKB0+KSKFXpMIyl+E6ZSYcHnWKZkZzaRxe80hRL0RSgkMxhoEFXINj" 
               "36FrhBPfo8j6J++Bx9uV85V1mIACw8H2nQE4/9i1u4+Zs4zWURgcUxVZWNT99DIv71AEOGmS4K+k" 
               "/2dZsR6T/xlWhQqMcksqzAS4E7xNtC0GuCCW4E9ykUP95/ZJ2G1tS39toE8veUVtCQppiNH6ACqr" 
               "/+v3I/z301fm5v6wOk3MurpLUuPm1nPmjvD3Gh21nfGxYCZ3MrI9GZx7ljJi+4G56LK6y1Lj5tZ1" 
               "5o7w973OTY8Euc1tgXlYEPmwug8a9/eVJkRPL2FOn2NtkzYMQa9InAZBn2lYwPqwuleWMjK/5/d5" 
               "302v+1JPbx+Xujo9vvoJMkq+sLrlz4Tw67462IO63a7nxmUnHNzq221t839toE/f2H9bbXlwAEHJ" 
               "bOaGfERtguK2vLpK4ufm/bD6ZKgFsDpfA9MdJxcdXLQrq/APi+7NIbqmpIFG2HH2ghvyaRfEqpe/" 
               "04tEnPEPRUdyCK1vLyyD2gQeQpJR9FLqqlYT5u/WCEnUsopgxjb6+34AZA0kmqXyzujR+/Y0ljo6" 
               "FrOm7ga9n5yAIXfMU7rWWRg44zZRa2/DvWyPXxm8uN5tyHlQbui/bT+bdh9rGjtSCaf25b5aOxf8" 
               "RqeV2pQbClzJRm8fQzHi9hh0XIsc/R68E9TFO+cxdFPXkTOffNF0k0u9A5wCV+bAO7oIm8HBu435" 
               "lkfHxmgxBjaXMuGw0g3XqRJqmcsGdkFv62DMIyIpVHHHJ04mX4oznILXQri/LQDhD4jqaJbgTHBp" 
               "Qts36glH4GwJG8XZ8m6DvbqLb1TU+Y+HaqLzMZCN/IYyZ+FC9Mq6WfFMzWLhZwgbP0nqGEm6AA57" 
               "FcVhViZ4d+x/lJNDin1LdgqtcSi/YQDOfqNxBrKX3GGOIxZ4AI5sCkFWPQiD3nX/YQaQeZSW1Sah" 
               "FgWxwuG4e91KRGY1BSC5PEnBBRcFmY6VbSCyrVpbSPOJNjUsojuMhbRo/FwO/14HaccrRjJkOo/2" 
               "OjAn0MfK2GIH4NRaD8dM/PmW8ItPdOaqnSWnYSeYKoZTTWGw10o88SDwqEqYKkYE45kqdAntf3Ld" 
               "5cCR2hskw/DiuFL1WQLav73tNIUFxKyNYP+Hx+TL8+GiN9wZsoENwgDg3wNkJm9NynU2TCQzvTMG" 
               "SpScchN6xAnO6RqvRcTuHhtdNQUhTTh4R2uRFXwk6DW1fnwkbJsw9ejjrhcHfEDfG201ZVP43Btc" 
               "j3Ht3WZ35idATYVvTu1WCSSyonHj52YCvLIY6EgYdBwytFqh63F7uiKEMbNpnlEcgoiqwlWPhXEo" "c6ri" 
              ) 
  ) 
  (setq *allPres*     (acad_strlsort 
                        (vl-remove-if 
                          '(lambda (x) (= x "cPrefix")) 
                          (mapcar 'car (vlax-ldata-list "XD_Circuit_Dict")) 
                        ) 
                      ) 
        *circuitdict* (_excel:getfromfile "circuitdict.xls") 
  ) 
  (dcl_project_import strl) 
  (dcl_form_show ab/Form1) 
) 
(defun _Odcl:AddList (ctrl lst default /) 
  (dcl_ComboBox_AddList ctrl lst) 
  (dcl_combobox_setcursel ctrl default) 
) 
(defun c:ab/form1/OnInitialize (/ lst) 
  (dcl_combobox_addlist 
    ab/form1/type 
    (mapcar 'vl-princ-to-string 
            (cdr (assoc "类型" *circuitdict*)) 
    ) 
  ) 
  (dcl_combobox_setcursel ab/form1/type 0) 
  (dcl_combobox_addlist 
    ab/form1/power 
    (mapcar 'vl-princ-to-string 
            (cdr (assoc "功率" *circuitdict*)) 
    ) 
  ) 
  (dcl_combobox_setcursel ab/form1/power 0) 
  (dcl_combobox_addlist 
    ab/form1/position 
    (mapcar 'vl-princ-to-string 
            (cdr (assoc "位置" *circuitdict*)) 
    ) 
  ) 
  (dcl_combobox_setcursel ab/form1/position 0) 
  (dcl_combobox_addlist 
    ab/form1/control 
    (mapcar 'vl-princ-to-string 
            (cdr (assoc "控制" *circuitdict*)) 
    ) 
  ) 
  (dcl_combobox_setcursel ab/form1/control 0) 
  (apply 'dcl_control_setpos 
         (cons ab/form1 (last (xdrx_document_pixelbox))) 
  ) 
  (_Odcl:Addlist 
    ab/form1/allPre 
    *allpres* 
    (vl-position 
      (vlax-ldata-get "XD_Circuit_Dict" "cPrefix") 
      *allPres* 
    ) 
  ) 
  (dcl_control_settext 
    ab/form1/numCur 
    (itoa (vlax-ldata-get 
            "XD_Circuit_Dict" 
            (vlax-ldata-get "XD_Circuit_Dict" "cPrefix") 
          ) 
    ) 
  ) 
  (dcl_control_settext 
    ab/form1/strPre 
    (vlax-ldata-get "XD_Circuit_Dict" "cPrefix") 
  ) 
  (dcl_combobox_setcursel 
    ab/form1/layer 
    (vl-position 
      (getvar "clayer") 
      (mapcar 'car (xd::object:get "layer")) 
    ) 
  ) 
  (dcl_Control_SetJustification ab/form1/height 1) 
  (dcl_control_settext ab/form1/height "2.5") 
) 
(defun c:ab/form1/strPre_OnEditChanged (NewValue /) 
  (if (not (member newvalue *allpres*)) 
    (progn (setq *allPres* (acad_strlsort (cons newvalue *allpres*))) 
           (vlax-ldata-put "XD_Circuit_Dict" newvalue 1) 
           (_Odcl:Addlist 
             ab/form1/allPre 
             *allpres* 
             (vl-position 
               (vlax-ldata-get "XD_Circuit_Dict" "cPrefix") 
               *allPres* 
             ) 
           ) 
           (dcl_control_settext ab/form1/numCur "1") 
           (vlax-ldata-put "XD_Circuit_Dict" "cPrefix" newvalue) 
    ) 
  ) 
) 
(defun c:ab/form1/numCur_OnEditChanged (NewValue /) 
  (vlax-ldata-put 
    "XD_Circuit_Dict" 
    (dcl_control_gettext ab/form1/strPre) 
    (atoi newvalue) 
  ) 
) 
(defun c:ab/form1/allPre_OnSelChanged (ItemIndexOrCount Value /) 
  (dcl_control_settext ab/form1/strPre value) 
  (dcl_control_settext 
    ab/form1/numCur 
    (vlax-ldata-get "XD_Circuit_Dict" value) 
  ) 
  (vlax-ldata-put "XD_Circuit_Dict" "cPrefix" value) 
) 
;;===================================================; 
;;            建立回路数据                           ; 
;;===================================================; 
(defun _Circuit:Create (txt blk pl pl1 / ctype cposition cpower ccontrol lyr) 
  (setq ctype     (nth (dcl_combobox_getcursel ab/form1/type) 
                       (cdr (assoc "类型" *circuitdict*)) 
                  ) 
        cposition (nth (dcl_combobox_getcursel ab/form1/position) 
                       (cdr (assoc "位置" *circuitdict*)) 
                  ) 
        cpower    (nth (dcl_combobox_getcursel ab/form1/power) 
                       (cdr (assoc "功率" *circuitdict*)) 
                  ) 
        ccontrol  (nth (dcl_combobox_getcursel ab/form1/control) 
                       (cdr (assoc "控制" *circuitdict*)) 
                  ) 
  ) 
  (vlax-ldata-put txt "Type" ctype) 
  (vlax-ldata-put txt "Power" cpower) 
  (vlax-ldata-put txt "Control" ccontrol) 
  (vlax-ldata-put txt "Position" cposition) 
  (if (/= (setq lyr (nth (dcl_combobox_getcursel ab/form1/layer) 
                         (dcl_control_getlist ab/form1/layer) 
                    ) 
          ) 
          (getvar "clayer") 
      ) 
    (xdrx_entity_setlayer txt lyr) 
  ) 
  (if (not blk) 
    (setq blk (car 
                (xdrx_entsel "\n拾取图块或文字: " '((0 . "insert,*text"))) 
              ) 
    ) 
  ) 
  (if (eq (type blk) 'ENAME) 
    (if (= (xdrx_getpropertyvalue blk "IsA") "AcDbBlockReference") 
      (setq blk (car (xdrx_getpropertyvalue blk "BlockTableRecord"))) 
      (setq blk (xdrx_getpropertyvalue blk "textString")) 
    ) 
  ) 
  (if blk 
    (xdrx_xdata_setbyproperty txt "XDCircuit" "String" blk) 
  ) 
  (if (= (dcl_control_getvalue ab/form1/group) 1) 
    (if pl1 
      (xdrx_group_make "*" pl txt pl1) 
      (xdrx_group_make "*" pl txt) 
    ) 
  ) 
  (vlax-ldata-put 
    txt 
    "Circuit" 
    (xdrx_getpropertyvalue pl "Handle") 
  ) 
  (vlax-ldata-put 
    "XD_Circuit_Dict" 
    (dcl_control_gettext ab/form1/strPre) 
    (1+ (atoi (dcl_control_gettext ab/form1/numCur))) 
  ) 
  (dcl_control_settext 
    ab/form1/numCur 
    (itoa (vlax-ldata-get 
            "xd_circuit_dict" 
            (dcl_control_gettext ab/form1/strPre) 
          ) 
    ) 
  ) 
) 
;;===================================================; 
;;              初始数据                             ; 
;;===================================================; 
(defun _Circuit:CheckDict (/ tf str num) 
  (if (and (not (setq tf (vlax-ldata-list "XD_Circuit_Dict"))) 
           (progn (princ "\n**当前图形未包含初始数据**") t) 
           (setq str (getstring "\n前缀: ")) 
           (setq num (getint "\n编号: ")) 
      ) 
    (progn (vlax-ldata-put "XD_Circuit_Dict" str num) 
           (vlax-ldata-put "XD_Circuit_Dict" "cPrefix" str) 
           (setq tf t) 
    ) 
  ) 
  tf 
) 
;;===================================================; 
;;              绘制连接                             ; 
;;===================================================; 
(defun c:XDTB_DrawCircuit (/ myerr olderr tf str num maxnums cPrefix p pts p d pl pl1 p1 str tf strl 
                           tf1 tf3 tf2 txt blklst blk 
                          ) 
  (defun myerr (msg) 
    (princ "\n*cancel*") 
    (setq *error* olderr) 
    (if (dcl_form_isactive ab/form1) 
      (dcl_form_close ab/form1) 
    ) 
    (xdrx_sysvar_pop) 
    (princ) 
  ) 
  (if (_Circuit:CheckDict) 
    (progn (setq olderr  *error* 
                 *error* myerr 
                 tf1     t 
           ) 
           (_Circuit:Control) 
           (xdrx_sysvar_push '("osmode" 64)) 
           (while (and tf1 (dcl_form_isactive ab/form1)) 
             (setq tf2 t 
                   pts nil 
                   pl nil 
                   blklst nil 
             ) 
             (while (and tf2 
                         (progn (initget 128 "E U") 
                                (setq p (if pts 
                                          (getpoint (car pts) "\r下一点[回退(U)/退出(E)]: ") 
                                          (getpoint "\r起点[退出(E)]: ") 
                                        ) 
                                ) 
                         ) 
                         (dcl_form_isactive ab/form1) 
                    ) 
               (if (listp p) 
                 (progn (setq pts (cons p pts)) 
                        (if (= (length pts) 2) 
                          (progn (setq p (getpoint (apply 'xdrx_line_midp pts) "\n弦高: ") 
                                       d (* 2 (xdrx_point_dist2line p (cadr pts) (car pts))) 
                                 ) 
                                 (setq pl (xdrx_polyline_make (cadr pts) (car pts))) 
                                 (xdrx_polyline_setbulgeat pl 0 (/ d (apply 'distance pts))) 
                          ) 
                        ) 
                        (if (setq ss (xdrx_pickset_getatpoint (car pts) '((0 . "insert")))) 
                          (setq blklst (mapcar '(lambda (x) 
                                                  (car (xdrx_getpropertyvalue x "BlockTableRecord")) 
                                                ) 
                                               (xdrx_pickset->ents ss) 
                                       ) 
                          ) 
                        ) 
                        (if (and pl (> (length pts) 2)) 
                          (progn (setq n (xdrx_polyline_numverts pl)) 
                                 (xdrx_polyline_setpointat pl (1- n) (car pts)) 
                                 (xdrx_polyline_addvertexat pl (1- n) (cadr pts)) 
                                 (xdrx_polyline_setbulgeat 
                                   pl 
                                   (- n 2) 
                                   (/ d (distance (cadr pts) (caddr pts))) 
                                 ) 
                                 (xdrx_polyline_setbulgeat 
                                   pl 
                                   (1- n) 
                                   (/ d (distance (car pts) (cadr pts))) 
                                 ) 
                          ) 
                        ) 
                        (setq tf3 t) 
                 ) 
                 (cond ((= p "E") 
                        (setq tf1 nil 
                              tf2 nil 
                        ) 
                       ) 
                       ((= p "U") 
                        (if pl 
                          (progn (xdrx_polyline_removevertexat 
                                   pl 
                                   (1- (xdrx_polyline_numverts pl)) 
                                 ) 
                                 (setq pts (cdr pts)) 
                          ) 
                        ) 
                        (setq tf3 nil) 
                       ) 
                       (t 
                        (setq tf2 nil 
                              tf3 t 
                        ) 
                       ) 
                 ) 
               ) 
             ) 
             (if (and tf1 
                      tf3 
                      pl 
                      (dcl_form_isactive ab/form1) 
                      (if (setq p (getpoint "\n引出点<回车端点>: ")) 
                        (progn (setq tf nil) p) 
                        (setq tf t 
                              p  (xdrx_curve_getendpoint pl) 
                        ) 
                      ) 
                      (setq p1 (getpoint p "\n标注点: ")) 
                      (dcl_form_isactive ab/form1) 
                      (setq str (strcat (dcl_control_gettext ab/form1/strPre) 
                                        (xd::string:strpad 
                                          (atoi (dcl_control_gettext ab/form1/numCur)) 
                                          2 
                                          "0" 
                                          0 
                                        ) 
                                ) 
                      ) 
                 ) 
               (progn (setq txt (xdrx_text_make 
                                  p1 
                                  (strcase str) 
                                  (distof (dcl_control_gettext ab/form1/height)) 
                                  0.0 
                                ) 
                            pl1 (xdrx_polyline_make p p1) 
                      ) 
                      (xdrx_polyline_setbulgeat pl1 0 0.5) 
                      (if (and blklst (apply '= blklst)) 
                        (setq blk (car blklst)) 
                      ) 
                      (_Circuit:Create txt blk pl pl1) 
               ) 
             ) 
           ) 
           (dcl_form_close ab/form1) 
           (xdrx_sysvar_pop) 
           (setq *error* olderr) 
    ) 
  ) 
  (princ) 
) 
;;===================================================; 
;;            处理旧图                               ; 
;;===================================================; 
(defun c:xdtb_createCircuit (/ myerr olderr allpres circuitdict strl pl txt blk) 
  (defun myerr (msg) 
    (princ "\n*cancel*") 
    (setq *error* olderr) 
    (if (dcl_form_isactive ab/form1) 
      (dcl_form_close ab/form1) 
    ) 
    (xdrx_sysvar_pop) 
    (princ) 
  ) 
  (setq olderr  *error* 
        *error* myerr 
  ) 
  (if (_Circuit:Control) 
    (while (and (setq pl (car (xdrx_entsel 
                                "\n拾取回路Pline<退出>: " 
                                '((0 . "LWPOLYLINE")) 
                              ) 
                         ) 
                ) 
                (setq txt (car (xdrx_entsel "\n拾取回路编号<退出>: " '((0 . "*TEXT"))) 
                          ) 
                ) 
                (progn (setq str    (xdrx_getpropertyvalue txt "textstring") 
                             curPre (xdrx_string_trimright str "0123456789") 
                             num    (substr str (1+ (strlen curpre))) 
                       ) 
                       (distof num) 
                       (princ (strcat "\n前缀 =" str " ; " "编号 = " num)) 
                       (setq num (atoi num)) 
                       (if (= (xdrx_yesorno "\n接受") 1) 
                         t 
                         (and (setq str (getstring "\n前缀: ")) 
                              (setq num (getint "\n编号: ")) 
                         ) 
                       ) 
                ) 
                (setq blk (car (xdrx_entsel 
                                 "\n拾取图块或文字<退出>: " 
                                 '((0 . "INSERT,*TEXT")) 
                               ) 
                          ) 
                ) 
                (dcl_form_isactive ab/form1) 
           ) 
      (if (not (member str *allPres*)) 
        (progn (setq *allPres* (acad_strlsort (cons str *allpres*))) 
               (vlax-ldata-put "XD_Circuit_Dict" str num) 
               (_Odcl:Addlist 
                 ab/form1/allPre 
                 *allpres* 
                 (vl-position 
                   (vlax-ldata-get "XD_Circuit_Dict" "cPrefix") 
                   *allPres* 
                 ) 
               ) 
        ) 
        (progn (dcl_control_settext ab/form1/strPre str) 
               (dcl_control_settext ab/form1/numCur (itoa num)) 
               (dcl_combobox_setcursel 
                 ab/form1/allPre 
                 (vl-position str *allPres*) 
               ) 
        ) 
      ) 
      (_Circuit:Create txt blk pl nil) 
    ) 
  ) 
  (dcl_form_close ab/form1) 
  (xdrx_sysvar_pop) 
  (setq *error* olderr) 
  (princ) 
) 
;;===================================================; 
;;             统计回路                              ; 
;;===================================================; 
(defun c:XDTB_CalCircuit (/ ss nl height) 
  (if (setq ss (ssget '((0 . "text") (-3 ("XDCircuit"))))) 
    (progn (setq height (xdrx_getpropertyvalue (ssname ss 0) "height") 
                 nl     (mapcar '(lambda (x / pl) 
                                   (if (setq pl (handent (vlax-ldata-get x "Circuit"))) 
                                     (list (xdrx_getpropertyvalue x "textstring") 
                                           (vlax-ldata-get x "Power") 
                                           (xdrx_xdata_get x "XDCircuit") 
                                           (vlax-ldata-get x "Type") 
                                           (vlax-ldata-get x "Power") 
                                           (itoa (xdrx_getpropertyvalue pl "numVerts")) 
                                           (* (vlax-ldata-get x "Power") 
                                              (xdrx_getpropertyvalue pl "numVerts") 
                                           ) 
                                           (vlax-ldata-get x "Position") 
                                           " " 
                                           " " 
                                     ) 
                                   ) 
                                 ) 
                                (xdrx_pickset->ents ss) 
                        ) 
                 nl     (cons "统计表" 
                              (cons '("回路" "控制" "编号" "类型" "功率" "数量" "总功率" "位置" 
                                      "备注" " " 
                                     ) 
                                    (vl-sort nl '(lambda (x1 x2) (< (car x1) (car x2)))) 
                              ) 
                        ) 
           ) 
           (if (setq p (getpoint "\n插入点<回车显示>: ")) 
             (xd::table:make 
               (reverse (cons '(" ") (reverse nl))) 
               p 
               (* 3 height) 
               height 
             ) 
             (foreach x nl (princ "\n") (princ x)) 
           ) 
           (xd::excel:createToFile 
             (strcat (getvar "dwgprefix") 
                     (vl-filename-base (getvar "dwgname")) 
                     ".xls" 
             ) 
             (cdr nl) 
           ) ;_写出 excel 文件 
           (xdrx_system_shellexecute 
             (strcat (getvar "dwgprefix") 
                     (vl-filename-base (getvar "dwgname")) 
                     ".xls" 
             ) 
           ) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2014-11-28 14:44:07

更新
将块名记录到文字的 xdata

st788796 · 发表于 2014-11-28 20:43:16

更新，回路连线保存到文字词典

grs432 · 发表于 2014-11-29 00:07:39

st788796 发表于 2014-11-28 20:43
更新，回路连线保存到文字词典

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

grs432 · 发表于 2014-11-29 00:29:22

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

现在几乎是完美了，再加上我说的能自定义预置字典内容，回路字体大小可以设置的话，可以说是没有什么挑剔了，我会准备个完整的图纸在此贴将动画整理发布一下。。在此感谢st788796老师的耐心梳理我对程序的调试意见，并给出了正确的程序执行方式，真的在工作上方便了好多呀！完成今天的成果，我真是无法用语言来表达对st788796老师的感激之情，再次感谢呀！！{:soso_e183:}{:soso_e183:}
后期我个人会自己加强自己对lisp的学习，希望能自己读懂st788796老师所写的内容！！{:soso_e112:}{:soso_e113:}{:soso_e129:}

st788796 · 发表于 2014-12-2 17:04:47

2014.12.02 updata

newer · 发表于 2014-12-2 17:20:08

赞一个，很成功的一次完善过程。程序最终也很牛。

grs432 · 发表于 2014-12-2 17:36:30

newer 发表于 2014-12-2 17:20
赞一个，很成功的一次完善过程。程序最终也很牛。

是的，，ST老师的思路很清析，可以说比我这个做这个专业的人都了解绘制的过程，特别是UI的页面制作，很漂亮。。赞1个。我也在学习，通过与ST老师沟通这个程序的过程，可以让我对lisp入门些。。

st788796 · 发表于 2014-12-2 17:41:32

grs432 发表于 2014-12-2 17:36
是的，，ST老师的思路很清析，可以说比我这个做这个专业的人都了解绘制的过程，特别是UI的页面制作，很漂 ...

抽空做几个动画补到这个帖子吧

st788796 · 发表于 2014-12-2 17:48:43

另外一个配套程序也转过来

;;对回路连线增删顶点
(defun c:XDTB_CircuitNode (/ _removevertexat
_addvertexat _pnt:toline
e tf p
key pr
)
(defun _pnt:toline (p p1 p2)
(last (trans (mapcar '- p p1) 0 (mapcar '- p2 p1)))
)
(defun _removevertexat (e p / n bulge p p1 p2 d)
(setq n (fix (xdrx_curve_getparamatpoint e p)))
(if (or (zerop n) (= n (1- (xdrx_polyline_numverts e))))
(xdrx_polyline_removevertexat e n)
(progn
(setq bulge (xdrx_polyline_getbulgeat e n)
p (xdrx_curve_getpointatparam e (+ n 0.5))
p1 (xdrx_polyline_getpointat e (1- n))
p2 (xdrx_polyline_getpointat e (1+ n))
d (distance
p
(xdrx_line_midp
(xdrx_polyline_getpointat e n)
p2
)
)
)
(xdrx_polyline_removevertexat e n)
(xdrx_polyline_setbulgeat
e
(1- n)
(if (minusp bulge)
(- (/ (* 2.0 d) (distance p1 p2)))
(/ (* 2.0 d) (distance p1 p2))
)
)
)
)
)
(defun _addvertexat (e p / n p1 p2 pm d bulge p0 tf1 tmp tf)
(setq p0 (xdrx_curve_getclosestpoint e p)
n (fix (xdrx_curve_getparamatpoint e p0))
)
(if (setq tf1 (= n (1- (xdrx_polyline_numverts e))))
(setq p1 (xdrx_curve_getpointatparam e (1- n))
p2 (xdrx_curve_getpointatparam e n)
pm (xdrx_curve_getpointatparam e (- n 0.5))
bulge (xdrx_polyline_getbulgeat e (1- n))
)
(setq p1 (xdrx_curve_getpointatparam e n)
p2 (xdrx_curve_getpointatparam e (1+ n))
pm (xdrx_curve_Getpointatparam e (+ n 0.5))
bulge (xdrx_polyline_getbulgeat e n)
)
)
(setq d (distance pm (xdrx_line_midp p1 p2))
tf (_pnt:toline p p1 p2)
)
(cond
((and (zerop n) (minusp tf))
(xdrx_polyline_setpointat e 0 p)
(setq tmp p1
p1 p
p tmp
)
)
((and tf1 (>= (_pnt:toline p p1 p2) (distance p1 p2)))
(xdrx_polyline_setpointat e n p)
(setq tmp p2
p2 p
p tmp
n (1- n)
)
)
(t)
)
(xdrx_polyline_addvertexat e (1+ n) p)
(xdrx_polyline_setbulgeat
e
n
(if (minusp bulge)
(- (/ (* 2.0 d) (distance p p1)))
(/ (* 2.0 d) (distance p p1))
)
)
(xdrx_polyline_setbulgeat
e
(1+ n)
(if (minusp bulge)
(- (/ (* 2.0 d) (distance p p2)))
(/ (* 2.0 d) (distance p p2))
)
)
)
;;main program
(if (setq e (car (xdrx_entsel "\n选择回路线: " '((0 . "lwpolyline")))))
(progn
(setq tf t
key "D"
pr "\r"
)
(while tf
(initget 128 "A D")
(setq p
(getpoint (strcat pr "拾取点[删点(D)/增点(A)]<" key ">: "))
)
(cond
((and (not (null p)) (listp p))
(if (= key "D")
(_removevertexat e p)
(_addvertexat e p)
)
(setq pr "\r")
)
((= p "A") (setq key "A") (setq pr "\n"))
((= p "D") (setq key "D") (setq pr "\n"))
(t (setq tf nil))
)
)
)
)
(princ)
)

;;对回路连线增删顶点 
(defun c:XDTB_CircuitNode (/               _removevertexat 
                           _addvertexat                   _pnt:toline 
                           e               tf           p 
                           key               pr 
                          ) 
  (defun _pnt:toline (p p1 p2) 
    (last (trans (mapcar '- p p1) 0 (mapcar '- p2 p1))) 
  ) 
  (defun _removevertexat (e p / n bulge p p1 p2 d) 
    (setq n (fix (xdrx_curve_getparamatpoint e p))) 
    (if        (or (zerop n) (= n (1- (xdrx_polyline_numverts e)))) 
      (xdrx_polyline_removevertexat e n) 
      (progn 
        (setq bulge (xdrx_polyline_getbulgeat e n) 
              p            (xdrx_curve_getpointatparam e (+ n 0.5)) 
              p1    (xdrx_polyline_getpointat e (1- n)) 
              p2    (xdrx_polyline_getpointat e (1+ n)) 
              d            (distance 
                      p 
                      (xdrx_line_midp 
                        (xdrx_polyline_getpointat e n) 
                        p2 
                      ) 
                    ) 
        ) 
        (xdrx_polyline_removevertexat e n) 
        (xdrx_polyline_setbulgeat 
          e 
          (1- n) 
          (if (minusp bulge) 
            (- (/ (* 2.0 d) (distance p1 p2))) 
            (/ (* 2.0 d) (distance p1 p2)) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (defun _addvertexat (e p / n p1 p2 pm d bulge p0 tf1 tmp tf) 
    (setq p0 (xdrx_curve_getclosestpoint e p) 
          n  (fix (xdrx_curve_getparamatpoint e p0)) 
    ) 
    (if        (setq tf1 (= n (1- (xdrx_polyline_numverts e)))) 
      (setq p1          (xdrx_curve_getpointatparam e (1- n)) 
            p2          (xdrx_curve_getpointatparam e n) 
            pm          (xdrx_curve_getpointatparam e (- n 0.5)) 
            bulge (xdrx_polyline_getbulgeat e (1- n)) 
      ) 
      (setq p1          (xdrx_curve_getpointatparam e n) 
            p2          (xdrx_curve_getpointatparam e (1+ n)) 
            pm          (xdrx_curve_Getpointatparam e (+ n 0.5)) 
            bulge (xdrx_polyline_getbulgeat e n) 
      ) 
    ) 
    (setq d  (distance pm (xdrx_line_midp p1 p2)) 
          tf (_pnt:toline p p1 p2) 
    ) 
    (cond 
      ((and (zerop n) (minusp tf)) 
       (xdrx_polyline_setpointat e 0 p) 
       (setq tmp p1 
             p1         p 
             p         tmp 
       ) 
      ) 
      ((and tf1 (>= (_pnt:toline p p1 p2) (distance p1 p2))) 
       (xdrx_polyline_setpointat e n p) 
       (setq tmp p2 
             p2         p 
             p         tmp 
             n         (1- n) 
       ) 
      ) 
      (t) 
    ) 
    (xdrx_polyline_addvertexat e (1+ n) p) 
    (xdrx_polyline_setbulgeat 
      e 
      n 
      (if (minusp bulge) 
        (- (/ (* 2.0 d) (distance p p1))) 
        (/ (* 2.0 d) (distance p p1)) 
      ) 
    ) 
    (xdrx_polyline_setbulgeat 
      e 
      (1+ n) 
      (if (minusp bulge) 
        (- (/ (* 2.0 d) (distance p p2))) 
        (/ (* 2.0 d) (distance p p2)) 
      ) 
    ) 
  ) 
  ;;main program 
  (if (setq e (car (xdrx_entsel "\n选择回路线: " '((0 . "lwpolyline"))))) 
    (progn 
      (setq tf        t 
            key        "D" 
            pr        "\r" 
      ) 
      (while tf 
        (initget 128 "A D") 
        (setq p 
               (getpoint (strcat pr "拾取点[删点(D)/增点(A)]<" key ">: ")) 
        ) 
        (cond 
          ((and (not (null p)) (listp p)) 
           (if (= key "D") 
             (_removevertexat e p) 
             (_addvertexat e p) 
           ) 
           (setq pr "\r") 
          ) 
          ((= p "A") (setq key "A") (setq pr "\n")) 
          ((= p "D") (setq key "D") (setq pr "\n")) 
          (t (setq tf nil)) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

grs432 · 发表于 2014-12-2 21:43:50

st788796 发表于 2014-11-28 14:44
更新
将块名记录到文字的 xdata

回路连线XDTB_DRAWCIRCUIT

增加减少回路点
XDTB_CIRCUITNODE

统计数据。XDTB_CALCIRCUIT

newer · 发表于 2014-12-2 22:00:24

grs432 发表于 2014-12-2 21:43
回路连线XDTB_DRAWCIRCUIT

相当专业的几个插件了，演示也做的相当专业，以后还有需要，还如此的交互吧，相信你能学到很多东西。这是论坛比群更适合讨论问题的地方。

st788796 · 发表于 2014-12-3 07:56:09

grs432 发表于 2014-12-2 21:43
回路连线XDTB_DRAWCIRCUIT

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

st788796 · 发表于 2014-12-3 09:23:30

有两处细节下次完善，当图中存在编号时，随便取一个的图层和字高作默认值

grs432 · 发表于 2014-12-3 10:01:15

st788796 发表于 2014-12-3 07:56
引出点时直接回车就在端点处引出，单独指定是为了在中间节点处引出（不知道专业是否需要，如果没有这种情 ...

鼠标引出是需要的，可以不在端点引出。这样子也方便，毕竟做图时有的位置不适合放的。。

账号		自动登录	找回密码
密码			立即注册

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

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

点评

点评

点评

点评

点评

点评

点评