[原创]：改变层名--对所有层名加前缀的小程序( 除0,Defpoints)

lsjjm

改变层名--对所有层名加前缀的小程序( 除0,Defpoints)

(defun C:test ()
  (vl-load-com)
  (setq pre (getstring "\nEnter Layer Prefix : "))
  (setq doc (vla-get-activedocument
            (vlax-get-acad-object))
     layers (vla-get-layers doc))
  (vlax-for lay layers
    (setq lname (vla-get-name lay))
    (if (not (member lname '("0" "Defpoints")))
      (vla-put-Name lay (strcat pre lname))
    )
  )
)

ydf7332462

要是对图选指定层加前缀且另建立一层，就是我要的了

lsjjm

最初由 ydf7332462 发布
[B]要是对图选指定层加前缀且另建立一层，就是我要的了 [/B]

Try this code:
(defun C:test ()
  (vl-load-com)
  (setq ent (entsel "\nSelect object on the layer: "))
  (setq lay (vla-get-layer (vlax-ename->vla-object (car ent))))
  (setq pre (getstring "\nEnter Layer Prefix : "))
  (mlayer (strcat pre lay))
)
(defun mLayer (layerName)
  (setq layerName (vl-catch-all-apply 'vla-add
                    (list (vla-get-layers
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
                          layername
                    )
                  )
  )
  (if (vl-catch-all-error-p LayerName) nil LayerName)
)

li809

修改之后,最适合我用了,顶