[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]