changing layers to match another drawing.

[cadmando2]

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]

I am not sure but check under TOOLS >> CAD STANDARDS >> LAYER TRANSLATOR. I know ACAD 2007 has it.

[BIGAL]

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]

Is this code lisp or VB?

[Lee Mac]

VB

 

Cheers

 

Lee