[请帮帮我]我想
我有剧本Sub ChangeLayer(ByVal FullDwgName)
On Error Resume Next
Dim AcadApp
Dim Thisdrawing
Set AcadApp = GetObject(,"Autocad.Application")
If Err Then
Err.Clear
Set AcadApp =CreateObject("Autocad.Application")
End If
Dim LayerObj
Dim strOldLayerName(4) 'old name of Layer
strOldLayerName(0) ="STV-DIM"
strOldLayerName(1) ="STV-CENTER"
strOldLayerName(2) ="STV-HIDDEN"
strOldLayerName(3) ="STV-REF"
strOldLayerName(4) ="STV-PRIMARY"
Dim strNewLayerName(4) 'New Name of Layer
strNewLayerName(0) ="PT-DIM" 'Name for new Layer 1
strNewLayerName(1) ="PT-CENTER" 'Name for new Layer 2
strNewLayerName(2) ="PT-HIDDEN" 'Name for new Layer 3
strNewLayerName(3) ="PT-REF" 'Name for new Layer 4
strNewLayerName(4) ="PT-PRIMARY" 'Name for new Layer 5
Dim intNewLayerColor(4)
intNewLayerColor(0)=1 'Color for Layer 1
intNewLayerColor(1)=2 'Color for Layer 2
intNewLayerColor(2)=3 'Color for Layer 3
intNewLayerColor(3)=4 'Color for Layer 4
intNewLayerColor(4)=5 'Color for Layer 5
Dim strNewLayerLineType(4)
strNewLayerLineType(0)="CENTER"
strNewLayerLineType(1)="Continuous"
strNewLayerLineType(2)="HIDDEN"
strNewLayerLineType(3)="PHANTOM"
strNewLayerLineType(4)="Continuous"
Set Thisdrawing = AcadApp.Documents.Open(FullDwgName)
Dim intA
For Each LayerObj In Thisdrawing.Layers
For intA=0 To 4
If LayerObj.Name = strOldLayerName(intA) Then
LayerObj.Name = strNewLayerName(intA)
LayerObj.color = intNewLayerColor(intA)
Thisdrawing.Linetypes.Load strNewLayerLineType(intA),"acad.lin"
LayerObj.Linetype=strNewLayerLineType(intA)
AcadApp.Update
End If
Next
Next
'Close drawing
Thisdrawing.Close True
End Sub
旧层：A1、A2、A3、A4、A5、A6、A7、A8、A9
新层：B1、B2、B3、B4
所以我想把A1，A3，A5变成B1
A2、A4、A6、A7=>B2
A8=>B3
A9=>B4
我该怎么办？
提前谢谢你 首先，你有vba代码而不是脚本，想想lisp，script，vba&。网
上面的代码更改了图层属性而不是对象，如果要获取4层对象并生成一个图层，则不能将4个图层重命名为一个图层。
手动使用layiso选择4个图层选择所有对象、chprop或使用特性。
脚本示例
(setq ss (ssget "x" '((8 . "A2,A4,A6,A7")))) (command "-chprop" ss "" "la" "B2" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A8")))) (command "-chprop" ss "" "la" "B3" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A9")))) (command "-chprop" ss "" "la" "B4" "")(setq ss nil)
这是我的文件更改层。rar公司
如果我想取4层对象并制作一层，我该怎么办？因为我想更改许多CAD文件。
帮我更改此文件。
提前谢谢你 只要让我发布的脚本做所有的工作，是的，一个lisp会做得更好，但一个真正的快速回答。
Open dwg1
(setq ss (ssget "x" '((8 . "A2,A4,A6,A7")))) (command "-chprop" ss "" "la" "B2" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A8")))) (command "-chprop" ss "" "la" "B3" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A9")))) (command "-chprop" ss "" "la" "B4" "")(setq ss nil)
close Y
Open dwg2
(setq ss (ssget "x" '((8 . "A2,A4,A6,A7")))) (command "-chprop" ss "" "la" "B2" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A8")))) (command "-chprop" ss "" "la" "B3" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A9")))) (command "-chprop" ss "" "la" "B4" "")(setq ss nil)
close Y
Open dwg3
(setq ss (ssget "x" '((8 . "A2,A4,A6,A7")))) (command "-chprop" ss "" "la" "B2" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A8")))) (command "-chprop" ss "" "la" "B3" "")(setq ss nil)
(setq ss (ssget "x" '((8 . "A9")))) (command "-chprop" ss "" "la" "B4" "")(setq ss nil)
close Y
你能帮我把你的代码放到我的脚本文件里吗？
请 我发布了脚本文件all ready dwg1=drawing name 1等等。
将我第一篇文章中的3行另存为layers4321。通过记事本复制和粘贴。在命令行中键入SCRIPT，选择layers4321，它应该会更改当前图形。
页:
[1]