Add condition to use different template

[Anonymous]

The program I have below reads values from cells in excel and draw it in auto into the template1.
I wonder if you can help me to add a condition if the coordinates values (x,y) taken from excel are between:
1.- 500 to 4000 use the template1
2.- 500 to 5000 use template2
3.- 500 to 6000 use template3
4.- 500 to 7000 use tempalte4

Can you please help me with this matter .

Thanks in advance.
Maperalia






'DRAW FROM EXCEL TO AUTOCAD
Option Explicit

Public oAcadApp As AcadApplication
Public oAcadDoc As AcadDocument



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
sFilename = "S:\Templates\Template1.dwt"
AcadOpenDoc sFilename
DrawInAutoCADFromExcel1

End Sub

[Anonymous]

"Select Case" seems to be a good choice for your conditions. Please see snip
below

Gary

'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

[Anonymous]

Gary;
Thanks for your quick response.
I ran the macro you gave me, however, I changed the coordinates values to see if is taking the different templates. However, it is not recognizing the coordinates values because it always open with the template1.

How can I make it recognize so the macro will open the template according the coordinates values?.

Can you help me please with this matter?

Thanks in advance.
Maperalia

[Anonymous]

Hi Maperalia,

The snip I posted was not meant to run as is.

You will have to change the variable "lUpperLimit" (in the statement below)
to match whatever variable you are using to hold the value from Excel.

Select Case (lUpperLimit)' This variable should contain the 4000, 5000, 6000
or 7000

Also get rid of the "Dim lUpperLimit" statement

Gary

[Anonymous]

Gary;
I sorry but I am little confuse. My knowledge in VBA is not as good to understand what you just explained me.

My understanding is that I have to do as I wrote below. However, I still do not understand how this information will read the following statement which is the the information taken from the excel cells.:
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


'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 (4000,5000,6000,7000)
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

Kind regards.
Maperalia

[Anonymous]

>>Select Case (4000,5000,6000,7000)
The value to be tested by "Select Case" needs to be a variable. Hard coded
values, as in the above, will give the same answer every time.

pointsColl.Add Cells(i, 7)
pointsColl.Add Cells(i, 8)

The value(s) 4000 or 5000 or 6000 or 7000 that appear to be coming from your
statements (above) need to be passed to the "Select Case" statement somehow.

You could use a global variable to store whatever it is you are trying to
test.

MyPublicExcelMaxValue = Thisworkbook.ActiveSheet.Cells(i,8).Value' Or
wherever you value comes from

Then in the other sub it would be something like:

Select Case (MyPublicExcelMaxValue)

See VBA help for the "Select Case" statement. It may be cleaner / better to
just put the "Select Case" in the same sub that returns the value you are
trying to test. Then you could choose your template file name in that same
sub without any extra confusion.

HTH

Gary