Alright, I think we're moving in the right direction.
Also, I think I need to explain a bit more what I'm doing. I need to be able to take any kind of shape or complex shape element and find the XY min/max values automatically so that I can create a grid of squares, which is what the "tile size" part of my form is about. That will allow me to create a fence out of the element, and void delete all the boxes I don't need. All of the shapes I need will most likely not be orthogonal. Therefore I need to be able to have the class module pass the min/max XY values on to the form and the function/ sub in the form will take care of the rest. Am I doing something backwards? (it's probable) Or am I asking the class module to do something strange?
This may seem like a lot of work for a macro, but we run into some large shapes that need to have grids made, and not always of the same size tiles, things like that, so making a macro like this seemed to be the best way to go.
Here is the rest of the code for my form.
Option Explicit
Public Property Get HighPoint() As Point3d
HighPoint = Hpoint
End Property
Public Property Get LowPoint() As Point3d
LowPoint = Lpoint
End Property
Function DOmath()
Dim Xmax As Double
Dim Xmin As Double
Dim Ymax As Double
Dim Ymin As Double
Dim AddXdata As Long
Dim SubYdata As Long
Dim X As Long
Dim Y As Long
Dim XtileBeg As Double
Dim XtileEnd As Double
Dim YtileBeg As Double
Dim YtileEnd As Double
Dim Diff As Double
Dim nDiff As Double
Dim startpoint As Point3d
Dim endpoint As Point3d
Dim CounterX As Long
Dim CounterY As Long
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
' Set tile parameters
If Tile10000.Value = True Then
AddXdata = 10000
SubYdata = -10000
ElseIf Tile5000.Value = True Then
AddXdata = 5000
SubYdata = -5000
ElseIf Tile2500.Value = True Then
AddXdata = 2500
SubYdata = -2500
End If
X = AddXdata
Y = SubYdata
Xmax = TextXmax.Value
Xmin = TextXmin.Value
Ymax = TextYmax.Value
Ymin = TextYmin.Value
' Find the Tile end X coord
Diff = Xmax
If Diff = 0 Then
XtileEnd = 0
Else
If Diff < 0 Then
Do
nDiff = Diff + X
Diff = nDiff
If Diff = 0 Then Exit Do
If Diff > 0 Then Exit Do
Loop
If Diff = 0 Then
XtileEnd = Xmax
Else
XtileEnd = Xmax - Diff - X
End If
Else
Do
nDiff = Diff - X
Diff = nDiff
If Diff = 0 Then Exit Do
If Diff < 0 Then Exit Do
Loop
If Diff = 0 Then
XtileEnd = Xmax
Else
XtileEnd = Xmax - Diff - X
End If
End If
End If
Debug.Print Diff
Debug.Print XtileEnd
'Find the Tile beginning X coord
Diff = Xmin
If Diff = 0 Then
XtileBeg = 0
Else
If Diff < 0 Then
Do
nDiff = Diff + X
Diff = nDiff
If Diff = 0 Then Exit Do
If Diff > 0 Then Exit Do
Loop
If Diff = 0 Then
XtileBeg = Xmin
Else
XtileBeg = Xmin - Diff
End If
Else
Do
nDiff = Diff - X
Diff = nDiff
If Diff = 0 Then Exit Do
If Diff < 0 Then Exit Do
Loop
If Diff = 0 Then
XtileBeg = Xmin
Else
XtileBeg = Xmin - Diff
End If
End If
End If
Debug.Print Diff
Debug.Print XtileBeg
' Find the Tile beginning Y coord
Diff = Ymax
If Diff = 0 Then
YtileBeg = 0
Else
If Diff < 0 Then
Do
nDiff = Diff + X
Diff = nDiff
If Diff = 0 Then Exit Do
If Diff > 0 Then Exit Do
Loop
If Diff = 0 Then
YtileBeg = Ymax
Else
YtileBeg = Ymax - Diff
End If
Else
Do
nDiff = Diff - X
Diff = nDiff
If Diff = 0 Then Exit Do
If Diff < 0 Then Exit Do
Loop
If Diff = 0 Then
YtileBeg = Ymax
Else
YtileBeg = Ymax - Diff
End If
End If
End If
Debug.Print Diff
Debug.Print YtileBeg
' Find the Tile end Y coord
Diff = Ymin
If Diff = 0 Then
YtileEnd = 0
Else
If Diff < 0 Then
Do
nDiff = Diff + X
Diff = nDiff
If Diff = 0 Then Exit Do
If Diff > 0 Then Exit Do
Loop
If Diff = 0 Then
YtileEnd = Ymin
Else
YtileEnd = Ymin - Diff + X
End If
Else
Do
nDiff = Diff - X
Diff = nDiff
If Diff = 0 Then Exit Do
If Diff < 0 Then Exit Do
Loop
If Diff = 0 Then
YtileEnd = Ymin
Else
YtileEnd = Ymin - Diff + X
End If
End If
End If
Debug.Print Diff
Debug.Print YtileEnd
startpoint.X = XtileBeg
startpoint.Y = YtileBeg
startpoint.Z = 0
endpoint.X = XtileBeg + X
endpoint.Y = YtileBeg + Y
endpoint.Z = 0
'Draw a square
CadInputQueue.SendCommand "place block icon"
CadInputQueue.SendDataPoint startpoint
CadInputQueue.SendDataPoint endpoint
CadInputQueue.SendReset
CommandState.StartDefaultCommand
'Copy square
CadInputQueue.SendCommand "copy icon"
CadInputQueue.SendDataPoint startpoint
CounterX = 2
endpoint.Y = YtileBeg
ExcelSheet.Application.Visible = True
ExcelSheet.Application.Cells(1, 2).Value = startpoint.X
ExcelSheet.Application.Cells(1, 3).Value = startpoint.Y
Do Until startpoint.Y = YtileEnd
Do Until endpoint.X = XtileEnd
endpoint.X = startpoint.X + X
endpoint.Y = startpoint.Y
CadInputQueue.SendDataPoint endpoint
startpoint.X = endpoint.X
ExcelSheet.Application.Cells(CounterX, 2).Value = endpoint.X
ExcelSheet.Application.Cells(CounterX, 3).Value = endpoint.Y
CounterX = CounterX + 1
Loop
startpoint.X = XtileBeg
CadInputQueue.SendDataPoint startpoint
ExcelSheet.Application.Cells(CounterX, 2).Value = startpoint.X
ExcelSheet.Application.Cells(CounterX, 3).Value = startpoint.Y
endpoint.X = startpoint.X
startpoint.Y = endpoint.Y + Y
CounterX = CounterX + 1
Loop
CadInputQueue.SendReset
ExcelSheet.SaveAs "E:\TestingPleasework.xls"
ExcelSheet.Application.Quit
' Test values
Debug.Print Xmax
Debug.Print Xmin
Debug.Print Ymax
Debug.Print Ymin
Debug.Print AddXdata
Debug.Print SubYdata
Debug.Print X
Debug.Print Y
Debug.Print XtileBeg
Debug.Print XtileEnd
Debug.Print YtileBeg
Debug.Print YtileEnd
End Function
Sub BtnAccept_Click()
Dim AddXdata As Double
Dim SubYdata As Double
Dim startpoint As Point3d
Dim endpoint As Point3d
Dim Xmax As Double
Dim Xmin As Double
Dim Ymax As Double
Dim Ymin As Double
Dim X As Long
Dim Y As Long
Dim XtileBeg As Double
Dim XtileEnd As Double
Dim YtileBeg As Double
Dim YtileEnd As Double
Dim Diff As Double
Dim nDiff As Double
If TextXmax.Value = "" Then
MsgBox ("Error: Value cannot be Null (but can be 0)")
ElseIf TextYmin.Value = "" Then
MsgBox ("Error: Value cannot be Null (but can be 0)")
ElseIf TextXmin.Value = "" Then
MsgBox ("Error: Value cannot be Null (but can be 0)")
ElseIf TextYmax.Value = "" Then
MsgBox ("Error: Value cannot be Null (but can be 0)")
Else
Me.Hide
DOmath
CadInputQueue.SendReset
Debug.Print X
Debug.Print Y
Debug.Print XtileBeg
Debug.Print XtileEnd
Debug.Print YtileBeg
Debug.Print YtileEnd
CommandState.StartDefaultCommand
End If
End Sub
Sub BtnCancel_Click()
Me.Hide
Unload Me
CommandState.StartDefaultCommand
End Sub
Sub BtnDefine_Click()
Dim oIDele As New IDele
Dim TextXmax As Double
Dim TextYmax As Double
Dim TextXmin As Double
Dim TextYmin As Double
Dim HighPoint As Point3d
Dim LowPoint As Point3d
Dim Xmax As Double
Dim Xmin As Double
Dim Ymax As Double
Dim Ymin As Double
Me.Hide
CommandState.StartLocate oIDele
TextXmax = HighPoint.X
TextYmax = HighPoint.Y
TextXmin = LowPoint.X
TextYmin = LowPoint.Y
Xmax = TextXmax
Xmin = TextXmin
Ymax = TextYmax
Ymin = TextYmin
Debug.Print TextXmax
Debug.Print TextXmin
Debug.Print TextYmax
Debug.Print TextYmin
End Sub
Sub OptAuto_Click()
BtnDefine.Enabled = True
BtnDefine.Locked = False
LabXmax.Enabled = False
LabXmin.Enabled = False
LabYmax.Enabled = False
LabYmin.Enabled = False
TextXmax.Enabled = False
TextXmax.Locked = True
TextXmin.Enabled = False
TextXmin.Locked = True
TextYmax.Enabled = False
TextYmax.Locked = True
TextYmin.Enabled = False
TextYmin.Locked = True
End Sub
Sub OptManual_Click()
BtnDefine.Enabled = False
BtnDefine.Locked = True
LabXmax.Enabled = True
LabXmin.Enabled = True
LabYmax.Enabled = True
LabYmin.Enabled = True
TextXmax.Enabled = True
TextXmax.Locked = False
TextXmin.Enabled = True
TextXmin.Locked = False
TextYmax.Enabled = True
TextYmax.Locked = False
TextYmin.Enabled = True
TextYmin.Locked = False
End Sub
Private Sub UserForm_Click()
End Sub
I know some of it will seem rather complicated for what I'm trying to do, but I did not know a better way to make sure that the tiles fall on a 2500', 5000' or 10,000' grid.