Print Page | Close Window

Changing layer names via a database

Printed From: CAD Forum
Category: EN
Forum Name: AutoCAD
Forum Description: Discussion about AutoCAD and AutoCAD LT, viewers, DWG and DWF formats, Design Review, AutoCAD 360, add-ons
URL: https://www.cadforum.cz/forum_en/forum_posts.asp?TID=76
Printed Date: 29.Apr.2026 at 22:22


Topic: Changing layer names via a database
Posted By: GaryM
Subject: Changing layer names via a database
Date 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

'initiate layer count
LayCnt = ThisDrawing.Layers.Count

'set connection string
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
             "Data Source=" & "E:\Standards.mdb" & ";"

'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
                 
                  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 If
End Sub

-------------
Regards,
Gary Mansfield


Replies:
Posted By: Vladimir Michl
Date Posted: 31.Aug.2007 at 11:30
Yes, your outer Do doesn't end with a Loop.
 
You can also try our RNL.LSP - see:
http://www.cadforum.cz/cadforum_en/qaID.asp?tip=4095 - http://www.cadforum.cz/cadforum_en/qaID.asp?tip=4095


-------------
Vladimir Michl (moderator)
ARKANCE - https://arkance.world" rel="nofollow - https://arkance.world - Autodesk Platinum Partner

Posted By: GaryM
Date Posted: 31.Aug.2007 at 11:52
hey

i cant seem to get that loop at right place.  where exactly is that Do without Loop...


-------------
Regards,
Gary Mansfield

Posted By: Vladimir Michl
Date Posted: 31.Aug.2007 at 12:16
Well, every DO must end with a LOOP. I have not looked deeply into your code but you have 2 DOs and a single LOOP only - so there is a syntax error.

-------------
Vladimir Michl (moderator)
ARKANCE - https://arkance.world" rel="nofollow - https://arkance.world - Autodesk Platinum Partner

Posted By: GaryM
Date Posted: 31.Aug.2007 at 14:19
AngryF#@KED!!! it took me 2 hours to get that loop error away.

Big%20smile but it working excellently. COOL MANLOL


-------------
Regards,
Gary Mansfield


Print Page | Close Window