CAD discussion forum - ask any CAD-related questions here, share your CAD knowledge on AutoCAD, Inventor, Revit and other Autodesk software with your peers from all over the world. To start a new topic, choose an appropriate forum.
Joined: 20.Aug.2007
Location: South Africa
Status: Offline
Points: 16
Topic: Changing layer names via a database Posted: 31.Aug.2007 at 11:16
Hey guys
Working on a project where i need to connect to a access database and change layer names in the drawing to a new layer name. The database got a table with a LDN field(Old Layer) and a Proposed_Layer field(New Layer).
Before changing the layers i want it to check its status for example; if its locked etc.
The code is as follows, but seem to get a Compile error: Do without Loop
Private Sub CommandButton1_Click() 'declare variables Dim oAccess As New ADODB.Connection Dim strConn As String Dim CHGLAY As Recordset Dim LayCnt As Integer Dim X As Integer Dim Y As Integer Dim LaySet As AcadSelectionSet Dim FilterType(0) As Integer Dim FilterData(0) As Variant Dim Ent As AcadEntity Dim ConVLay As Boolean Dim Layfal As Integer 'thats layer false
'make connection to database Set oAccess = CreateObject("ADODB.Connection") oAccess.Open strConn
CHGLAY.Open "Select !LDN & !Proposed_Layer from MS_Layers Where Len(!LDN)>0)"
Layfal = 0
Y = 0 For Y = 0 To LayCnt - 1 'check if layers are locked ConVLay = False Next If ThisDrawing.Layers.Item(Y).Lock = True Then ConVLay = True Else
CHGLAY.MoveFirst Do Until CHGLAY.EOF If UCase(ThisDrawing.Layers.Item(Y).Name) + UCase(CHGLAY!LDN) Then X = 0 For X = 0 To LayCnt - 1 If UCase(ThisDrawing.Layers.Item(X).Name) = UCase(CHGLAY!Proposed_Layer) Then
For Each Ent In LaySet Ent.Layer = ThisDrawing.Layers.Item(X).Name Next ThisDrawing.SelectionSets.Item("LayerChange").Delete
ConVLay = True Exit For End If Next
If ConVLay = False Then CHGLAY.MoveFirst Do Until CHGLAY.EOF If UCase(ThisDrawing.Layers.Item(Y).Name) = UCase(CStr(CHGLAY!Proposed_Layer)) Then ConVLay = True Exit Do End If CHGLAY.MoveNext Loop End If
If ConVLay = True Then ThisDrawing.Layers.Item(Y).LayerOn = False ElseIf ConVLay = False Then Layfal = Layfal + 1
ThisDrawing.Layers.Item(Y).LayerOn = True End If
If Layfal = 0 Then
Else ReDim arrLay(0 To Layfal - 1) As Variant Y = 0 X = 0
For Y = 0 To LayCnt - 1 If ThisDrawing.Layers.Item(Y).LayerOn = True Then arrLay(X) = ThisDrawing.Layers.Item(Y).Name X = X + 1 End If Next
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot delete your posts in this forum You cannot edit your posts in this forum You cannot create polls in this forum You cannot vote in polls in this forum