社区 › Auto Lisp › 在dwg t中保存命名对象

Ahankhah 发表于 2022-7-6 08:12:23

在dwg t中保存命名对象

大家好，
 
是否可以：
1-获取表格组的属性（例如图层、textstyle、dimstyle等）
2-保存图纸内的信息（通过Dictadd等）
3-清除已处理的表组。
 
因此，有可能在需要时恢复信息。
 
 
如果可能的话，我们非常感谢您的任何建议。

VVA 发表于 2022-7-6 08:45:48

试试看

(vl-load-com)
(defun savetable (table / d)
   ;;; table - "LAYER" "DIMSTYLE" "STYLE" "LTYPE",
(while (setq d (tblnext table (null d)))
   (vlax-ldata-put
   (strcat "$SAVED$_" table)
   (cdr (assoc 2 d))
   (vl-remove-if
       (function
         (lambda(x)
         (member (car x) '(-1 5 330 390 347))
         )
         )
       (entget(tblobjname table (cdr (assoc 2 d))))
       )
   )
   );_while
)
(defun restoretable (table item / d)
;;; table - "LAYER" "DIMSTYLE" "STYLE" "LTYPE",
;;; item - item name to restored or nil - all
(mapcar
   (function
   (lambda (x)
       (entmakex (cdr x))
       )
   )
   ((lambda(l)
      (if (assoc item l)(list (assoc item l)) l)
      )
   (vlax-ldata-list (strcat "$SAVED$_" table))
   )
   )
)

(defun C:LS ()
;;;Layer save
;;;Line Type save
(savetable "LTYPE")
(savetable "LAYER")(princ)
)
(defun C:LR ()
;;;Layer restore
(restoretable "LTYPE" nil)
(restoretable "LAYER" nil)(princ)
)
(defun C:LR1 (/ item)
;;;One Layer restore
(if (and
       (setq item (mapcar 'car (vlax-ldata-list (strcat "$SAVED$_" "LAYER"))))
       (setq item (mydcl "Select layer" item))
       )
   (progn
   (restoretable "LTYPE" nil)
   (restoretable "LAYER" item)
   )
   )
(princ)
)
(defun mydcl (zagl info-list / fl ret dcl_id)
   (vl-load-com)
   (if (null zagl)
       (setq zagl "Select")
   ) ;_ end of if
   (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
   (setq ret (open fl "w"))
   (mapcar
       '(lambda (x) (write-line x ret))
       (list "mip_msg : dialog { "
             (strcat "label=\"" zagl "\";")
             " :list_box {"
             "alignment=top ;"
             "width=51 ;"
             "allow_accept = true;"
             "tabs = \"16 32\";"
             "tab_truncate = true;"
             (if (> (length info-list) 26)
               "height= 26 ;"
               (strcat "height= " (itoa (+ 3 (length info-list))) ";")
             ) ;_ end of if
             "is_tab_stop = false ;"
             "key = \"info\";}"
             "ok_cancel;}"
       ) ;_ end of list
   ) ;_ end of mapcar
   (setq ret (close ret))
   (if (and (not (minusp (setq dcl_id (load_dialog fl))))
            (new_dialog "mip_msg" dcl_id)
         ) ;_ end of and
       (progn
         (start_list "info")
         (mapcar 'add_list info-list)
         (end_list)
         (set_tile "info" "0")
         (setq ret (car info-list))
         (action_tile
         "info"
         "(setq ret (nth (atoi $value) info-list))"
         ) ;_ end of action_tile
         (action_tile
         "cancel"
         "(progn(setq ret nil)(done_dialog 0))"
         ) ;_ end of action_tile
         (action_tile "accept" "(done_dialog 1)")
         (start_dialog)
       ) ;_ end of progn
   ) ;_ end of if
   (unload_dialog dcl_id)
   (vl-file-delete fl)
   ret
   )

Ahankhah 发表于 2022-7-6 09:13:44

弗拉基米尔，非常感谢你的代码。这太棒了。
 
Дзякуй Уладзімір

查看完整版本: 在dwg t中保存命名对象