[编程交流] 交换图层名和的值

([color=BLUE]defun[/color] c:test [color=BLUE]nil[/color] ([color=BLUE]vl-load-com[/color])
 ([color=BLUE]vlax-for[/color] layer ([color=BLUE]vla-get-layers[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
   ([color=BLUE]vl-catch-all-apply[/color]
     ([color=BLUE]function[/color]
       ([color=BLUE]lambda[/color] ( [color=BLUE]/[/color] ln ld )
         ([color=BLUE]setq[/color] ln ([color=BLUE]vla-get-name[/color] layer)
               ld ([color=BLUE]vla-get-description[/color] layer)
         )
         ([color=BLUE]vla-put-description[/color] layer ln)
         ([color=BLUE]vla-put-name[/color] layer ld)
       )
     )
   )
 )
 ([color=BLUE]princ[/color])
)

(defun c:LAYSWAP (/ layerName activeDoc layerItem oldDescription)
 (princ "\rLAYER SWAP ")
 (vl-load-com)
 (if (and (setq layerName (getstring T "\nEnter layer name to swap: "))
          (setq layerName (cdr (assoc 2 (tblsearch "layer" layerName)))))
   (progn
     (vla-startundomark
       (setq activeDoc (vla-get-activedocument (vlax-get-acad-object))))
     (setq layerItem (vla-item (vla-get-layers activeDoc) layerName))
     (setq oldDescription (vla-get-description layerItem))
     (vla-put-description layerItem layerName)
     (vla-put-name layerItem oldDescription)        
     (vla-endundomark activeDoc))
   (prompt "\n** Layer does not exist ** "))
 (princ))

(defun c:LAYSWAP (/ *error* _layswap activeDoc layerName)
 (princ "\rLAYER SWAP ")
 (vl-load-com)
 (defun *error*  (msg)
   (vla-endundomark activeDoc)
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** "))))                 ; Fatal error, display it
   (princ))
 (defun _layswap  (layerName / oLayers layerDesc)
   (if
     (and
       (setq
         layerItem (vla-item
                     (setq oLayers (vla-get-layers activeDoc))
                     layerName))
       (setq layerDesc (vla-get-description layerItem))
       (setq layerName (vla-get-name layerItem)))
      (progn
        (vla-put-name layerItem layerDesc)
        (vla-put-description layerItem layerName))))
 
 (vla-startundomark
       (setq activeDoc (vla-get-activedocument (vlax-get-acad-object))))
 (vlax-for x (vla-get-layers activeDoc)
   (if (not (vl-position (strcase (setq layerName (vla-get-name x))) '("0" "DEFPOINTS")))
     (_layswap layerName)))
 (vla-endundomark activeDoc)
 (princ))