Results 1 to 6 of 6

Thread: Creating layers from a List

  1. #1
    100 Club
    Join Date
    2008-02
    Posts
    112
    Login to Give a bone
    0

    Default Creating layers from a List

    I am woking on VBA program that will add layers to a drawing based on the Business Unit the user works in. The program is going to pull the layers from a master list that I created in Excel. Here is the Code I have so far;

    Code:
        Set xlbook = GetObject(SupPath & "06Layers.xls")
        'set reference to Excel file
        
        Set xlsheet = xlbook.Sheets("MasterLayerList")
        'set reference to the worksheet
        
        Dim LayerName As String
        
            
        Dim layerObj As AcadLayer
        Dim color As AcadAcCmColor
        Dim LTname As AcadLineType
        Dim Lcolor as String
    
    Select Case fmTitleBlockCreator.cmbInsertLayers.Value <> ""
        
        Case fmTitleBlockCreator.cmbInsertLayers.Value = "DD"
            
            For Each LayerName In LayerList
                Set layerObj = ThisDrawing.Layers.Add(LayerName)
                Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.Lcolor")
                layerObj.TrueColor = color
                ThisDrawing.Linetypes.Load LTname, "acad.lin"
            Next
    
        Case fmTitleBlockCreator.cmbInsertLayers.Value = "PI"
            
            For Each LayerName In LayerList
                Set layerObj = ThisDrawing.Layers.Add(LayerName)
                Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
                layerObj.TrueColor = color
                ThisDrawing.Linetypes.Load LTname, "acad.lin"
            Next
    
    End Select
    The Excel File looks something like this;
    Code:
    BU	Dis	LayerName        Color	Linetype
    DD	C-	EOP		4	Continuous
    SV	V-	EOP-X-PT	         6	Continuous
    PI	C-	EOP		2	Dash
    LA	L-	TREE		3	DashDotX2
    I know am going to use the "For Each...Next" statement, I specified the Excel file and the worksheet I want to use, how specify the Colum in excel I want to iterate through. The idea is that everytime the program get to the BU ID (i.e. DD, SV, PI, LA) it adds the layer shown in the respective row.

  2. #2
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    6,399
    Login to Give a bone
    0

    Default Re: Creating layers from a List

    If you want to use For..Each you will need to bring the data into a Collectionb object. Otherwise, use VLOOKUP.
    C:> ED WORKING....

  3. #3
    Member
    Join Date
    2006-02
    Posts
    20
    Login to Give a bone
    0

    Default Re: Creating layers from a List

    If your list isn't going to change you don't need an excel file. Just use SelectCase.

    ska

  4. #4
    100 Club
    Join Date
    2008-02
    Posts
    112
    Login to Give a bone
    0

    Default Re: Creating layers from a List

    I am at a complete loss, if I use a "Do While...Loop" I get the error "out of memory" If I use a "For Each....Next" loop and try to build a collection without specifing a range I get "out memory" error and if I specify a range I get a type "mismatch error" what am i doing wrong. It seems like this should be something really simple.

    Code:
    Sub AddLayers()
        
    Dim layerObj As AcadLayer
    Dim color As AcadAcCmColor
    Dim LayerName As String
    Dim LTname As String
    Dim col As New AcadAcCmColor
    Dim colLayerList As New Collection
    Dim i As Integer
    Dim LayerValue As Variant
    Dim LayerList As Range
    
        Set xlbook = GetObject(SupPath & "06Layers.xls")
        'set reference to Excel file
    
        Set xlsheet = xlbook.Sheets("MasterLayerList")
        'set reference to the worksheet
        
        Dim entry As AcadLineType
        Dim found As Boolean
        found = False
            
        col.ColorMethod = AutoCAD.acColorMethodByACI
        
        Do While xlsheet.Cells <> "" Or xlsheet.Cells <> 0
            i = i + 1
            LayerName = xlsheet.Cells(i, 3)
            Set layerObj = ThisDrawing.Layers.Add(LayerName)
            Set col = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
            col.ColorIndex = xlsheet.Cells(i, 4)
            layerObj.TrueColor = col
            LTname = xlsheet.Cells(i, 5)
            layerObj.Linetype = LTname
            
            For Each entry In ThisDrawing.Linetypes
            If StrComp(entry.Name, LTname, 1) = 0 Then
                found = True
                Exit For
                End If
            Next
            
            If Not (found) Then ThisDrawing.Linetypes.Load LTname, "acad.lin"
        Loop
    
    End Sub
    or
    Code:
    Sub AddLayers()
        
    Dim layerObj As AcadLayer
    Dim color As AcadAcCmColor
    Dim LayerName As String
    Dim LTname As String
    Dim col As New AcadAcCmColor
    Dim colLayerList As New Collection
    Dim i As Integer
    Dim LayerValue As Variant
    Dim LayerList As Range
    
        Set xlbook = GetObject(SupPath & "06Layers.xls")
        'set reference to Excel file
    
        Set xlsheet = xlbook.Sheets("MasterLayerList")
        'set reference to the worksheet
        
        Dim entry As AcadLineType
        Dim found As Boolean
        found = False
            
        col.ColorMethod = AutoCAD.acColorMethodByACI
        
        colLayerList.Add xlsheet.Cells.Value
            
        For Each LayerValue In colLayerList
            i = i + 1
            LayerName = xlsheet.Cells(i, 3)
            Set layerObj = ThisDrawing.Layers.Add(LayerName)
            Set col = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
            col.ColorIndex = xlsheet.Cells(i, 4)
            layerObj.TrueColor = col
            LTname = xlsheet.Cells(i, 5)
            layerObj.Linetype = LTname
            
            For Each entry In ThisDrawing.Linetypes
            If StrComp(entry.Name, LTname, 1) = 0 Then
                found = True
                Exit For
                End If
            Next
            
            If Not (found) Then ThisDrawing.Linetypes.Load LTname, "acad.lin"
        Next
    
    End Sub

  5. #5
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    6,399
    Login to Give a bone
    0

    Default Re: Creating layers from a List

    If you get an out of memory error, you've probably got an infinite loop, i.e. the condition never becomes false. Examine the logic of your while condition.
    C:> ED WORKING....

  6. #6
    100 Club
    Join Date
    2008-02
    Posts
    112
    Login to Give a bone
    0

    Default Re: Creating layers from a List

    Thanks for the reply Ed, but I figured it out. Actually, about 5 minutes after I made that last post I figured out what I was doing wrong and where my adjustments needed to be made.

Similar Threads

  1. Creating layers in VB.net
    By Ukemi72 in forum Dot Net API
    Replies: 4
    Last Post: 2013-11-18, 06:27 PM
  2. Creating layers and then deleting them
    By Coolmo in forum Dot Net API
    Replies: 3
    Last Post: 2010-06-22, 06:48 PM
  3. Creating Layers with AutoLisp
    By Snowman_427 in forum AutoLISP
    Replies: 6
    Last Post: 2009-12-12, 11:35 PM
  4. Layers for Parts List
    By bhaugi in forum AutoCAD Civil 3D - Pipes
    Replies: 3
    Last Post: 2008-02-07, 07:24 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •