Select Case Statement Problem

[maperalia]

The variables for the select statement is the cell "8". However, I can not
make it work in ythe program showm below.
Could you please help to find the way to may work the variable for this
select case statement?

Thanks in advance.
Maperalia



'DRAW FROM EXCEL TO AUTOCAD
Option Explicit

Public oAcadApp As AcadApplication
Public oAcadDoc As AcadDocument

'Open an existen Template
Public Sub Main()
Dim sFilename As String
AcadConnect
'Sub rountine entered with lUpperLimit set to 4000, 5000, 6000, or 7000
Select Case (pointsColl.Add Cells(8))

Case 500 To 4000
sFilename = "S:\Templates\Template1.dwt"

Case 500 To 5000
sFilename = "S:\Templates\Template2.dwt"

Case 500 To 6000
sFilename = "S:\Templates\Template3.dwt"

Case 500 To 7000
sFilename = "S:\Templates\Template4.dwt"

Case Else
MsgBox "Error, using default template", vbExclamation + vbOKOnly,
"Limits Error"
sFilename = "S:\Templates\Template1.dwt"
End Select
AcadOpenDoc sFilename
DrawInAutoCADFromExcel1

End Sub






Public Sub DrawInAutoCADFromExcel1()

Dim i As Integer
Dim lowerLoop As Integer: lowerLoop = 6
Dim upperLoop As Integer: upperLoop = 100
Dim minusValue As Integer
Dim pointsColl As New Collection
Dim acadApp As AcadApplication
Dim pline As AcadLWPolyline
Dim text As AcadText
Dim textValue As String
Dim textLocation(0 To 2) As Double
Dim textHeight As Double: textHeight = 0.03
Dim LWPoints() As Double

'**************************************************************** ******
'Insert Text
Dim oTextEnt As AcadText
Dim dInsertPoint(0 To 2) As Double
Dim sTextString As String
Dim dTextHeight As Double
Dim lRowCount As Long

dTextHeight = 0.06


AcadConnect 'Subroutine provided previously
Set oAcadDoc = oAcadApp.ActiveDocument 'Connect to the open and active Drawing
For lRowCount = 1 To ThisWorkbook.ActiveSheet.UsedRange.Rows.Count

'Type coordinates location in the columns A & B for the text written in
column D
dInsertPoint(0) = CDbl(Val(ThisWorkbook.ActiveSheet.Cells(lRowCount,
1).Value))
'dInsertPoint(0) = dInsertPoint(0) * 1000
dInsertPoint(1) = CDbl(Val(ThisWorkbook.ActiveSheet.Cells(lRowCount,
2).Value))
dInsertPoint(2) = 0#

'Type the text value in the column D
sTextString = ThisWorkbook.ActiveSheet.Cells(lRowCount, 4).Value

Set oTextEnt = oAcadDoc.ModelSpace.AddText(sTextString, dInsertPoint,
dTextHeight)

oTextEnt.Layer = "0"
oTextEnt.Alignment = acAlignmentMiddleLeft
oTextEnt.TextAlignmentPoint = dInsertPoint
oTextEnt.Color = acGreen
oTextEnt.StyleName = "title"
oTextEnt.Update






Next lRowCount


'********************************************************* **************
'Read Coordinates from Excel cells and Draw them in AutoCAD

On Error GoTo stub_Error
For i = lowerLoop To upperLoop
If Not Cells(i, 7) = "" And _
Not Cells(i, 8) = "" Then
pointsColl.Add Cells(i, 7)
pointsColl.Add Cells(i, 8)
Else: Exit For
End If
Next i

ReDim LWPoints(pointsColl.Count - 1) As Double

For i = 0 To UBound(LWPoints)
LWPoints(i) = pointsColl(i + 1)
Next i

If UBound(LWPoints) > 0 Then

With oAcadDoc.ModelSpace
'--------------------------------------------
'Draw the Polyline
Set pline = .AddLightWeightPolyline(LWPoints)
oAcadDoc.Regen acActiveViewport
pline.Color = acYellow
pline.Linetype = "Dot"
pline.LinetypeScale = 0.18
pline.Update

If LWPoints(0) = LWPoints(UBound(LWPoints) - 1) And _
LWPoints(1) = LWPoints(UBound(LWPoints)) Then

minusValue = 2
Else: minusValue = 0
End If
'--------------------------------------------


'Add Coordinates to the drawing
For i = 0 To (UBound(LWPoints) - minusValue) Step 2
textValue = LWPoints(i) & "," & LWPoints((i + 1))
textLocation(0) = LWPoints(i)
textLocation(1) = LWPoints((i + 1))
textLocation(2) = 0
Set text = .AddText(textValue, textLocation, textHeight)
text.Color = acYellow
Next i



'***********************************************************************



oAcadDoc.Regen acActiveViewport
End With

Else: Resume stub_Exit

End If

stub_Exit:


On Error GoTo 0

Set pointsColl = Nothing
Set acadApp = Nothing
Exit Sub

stub_Error:
Err.Clear
Resume stub_Exit

End Sub






'Connect to AutoCAD
Public Sub AcadConnect()
If Err Then Err.Clear
On Error Resume Next
Set oAcadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set oAcadApp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox "Could not connect to AutoCad"
Exit Sub
End If
End If
oAcadApp.Visible = True
oAcadApp.WindowState = acMax
oAcadApp.ZoomExtents

End Sub

'Open Drawing
Public Sub AcadOpenDoc(sFilename As String)
Set oAcadDoc = oAcadApp.Documents.Open(sFilename)
End Sub




















'Open an existen Template
Public Sub Main()

Dim sFilename As String

AcadConnect

Dim lUpperLimit As Long

'Sub rountine entered with lUpperLimit set to 4000, 5000, 6000, or 7000

Select Case (lUpperLimit)

Case 500 To 4000
sFilename = "S:\Templates\Template1.dwt"

Case 500 To 5000
sFilename = "S:\Templates\Template2.dwt"

Case 500 To 6000
sFilename = "S:\Templates\Template3.dwt"

Case 500 To 7000
sFilename = "S:\Templates\Template4.dwt"

Case Else
MsgBox "Error, using default template", vbExclamation + vbOKOnly,
"Limits Error"
sFilename = "S:\Templates\Template1.dwt"
End Select

AcadOpenDoc sFilename
DrawInAutoCADFromExcel1

End Sub

 

[Norman Jones]

Hi Maperalia,

Select Case (pointsColl.Add Cells(8))

Try:

Dim rng As Range

Set rng = ThisWorkbook. _
Sheets("Sheet1").Range("A8") '<<=== CHANGE

Select Case rng.Value

 

[maperalia]

Norman;
Thanks for your quick response.
I think that I was not clear when I mentioned the cell "8". In fact if you
read the following statement from my program yu will see the coordinates are
taken from the column "7" and "8", however, I am interest only for the values
taken in the column"8":

'******************************
'Read Coordinates from Excel cells and Draw them in AutoCAD

On Error GoTo stub_Error
For i = lowerLoop To upperLoop
If Not Cells(i, 7) = "" And _
Not Cells(i, 8) = "" Then
pointsColl.Add Cells(i, 7)
pointsColl.Add Cells(i, 8)
Else: Exit For
End If
Next i

ReDim LWPoints(pointsColl.Count - 1) As Double

For i = 0 To UBound(LWPoints)
LWPoints(i) = pointsColl(i + 1)
Next i

If UBound(LWPoints) > 0 Then

With oAcadDoc.ModelSpace
'--------------------------------------------


Cloud you please help me to adjust it to this variable?

Thanks in advance.
Maperalia