cad通信图块制图设想

lflqqd

某成等制图过程比较繁琐，其实可以根据个人使用习惯，通过 lisp 和 opendcl 结合设计符合自己习惯的插件。
例如，先建立长度标注图块，包含长度、线缆程式、布放方式的图块。然后用图块统计功能。
先贴统计功能：

(defun c:dxcad_Form5_TextButton3_OnClicked (/ filen)
    (if        (setq filen (getfiled "保存文件名" "" "csv" 1))
        (progn (dcl_Control_SetText dxcad_Form5_TextBox2 filen)
               (setq filen nil)
        ) ;_ 结束progn
    ) ;_ 结束if
) ;_ 结束defun
;;统计
(defun c:dxcad_Form5_TextButton4_OnClicked (/             space    doc      slst        ent         bpt          props           data1
                                            rowdata  data     separate tabldata        exclprops          exclblks ss1
                                            maxlen   blk      named    vlaobj        blkprop         j          view           r1
                                           )
    (cond
        ;;cad是否支持表格
        ((and (not
                  (vlax-method-applicable-p
                      (setq space
                               (vlax-get-property
                                   (setq doc
                                            (vla-get-ActiveDocument
                                                (vlax-get-acad-object)
                                            ) ;_ 结束vla-get-ActiveDocument
                                   ) ;_ 结束setq
                                   (if (= 1 (getvar 'CVPORT))
                                       'Paperspace
                                       'Modelspace
                                   ) ;_ 结束if
                               ) ;_ 结束vlax-get-property
                      ) ;_ 结束setq
                      'AddTable
                  ) ;_ 结束vlax-method-applicable-p
              ) ;_ 结束not
              (= 1
                 (dcl_Control_GetCurrentSelection dxcad_Form5_OptionList2)
              ) ;_ 结束=
         ) ;_ 结束and
         (dcl_MessageBox
             "\n** This Version of AutoCAD Does not Support Tables **"
             "错误信息"
         ) ;_ 结束dcl_MessageBox
        )
        ;;csv保存文件名
        ((and (= "" (dcl_Control_GetText dxcad_Form5_TextBox2))
              (= 0
                 (dcl_Control_GetCurrentSelection dxcad_Form5_OptionList2)
              ) ;_ 结束=
         ) ;_ 结束and
         (dcl_MessageBox
             "\n** 请选择CSV保存文件名！ **"
             "错误信息"
         ) ;_ 结束dcl_MessageBox
        )
        ;;选择全图
        ((= 0
            (dcl_Control_GetCurrentSelection dxcad_Form5_OptionList1)
         ) ;_ 结束=
         (setq slst
                  (list        (ssget "X"
                               (list '(0 . "insert")
                               ) ;_ 结束list
                        ) ;_ 结束ssget
                  ) ;_ 结束list
         ) ;_ 结束setq
        )
        ;;选择区域
        ((= 1
            (dcl_Control_GetCurrentSelection dxcad_Form5_OptionList1)
         ) ;_ 结束=
         (if (= nil ss)
             (dcl_MessageBox "请选择要统计的图纸！" "错误信息")
             (progn
                 (setq i -1)
                 (repeat (sslength ss)
                     (setq ent (ssname ss (setq i (1+ i))))
                     (entupd ent)
                     ;;取消亮显对象
                     (setq bpt
                              (LM:boundingbox (vlax-ename->vla-object ent))
                     ) ;_ 结束setq
                     (setq slst
                              (append
                                  (list
                                      (ssadd
                                          ent
                                          (ssget
                                              "X"
                                              (list
                                                  '(0 . "insert")
                                                  '(-4 . "<and")
                                                  '(-4 . ">=,>=,*")
                                                  (list 10 (car (car bpt)) (cadr (car bpt)) 0)
                                                  '(-4 . "<=,<=,*")
                                                  (list 10 (car (caddr bpt)) (cadr (caddr bpt)) 0)
                                                  '(-4 . "and>")
                                              ) ;_ 结束list
                                          ) ;_ 结束ssget
                                      ) ;_ 结束ssadd
                                  ) ;_ 结束list
                                  slst
                              ) ;_ 结束append
                     ) ;_ 结束setq
                 ) ;_ 结束repeat
             ) ;_ 结束progn
         ) ;_ 结束if
        )
    ) ;_ 结束cond
    ;;slst 列表list对象，其中包含各图块对象选择集
    (if
        slst
           (progn
               ;;清空变量，防止意外中断，造成变量叠加
               (setq i 0
                     props nil
                     data1 nil
                     rowdata nil
                     data nil
                     separate nil
                     tabldata nil
               ) ;_ 结束setq
               ;;求和属性字段
               (setq exclprops '("长度" "预留长度" "接续芯数" "成端芯数"))
               ;;不统计块
               (setq
                   exclblks '("工作量块" "材料量块" "工作量表头" "材料量表头")
               ) ;_ 结束setq

               (setq maxlen 0)
               (while (< i (length slst))
                   (setq ss1 (nth i slst))
                   (setq j 0)
                   (while (< j (sslength ss1))
                       (setq blk (ssname ss1 j))
                       (setq named (cdr (assoc 2 (entget blk))))
                       (if (not (member named exclblks))
                           (progn
                               (setq vlaobj (vlax-ename->vla-object blk))
                               (if
                                   (and        (vlax-property-available-p vlaobj 'isdynamicblock)
                                        (eq :vlax-true (vla-get-isdynamicblock vlaobj))
                                   ) ;_ 结束and
                                      (setq props (append (LM:getdynprops vlaobj) props))
                               ) ;_ 结束if
                               (setq props (append (LM:vl-GetAttributes vlaobj) props))

                               (setq len (* 2 (+ 2 (length props))))
                               (if (< maxlen len)
                                   (setq maxlen len)
                               ) ;_ 结束if
                               (setq blkprop (constokey named props exclprops))
                               (setq data
                                        (_assoc++ (car blkprop) (cdr blkprop) data)
                               ) ;_ 结束setq
                           ) ;_ 结束progn
                       ) ;_ 结束if
                       (setq j (+ 1 j))
                       (setq props nil
                             blkprop nil
                       ) ;_ 结束setq
                   ) ;_ 结束while
                   (setq data1
                            (append (list (list "-SelectedSet Separate-") data) data1)
                   ) ;_ 结束setq
                   (setq data nil)
                   (setq i (+ 1 i))
               ) ;_ 结束while
               (setq data1 (reverse data1))
               ;;将data1格式为(key value)<key 为属性点对列表，value 为求和及计数点对列表> 转为 tabldata 即( (rowdata) (rowdata)... ) ,rowdata 格式("a"  "b" ......)
               (setq i 0)
               (repeat (length data1)
                   (setq view (nth i data1))
                   (setq j 0)
                   (repeat (length view)
                       (setq row (nth j view))
                       (if (/= "-SelectedSet Separate-" row)
                           (progn
                               (setq r1 (reverse (append (car row) (cdr row))))
                               (setq j (+ 1 j))
                               (mapcar
                                   '(lambda (cons1)
                                        (setq
                                            rowdata (append (list (car cons1) (cdr cons1))
                                                            rowdata
                                                    ) ;_ 结束append
                                        ) ;_ 结束setq
                                    ) ;_ 结束lambda
                                   r1
                               ) ;_ 结束mapcar
                           ) ;_ 结束progn
                           (progn
                               (repeat maxlen
                                   (setq separate (append (list "-") separate))
                               ) ;_ 结束repeat
                               (setq rowdata (append separate rowdata))
                           ) ;_ 结束progn
                       ) ;_ 结束if
                       (setq tabldata (append (list rowdata) tabldata))
                       (setq rowdata nil)
                   ) ;_ 结束repeat
                   (setq separate nil)
                   (setq i (+ 1 i))
               ) ;_ 结束repeat
               (dcl_Form_Hide dxcad_Form5)
               ;;判断写入CSV或插入表格
               (if (= 0
                      (dcl_Control_GetCurrentSelection dxcad_Form5_OptionList2)
                   ) ;_ 结束=
                   ;;写入CSV
                   (LM:writecsv
                       tabldata
                       (dcl_Control_GetText dxcad_Form5_TextBox2)
                   ) ;_ 结束LM:writecsv
                   ;;插入表格
                   (if (setq pt (getpoint "\nPick Point for Table: "))
                       (LM:AddTable space (trans pt 1 0) "工作量统计" tabldata)
                   ) ;_ 结束if
               ) ;_ 结束if
               (setq vlaobj nil
                     ss        nil
                     ss1 nil
                     ent nil
                     blk nil
                     slst nil
                     data1 nil
                     tabldata nil
                     row nil
                     r1        nil
                     maxlen nil
                     separate nil
               ) ;_ 结束setq
               (dcl_Control_SetText dxcad_Form5_TextBox1 "")
               (dcl_Control_SetText dxcad_Form5_TextBox2 "")
               (dcl_Control_SetText dxcad_Form5_TextBox3 "")
               (dcl_form_close dxcad_Form5)
               (princ)
           ) ;_ 结束progn

    ) ;_ 结束if

) ;_ 结束defun