[code="lisp]

(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)

;函数功能：生成低压系统图

(defun lea-dyxtt (lst flag /  insert lea-Rectange insertionPnt i item minp maxp PLOT_BL PLOT_TR pdx pdy emkText)

(defun insert(insertionPnt  blockname  )

(vl-load-com)

(setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))

(setq whatspace (vla-get-ActiveSpace AcadDocument))

(setq mSpace (vla-get-ModelSpace acadDocument))

(setq pSpace (vla-get-PaperSpace acadDocument))

(setq DwgProps (vla-Get-SummaryInfo acadDocument))

(if (null (findfile blockname)) (progn (alert "文件没有相应出线数量的馈线柜，请添加") (exit)) blockname)

(if (= whatspace 1)

(vla-InsertBlock mSpace insertionPnt blockname 1 1 1 0)

(vla-InsertBlock pSpace insertionPnt blockname 1 1 1 0)

)

)

(defun lea-Rectange (pt1 pt2)

(entmake

(list

'(0 . "LWPOLYLINE")                          ;轻多段线

'(100 . "AcDbEntity")

'(100 . "AcDbPolyline")

'(90 . 4)                                  ;四个顶点

'(70 . 1)                                  ;闭合

(cons 38 (caddr pt1))                          ;高程

(cons 10 (list (car pt1) (cadr pt1)))          ;左下角

(cons 10 (list (car pt2) (cadr pt1)))          ;右下角

(cons 10 (list (car pt2) (cadr pt2)))          ;右上角

(cons 10 (list (car pt1) (cadr pt2)))          ;左上角

(cons 210 '(0 0 1))                          ;法线方向

)

)

)

(setq        insertionPnt(vlax-3d-point(getpoint "\n请输入图框插入位置点: "))

i    0

;lst  '("BYQ-Z.DWG" "GCS-ZJX.DWG" "GCS-7.DWG")

)

(repeat (length lst)

(insert insertionPnt (nth i lst))

(setq item (vlax-ename->vla-object (entlast)))

(vla-getboundingbox

item

'minp

'maxp

)

(setq PLOT_BL (vlax-safearray->list minp)

PLOT_TR (vlax-safearray->list maxp)

)

(setq PDX (ABS (- (caR PLOT_BL) (caR PLOT_TR)))

PDY  (ABS (- (caDR PLOT_BL) (caDR PLOT_TR)))

)

(setq PLOT_BL (list (- (car PLOT_TR) pdx) (- (cadr PLOT_TR) 90) (last PLOT_BL)))

(lea-Rectange PLOT_BL PLOT_TR)

(defun emkText (pt str h)

(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)))

)

;绘制眉头

(setq p1 (lea-point-pt PLOT_TR '(0 4 0))

p0 (lea-point-pt PLOT_BL '(0 90 0))

)

(lea-Rectange p0 p1)

(if (= flag "抽屉式") (setq flag1 "GCS") (setq flag1 "GGD"))

(if (or (= i 0) (= i (1-(length lst)))) (emkText (lea-point-mid p0 p1) "低压柜型号" 2) (emkText (lea-point-mid p0 p1) flag1 2))

(setq p2 (lea-point-pt p0 '(0 4 0))

p3 (lea-point-pt p1 '(0 4 0))

)

(lea-Rectange p2 p3)

(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))

;眉头结束

(setq insertionPnt (vlax-3d-point PLOT_TR)

i  (1+ i)

)

)

)

;删除列表里其中某个位置的元素

(defun lea-lst2lst (n lst / lst1 n1 i)

(setq n1 (length lst)

i 0

lst1 '()

)

(repeat n1

(if (/= i n )(setq lst1 (cons (nth i lst) lst1)) (setq i n))

(setq i (1+ i))

)

(reverse lst1)

)

(vl-load-com)

(lea-start)

(defun show_lst( key lst)

(start_list key)

(mapcar 'add_list lst)

(end_list)

)

(setq dclname

(cond

((setq tempname (vl-filename-mktemp "temp.dcl")

filen (open tempname "w")

)

(foreach stream '(

"RENAME:dialog {"

"    :boxed_column {label = "lea低压系统图" ;"

"                :row {:radio_button { key = "krb1" ; label = "抽屉式" ; width = 20 ; }"

"                                                                             :radio_button { key = "krb2" ; label = "固定式" ;width = 20 ; }}"

"        :row {"

"                 :list_box { key = "klst1" ; label = "插入顺序从下往上" ; width = 20 ; }"

"        :column {"

"                :row {:button { key = "kb1" ; label = "变压器左" ; width = 20 ; }"

"                                                                            :button { key = "kb2" ; label = "变压器右" ; width = 20 ; }}"

"                :row {:button { key = "kb3" ; label = "进线柜左" ; width = 20 ; }"

"                                                                            :button { key = "kb4" ; label = "进线柜右" ; width = 20 ; }}"

"                :row {:button { key = "kb5" ; label = "电容柜" ; width = 20 ; }"

"                                                                            :button { key = "kb6" ; label = "联络柜" ; width = 20 ; }}"

"                :row {:button { key = "kb7" ; label = "馈线柜" ; width = 20 ; }"

"                                                                            :edit_box { key = "k1" ;  width = 20 ; }}"

"                :button { key = "kb8" ; label = "删除" ; width = 20 ; }"

"                }"

"             }"

"             }"

" spacer_1;"

" ok_cancel;"

"             }"

)

(write-line stream filen)

)

(close filen)

tempname

)

)

)

(setq Dcl_Id (load_dialog dclname))

(new_dialog "RENAME" Dcl_Id)

(setq lst '()

lst1 '("GCS变压器左进.DWG" "GCS变压器右进.DWG" "GCS进线柜左进.DWG" "GCS进线柜右进.DWG" "GCS电容柜.DWG" "GCS联络柜.DWG" "GCS出线柜-");GCS柜

lst2 '("GGD变压器左进.DWG" "GGD变压器右进.DWG" "GGD进线柜左进.DWG" "GGD进线柜右进.DWG" "GGD电容柜.DWG" "GGD联络柜.DWG" "GGD出线柜-");GGD柜

)

(set_tile "k1" (setq na1 "1"))

(set_tile "krb1" "1")

(setq k1(get_attr "krb1" "label"));预设起始值

(action_tile "krb1" "(setq k1(get_attr $key "label"))")

(action_tile "krb2" "(setq k1(get_attr $key "label"))")

;(cond

;        ((= k1 "抽屉式") (setq lst3 lst1))

;        ((= k1 "固定式") (setq lst3 lst2))

;)

(action_tile "kb1" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 0 lst3) lst))(show_lst "klst1" lst)")

(action_tile "kb2" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 1 lst3) lst))(show_lst "klst1" lst)")

(action_tile "kb3" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 2 lst3) lst))(show_lst "klst1" lst)")

(action_tile "kb4" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 3 lst3) lst))(show_lst "klst1" lst)")

(action_tile "kb5" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 4 lst3) lst))(show_lst "klst1" lst)")

(action_tile "kb6" "(if (= k1 "抽屉式") (setq lst3 lst1) (setq lst3 lst2))(setq lst (cons (nth 5 lst3) lst))(show_lst "klst1" lst)")

(action_tile "k1" "(setq na1 $value)")

(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)")

(action_tile "klst1" "(setq n (atoi $value) )")

(action_tile "kb8" "(setq lst (lea-lst2lst n lst))(show_lst "klst1" lst)")

(action_tile "accept" "(done_dialog)")

(start_dialog)

(lea-dyxtt (reverse lst) k1)

(unload_dialog Dcl_Id)

(vl-file-delete  tempname)

(lea-end)

)[/code]