GaryM
31.08.2007, 11:16
Hey guysWorking 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 LoopPrivate Sub CommandButton1_Click()'declare variablesDim oAccess As New ADODB.ConnectionDim strConn As StringDim CHGLAY As RecordsetDim LayCnt As IntegerDim X As IntegerDim Y As IntegerDim LaySet As AcadSelectionSetDim FilterType(0) As IntegerDim FilterData(0) As VariantDim Ent As AcadEntityDim ConVLay As BooleanDim Layfal As Integer 'thats layer false'initiate layer countLayCnt = ThisDrawing.Layers.Count'set connection stringstrConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & "E:\Standards.mdb" & ";"'make connection to databaseSet oAccess = CreateObject("ADODB.Connection")oAccess.Open strConnCHGLAY.Open "Select !LDN & !Proposed_Layer from MS_Layers Where Len(!LDN)>0)"Layfal = 0Y = 0For Y = 0 To LayCnt - 1 'check if layers are locked ConVLay = FalseNext 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 FilterType(0) = 8 FilterData(0) = ThisDrawing.Layers.Item(Y).Name Set LaySet = ThisDrawing.SelectionSets.Add("LayerChange") LaySet.Select acSelectionSetAll, , , FilterType, FilterData 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 LstErrLay.List() = arrLay End If CHGLAY.Close oAccess.Close ThisDrawing.PurgeAll ThisDrawing.Application.Update ThisDrawing.Regen acAllViewports ThisDrawing.Application.ZoomExtents ThisDrawing.SetVariable "FIELDEVAL", 23 ThisDrawing.SetVariable "USERI5", 99 MsgBox "DONE!"End IfEnd Sub