[编程交流] 在dwg t中保存命名对象

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