[编程交流] 从复制属性定义

[color=GREEN];; Copy Attribute Definitions  -  Lee Mac[/color]
([color=BLUE]defun[/color] c:copyattdef ( [color=BLUE]/[/color] blk bln cmd doc idx lst sel src tmp )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]princ[/color] [color=MAROON]"\nSelect source block..."[/color])
           ([color=BLUE]setq[/color] src ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S"[/color] '((0 . [color=MAROON]"INSERT"[/color]) (66 . 1))))
           ([color=BLUE]princ[/color] [color=MAROON]"\nSelect blocks to copy attributes to..."[/color])
           ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"INSERT"[/color]))))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] doc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
                 blk ([color=BLUE]vla-get-blocks[/color] doc)
           )
           ([color=BLUE]vlax-for[/color] obj ([color=BLUE]vla-item[/color] blk (LM:blockname ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] src 0))))
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"AcDbAttributeDefinition"[/color] ([color=BLUE]vla-get-objectname[/color] obj))
                   ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] obj lst))
               )
           )
           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] lst ([color=BLUE]reverse[/color] lst))
               ([color=BLUE]progn[/color]
                   ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] idx ([color=BLUE]sslength[/color] sel))
                       ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]member[/color] ([color=BLUE]setq[/color] bln (LM:blockname ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] idx ([color=BLUE]1-[/color] idx)))))) tmp))
                           ([color=BLUE]progn[/color]
                               ([color=BLUE]setq[/color] tmp ([color=BLUE]cons[/color] bln tmp))
                               ([color=BLUE]vlax-invoke[/color] doc 'copyobjects lst ([color=BLUE]vla-item[/color] blk bln))
                           )
                       )
                   )
                   ([color=BLUE]setq[/color] cmd ([color=BLUE]getvar[/color] 'cmdecho))
                   ([color=BLUE]setvar[/color] 'cmdecho 0)
                   ([color=BLUE]foreach[/color] itm tmp ([color=BLUE]vl-cmdf[/color] [color=MAROON]"_.attsync"[/color] [color=MAROON]"_n"[/color] itm))
                   ([color=BLUE]setvar[/color] 'cmdecho cmd)
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)
[color=GREEN];; Block Name  -  Lee Mac[/color]
[color=GREEN];; Returns the true (effective) name of a supplied block reference[/color]
                       
([color=BLUE]defun[/color] LM:blockname ( obj )
   ([color=BLUE]if[/color] ([color=BLUE]vlax-property-available-p[/color] obj 'effectivename)
       ([color=BLUE]defun[/color] LM:blockname ( obj ) ([color=BLUE]vla-get-effectivename[/color] obj))
       ([color=BLUE]defun[/color] LM:blockname ( obj ) ([color=BLUE]vla-get-name[/color] obj))
   )
   (LM:blockname obj)
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])