[编程交流] 用其他线型替换线型

(defun c:clr2by (/ doc blks lays lokt new-ltype old-ltype)
;;convert all objects in a drawing to color=bylayer
;;by Jeff Mishler - updated 7/25/05 to handle dimension colors
;;updated 1/05/06 to affect Attributes and to change a specific linetype to another
;;Modified, Bob Shaw (ECCAD)..Added Lists of Linetypes to swap.
(vl-load-com)
;; List of Linetypes to swap..
(setq Old_lt_lst (list
"$$$bla_bla"
))
(setq New_lt_lst (list
"ZIGZAG"
))
;;
(setq doc (vla-get-activedocument (vlax-get-acad-object))
blks (vla-get-blocks doc)
lays (vla-get-layers doc)
;;;;old-ltype "OLD" ;;;;; change this to match your old ltype
;;;;new-ltype "NEW" ;;;;; change this to match your new ltype
)
(vlax-for lay lays
(if (eq (vla-get-lock lay) :vlax-true)
(progn
(setq lokt (cons lay lokt))
(vla-put-lock lay :vlax-false)
)
)
)
(vlax-for blk blks
(vlax-for ent blk
(mapcar '(lambda (x)
(if (vlax-property-available-p ent x)
(vlax-put ent x 256)
)
)
(list "Color" "DimensionLineColor" "ExtensionLineColor" "TextColor")
)
(if (and (vlax-property-available-p ent 'hasattributes)
(eq (vla-get-hasattributes ent) :vlax-true)
)
(foreach att (vlax-invoke ent 'getattributes)
(vla-put-color att 256)
)
)
;;
 (setq n 0)
 (repeat (length Old_lt_lst)
  (setq Olt (nth n Old_lt_lst))
  (setq Nlt (nth n New_lt_lst))
   (if (and (eq (vla-get-linetype ent) Olt)
            (tblsearch "LTYPE" Nlt))
      (vla-put-linetype ent Nlt)
   )
  (setq n (+ n 1))
 ); repeat
;;
)
)
(if lokt
(mapcar '(lambda (x)
(vla-put-lock x :vlax-true)
)
lokt
)
)
(princ)
)
(c:clr2by); and run it.

(defun c:fixlt ( / n )
   (vlax-for b (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
       (if (and
               (= :vlax-false (vla-get-islayout b))
               (= :vlax-false (vla-get-isxref b))
           )
           (vlax-for o b
               (if (and
                       (wcmatch (setq n (vla-get-linetype o)) "*$*")
                       (setq n (substr n (+ 2 (vl-string-position 36 n 0 t))))
                       (tblsearch "LTYPE" n)
                   )
                   (vl-catch-all-apply 'vla-put-linetype (list o n))
               )
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)