使用lisp gettin重命名层
你好我在论坛上发现了这个非常好的惯例，但不知道我要感谢谁（gilsoto13？）。
我已经在家里的CAD 2011上测试了这些LISP。工作正常。
但在CAD 2007 Electrical上，我发现了这个错误：
我在网上查了一下，发现它与选择集（lisp选择集谓词）有关？
就像例程期望选择一样，或者我的选择集为零？我应该在某个地方，从谓词的东西中提取a-p吗？
代码如下：
;;function to rename a layer.
;;if old layer exists, and new layer doesn't exist, the old layer is simply renamed.
;;if old layer exists, and new layer is already there, it takes everything on old layer and puts them on new layer.
;;if old layer doesn't exist, it does nothing.
(defun renlay (ol nl / ss i ent )
(cond ((and (tblsearch "layer" ol) (not (tblsearch "layer" nl)))
(command "._rename" "la" ol nl)
)
((and (tblsearch "layer" ol)(tblsearch "layer" nl))
(setq ss (ssget "x" (list (cons 8 ol))))
(setq i -1)
(repeat (sslength ss)
(setq ent (entget (ssname ss (setq i (1+ i))))
ent (subst (cons 8 nl) (cons 8 (cdr (assoc 8 ent))) ent)
)
(entmod ent)
)
)
((not (tblsearch "layer" ol))
(prompt (strcat "\nLayer " ol " not found. "))
)
)
(princ)
)
;;example
(defun c:test ()
(renlay "ENG" "GE_TXT_LANGUAGE_EN")
(renlay "NL" "GE_TXT_LANGUAGE_DU")
(renlay "DUITS" "GE_TXT_LANGUAGE_GE")
(renlay "FR" "GE_TXT_LANGUAGE_FR")
)
Thx提前。 也许可以试试这样：
(defun RenameLayer ( old new )
;; © Lee Mac 2010
(if (tblsearch "LAYER" old)
(if (tblsearch "LAYER" new)
(if (setq ss (ssget "_X" (list (cons 8 old))))
(
(lambda ( i )
(while (setq e (ssname ss (setq i (1+ i))))
(entupd
(cdr
(assoc -1
(entmod
(list (assoc -1 (entget e)) (cons 8 new))
)
)
)
)
)
)
-1
)
)
(
(lambda ( old )
(entmod
(subst
(cons 2 new) (assoc 2 old) old
)
)
)
(entget (tblobjname "LAYER" old))
)
)
(princ (strcat "\n--> Layer: " old " not found."))
)
(princ)
)
(defun c:test ( / o n )
(if
(and
(setq o (getstring t "\nSpecify Layer to be Renamed: "))
(setq n (getstring t "\nSpecify New Layer Name: "))
)
(RenameLayer o n)
)
(princ)
) Thx Lee，
它工作得很好，但我认为它帮助不大。
看，我想处理1300个文件。
它们都需要创建层并重命名一些层。
如果你不介意，我将使用你的一些代码来创建层：
(defun MakeLayer ( name colour linetype lineweight willplot bitflag description )
;; © Lee Mac 2010
(or (tblsearch "LAYER" name)
(entmake
(append
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2name)
(cons 70 bitflag)
(cons 290 (if willplot 1 0))
(cons 6
(if (and linetype (tblsearch "LTYPE" linetype))
linetype "CONTINUOUS"
)
)
(cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7))
(cons 370
(fix
(* 100
(if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0)
)
)
)
)
(if description
(list
(list -3
(list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description))
)
)
)
)
)
)
)
(defun c:MakeLayers nil (vl-load-com)
;; © Lee Mac 2010
;; Specifications:
;; Description Data Type Remarks
;; -----------------------------------------------------------------
;; Layer Name STRING Only standard chars allowed
;; Layer Colour INTEGER may be nil, -ve for Layer Off, Colour < 256
;; Layer Linetype STRING may be nil, If not loaded, CONTINUOUS.
;; Layer Lineweight REAL may be nil, 0 <= x <= 2.11
;; Plot? BOOLEAN T = Plot Layer, nil otherwise
;; Bit Flag INTEGER 0=None, 1=Frozen, 2=Frozen in VP, 4=Locked
;; Description STRING may be nil for no description
;; Function will return list detailing whether layer creation is successful.
(
(lambda ( lst / lts ) (setq lts (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object))))
(mapcar 'cons (mapcar 'car lst)
(mapcar
(function
(lambda ( x )
(and (caddr x)
(or (tblsearch "LTYPE" (caddr x))
(vl-catch-all-apply 'vla-load (list lts (caddr x) "acad.lin"))
)
)
(apply 'MakeLayer x)
)
)
lst
)
)
)
'(
; Name Colour Linetype Lineweight Plot? BitFlag Description
( "CEN" 6 "CENTER" 0.18 T 0 nil )
( "DIMS" -1 nil 0.18 T 0 nil )
( "HAT" 3 nil 0.18 T 0 nil )
( "HID" 4 "HIDDEN" 0.15 T 0 "Hidden" )
( "LOGO" 176 nil 0.09 T 0 "For Logo")
( "OBJ" -2 nil 0.40 T 0 nil )
( "PAPER" 5 "PHANTOM" nil T 0 nil )
( "PHAN" 6 "PHANTOM" 0.18 T 0 nil )
( "TITLE" 176 nil nil T 0 "For Title" )
( "TXT" 7 nil nil T 0 nil )
)
)
)
这将完成层转换器所做的工作，但只需1秒
您确实需要始终使用相同的旧层，但大多数情况下都是这样。
(dolayers);creates new layers if not already there.
(setlayernew);will merge all old layers that are set with the new ones.
;;function to rename a layer.
;;if old layer exists, and new layer doesn't exist, the old layer is simply renamed.
;;if old layer exists, and new layer is already there, it takes everything on old layer and puts them on new layer.
;;if old layer doesn't exist, it does nothing.
(defun renlay (ol nl / ss i ent )
(cond ((and (tblsearch "layer" ol) (not (tblsearch "layer" nl)))
(command "._rename" "la" ol nl)
)
((and (tblsearch "layer" ol)(tblsearch "layer" nl))
(command "-LAYMRG" "N" ol "" "N" nl "Y")
)
((not (tblsearch "layer" ol))
(prompt (strcat "\nLayer " ol " not found. "))
)
)
(princ)
)
;;example
(defun c:setlayernew ()
(command "-layer" "s" "0" "")
(renlay "1" "01 Dimensions")
(renlay "2" "02 Project dimensions notes")
(renlay "8" "05 Center")
(renlay "9" "08 Surrounding")
(renlay "11" "05 Center")
(renlay "13" "13 Border")
(renlay "BORDER" "13 Border")
(renlay "BORDER-V" "13 Border")
(renlay "HORIZONTAL REF BOX" "0")
(renlay "LOGO" "01 Dimensions")
(renlay "3D" "0")
(renlay "3d" "0")
(renlay "Dimension (ISO)" "01 Dimensions")
(renlay "Visible (ISO)" "0")
(renlay "Visible Narrow (ISO)" "0")
(renlay "Border (ISO)" "13 Border")
(renlay "Title (ISO)" "13 Border")
(princ)(princ "Layers renamed and merged")
)
是的，您可以检查有效的SelectionSet，我的代码就是这样做的。你是说你仍然收到错误？ 您可能需要使用以下内容：
(defun MkLay (Nme Col lTyp lWgt Plt / lays lay)
(vl-load-com)
(setq lays (vla-get-layers
(vla-get-ActiveDocument
(vlax-get-acad-object)))
lay (cond ((tblsearch "LAYER" Nme)
(vla-item lays Nme))
(t (vla-add lays Nme))))
(and Col (vla-put-Color lay Col))
(and lTyp (lTload lTyp) (vla-put-Linetype lay lTyp))
(and lWgt(vla-put-LineWeight lay (eval (read (strcat "acLnWt" lWgt)))))
(and (not Plt) (vla-put-Plottable lay :vlax-false)))
(defun lTload (lTyp)
(or (tblsearch "LTYPE" lTyp)
(vla-load
(vla-get-Linetypes
(vla-get-ActiveDocument
(vlax-get-acad-object))) lTyp "acad.lin")))
(defun c:DoLayers ( / )
(vl-load-com)
(mapcar 'MkLay
'( "01 Dimensions" "02 Project dimensions notes" ); Name
'( 1 nil ) ; Colours
'( nil nil ) ; LineType
'( nil nil ); LineWeight 0.18 = "018"
'( T T )) ; Plottable (T or nil)
(princ)(princ "New layers set")
(princ))
根据需要更改关联列表（“OLDLAYER”、“NEWLAYER”）
这更像是一种暴力手段，但：
[列表]
[*]它可以处理较重的多段线
[*]处理锁定层
[*]包括所有块定义
[/列表]
-大卫 呜呜！
Thx CADkitt，效果很好！
@李
不。你的代码也运行得很好
祝你们俩多谢。
某人 thx David公司 还有，如何更改标注样式名称 使用-重命名
然后将其放入（命令“-rename”“dimstyle”“oldname”“newname”） 但是我怎么能把那个样式和标准图层放在所有的dwg中呢？我打开了它。
页:
[1]
2