View Full Version : changing layers to match another drawing.
cadmando2
13th Jan 2009, 09:34 pm
I work for a HVAC company. I'm using AutoCAD 2008.
I’m working on a few project’s that we get Architectural back ground’s form one of are client’s.
The Architecture client’s uses an AutoDesk architectural program and we have to change the layer’s to match are standards, but it takes time to change layers in each drawing files.
Is there away that I can update the layers info like color in one drawing and then change the same layer’s info in other drawings I select? Without have to change them manually.
I have only used AutoCAD 2008 for a few months and I know that 2004 had a way to match layer in another drawing, but It will not work here.
I just want the layers I change in the first drawing to match the changes in other drawing I select.
:?
Is there a lisp file or VB routine or help in creating such a file,...
Thanks
borgunit
13th Jan 2009, 10:34 pm
I am not sure but check under TOOLS >> CAD STANDARDS >> LAYER TRANSLATOR. I know ACAD 2007 has it.
BIGAL
15th Jan 2009, 03:02 am
It could be done as I change all the layer properties.
The method I use is to read an existing text file this matches our surveyors library.
Ok what you need to do is write out the layer details dwg1 to a text file then compare that to a known list in dwg2 and make changes simple ha ha
here is some code to get you well underway search here for writing out layers
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
cadmando2
15th Jan 2009, 10:24 pm
Is this code lisp or VB?
Lee Mac
15th Jan 2009, 10:37 pm
VB
Cheers
Lee
Powered by vBulletin™ Version 4.1.2 Copyright © 2013 vBulletin Solutions, Inc. All rights reserved.