更改层以匹配另一个
我在一家暖通空调公司工作。我正在使用AutoCAD 2008。我正在做一些项目，我们得到建筑背景的形式之一是客户的。
Architecture客户端使用AutoDesk architectural程序，我们必须更改图层以匹配are标准，但更改每个图形文件中的图层需要时间。
是否可以在一个图形中更新图层信息（如颜色），然后在我选择的其他图形中更改同一图层的信息？无需手动更改。
我只使用AutoCAD 2008几个月，我知道2004有一种方法可以匹配另一个图形中的图层，但它在这里不起作用。
我只希望我在第一个图形中更改的图层与我选择的其他图形中的更改相匹配。
是否有lisp文件或VB例程或帮助创建这样的文件，。。。
谢谢 我不确定，但在工具>>CAD标准>>图层转换器下进行检查。我知道ACAD 2007有它。 这可以在我更改所有图层属性时完成。
我使用的方法是读取与我们的surveyors库匹配的现有文本文件。
好的，您需要做的是将图层细节dwg1写入文本文件，然后将其与dwg2中的已知列表进行比较，并进行简单的更改
下面是一些代码，可以帮助您在这里搜索并写出图层
Dim objENT As AcadEntity
Dim ssetObj As AcadSelectionSet
Dim layercode As String
Dim objLayers As AcadLayers
Dim objLayer As AcadLayer
Dim X, Y, J, k As Integer
Dim lname, ans, ltype As String
Dim MyLAYERNAME(256) As String
Dim MyLAYERCOLOR(256) As Integer
Dim MyLAYERLINETYPE(256) As String
'On Error GoTo filediafix
' 256 max LINES 3 VARIABLES
Open "S:\Autodesk\lisp\civilcad6layercodes.txt" For Input As #1
' setvar filedia to 0
ThisDrawing.SendCommand "filedia" & vbCr & "0" & vbCr
'loads all custom linetypes purges first then reloads
'ThisDrawing.SendCommand "-purge" & vbCr & "lt" & vbCr & "*" & vbCr & "N" & vbCr
'ThisDrawing.SendCommand "-linetype" & vbCr & "l" & vbCr & "*" & vbCr & "s:\Autodesk\supportfiles\custom.lin" & vbCr & vbCr
' reset all solid linetypes to continuous
Set objLayers = ThisDrawing.Layers
For Each objLayer In objLayers
If objLayer.Linetype = "solid" Or objLayer.Linetype = "SOLID" Then
objLayer.Linetype = "Continuous"
End If
Next objLayer
MsgBox "Solid Linetypes reset in the layers"
For Each objLayer In objLayers
'If objLayer.Name = "FENCE" Then
'If objLayer.Linetype = "903" Then
' objLayer.Linetype = "FENCE"
' End If
Next objLayer
MsgBox "903 Linetypes reset in the layers"
For Each objLayer In objLayers
If objLayer.Linetype = "dash" Then
objLayer.Linetype = "DASHED"
End If
Next objLayer
MsgBox "DASH Linetypes reset in the layers"
For Each objLayer In objLayers
If objLayer.Linetype = "VEGETATION" Then
objLayer.Linetype = "TREE"
End If
Next objLayer
MsgBox "Vegetation Linetypes reset in the layers"
' now change layer colors and linEtype for all entities to bylayer
Set ssetObj = ThisDrawing.SelectionSets.Add("MYsSS")
ssetObj.Select acSelectionSetAll
For Each objENT In ssetObj
objENT.color = acByLayer
objENT.Linetype = "ByLayer"
Next objENT
ThisDrawing.SelectionSets.Item("MYsSS").Delete
'read in each line of data file with layer name colour and linetype
Y = 0
Do While Not EOF(1) ' Check for end of file.
Line Input #1, layercode ' Read line of data.
' MsgBox "1 lines" & layercode
ans = Mid(layercode, 1, 22) 'LAYER NAME
J = 22
lname = ""
For k = 1 To J
character = Mid(ans, k, 1)
If character = " " Then k = J Else lname = lname + character
Next k
MyLAYERNAME(Y) = lname
MyLAYERCOLOR(Y) = CInt(Mid(layercode, 23, 1)) 'COLOR NUMBER
ans = Mid(layercode, 25, 10)
J = 10
ltype = ""
For k = 1 To J
character = Mid(ans, k, 1)
If character = " " Then k = J Else ltype = ltype + character
Next k
MyLAYERLINETYPE(Y) = ltype ' LINETYPE
Y = Y + 1
Loop
Close #1 ' Close file.
For Each objLayer In objLayers
For X = 1 To Y
If objLayer.Name = MyLAYERNAME(X) Then
objLayer.color = MyLAYERCOLOR(X)
objLayer.Linetype = MyLAYERLINETYPE(X)
X = Y
Else
z = z + 1
End If
Next X
Next objLayer
MsgBox "Linetypes and colours have been reset all the layers"
filediafix:
ThisDrawing.SendCommand "filedia" & vbCr & "1" & vbCr
这段代码是lisp还是VB？ VB
干杯
李
页:
[1]