[编程交流] 更改块

(defun C:CBC  (/ blockobj bname en ent obj);change block 
 (setq ent (entsel "\nSelect block: "))
 (setq en (car ent)
obj (vlax-ename->vla-object en)
bname (vla-get-effectivename obj)
blockobj
     (vla-item (vla-get-blocks
                 (vla-get-activedocument
                   (vlax-get-acad-object)))
               bname)
    )
 
 (vla-put-layer obj "0")
 
 (vlax-for item blockobj
     (if (eq "1" (vla-get-layer item))
     (if (and (eq "AcDbLine" (vla-get-objectname item))
       (eq "DASHDOT" (strcat (vla-get-linetype item)))
       (eq 2 (vla-get-color item))
       )
(progn
(vla-put-layer item "0")  
(vla-put-color item 1))
(progn
  (vla-put-layer item "0")
  (vla-put-color item acByBlock)
  (vla-put-linetype item "BYBLOCK")
)
)
)
)
 (vla-regen (vla-get-activedocument
       (vlax-get-acad-object))
     acallviewports)
 
 (princ)
 )
(princ "\n   ***  Type CBC to execute  ***")
(prin1)
(vl-load-com)

(defun C:CB2  (/ blockobj bname en ent obj)          ;change block 
 (setq ent (entsel "\nSelect block: "))
 (setq        en         (car ent)
obj         (vlax-ename->vla-object en)
bname         (vla-get-effectivename obj)
blockobj
         (vla-item (vla-get-blocks
                     (vla-get-activedocument
                       (vlax-get-acad-object)))
                   bname)
)
 (vla-put-layer obj "0")
 (vlax-for item  blockobj
   (if        (and (eq "DASHDOT" (strcase (vla-get-linetype item)))
     (eq 2 (vla-get-color item))
     )
     (vla-put-color item 1)
     )
   (if        (and (eq "ByLayer" (vla-get-linetype item))
     (eq acLnWtByLayer (vla-get-lineweight item))
     (eq 2 (vla-get-color item))
     )
     (vla-put-color item 
     )
   (if        (eq acByLayer (vla-get-color item))
     (vla-put-color item acByBlock)
     )
   (vla-put-layer item "0")
   )
 (vla-regen (vla-get-activedocument
       (vlax-get-acad-object))
     acallviewports)
 (princ)
 )
(princ "\n   ***  Type CB2 to execute  ***")
(prin1)
(vl-load-com)