Public Function GetWizardInfo(Names As Variant) As Long
ReDim Names(NUM_WIZARDS)
GetWizardInfo = NUM_WIZARDS
End Function
'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
If PropID = idBoltType Or PropID = idNutType Then
ReDim Names(NUM_TYPEBOLT), Value(NUM_TYPEBOLT)
Names(0) = "Bolt1"
Values(0) = Bolt1
Names(1) = "Bolt2"
Values(1) = Bolt2
GetEnumNames = NUM_TYPEBOLT
Exit Function
End If
If PropID = idNutType Then
ReDim Names(NUM_TYPENUT), Value(NUM_TYPENUT)
Names(0) = "Nut1"
Values(0) = Nut1
Names(1) = "Nut2"
Values(1) = Nut2
GetEnumNames = NUM_TYPENUT
Exit Function
End If
GetEnumNames = 0
End Function
Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
'Set up error function
On Error GoTo Failed
Dim i%, j%
Dim Diameter#
Dim iDiam%
If SaveProperties Then
'OK button on property page was clicked
'Form is still loaded
With frmBoltNut
'Need On Error statement for the case where you have
'RRect Turbo Shape and ahother "shape" selected
On Error Resume Next
For i = 0 To NUM_TYPEBOLT
If .BoltType(i).Value Then
Graphic.Properties("BoltType") = i
Exit For
End If
Next i
For j = 0 To NUM_TYPENUT
If .NutType(j).Value Then
Graphic.Properties("NutType") = j
Exit For
End If
Next j
' iDiam = .ListDiam.ListIndex
' Graphic.Properties("Diameter") = iDiam
Diameter = 0#
On Error Resume Next
Diameter = CDbl(.ListDiam.Text)
If Diameter < 0.00001 Then Diameter = 0.5
Graphic.Properties("Diameter") = Diameter
'When the property page is closed, transfer the numeric
'Diameter value from the TextBox to the Graphic
'Get the value as a double-precision number
'Make sure it's between 0 and 100
'Set the roundness property value in the Graphic
End With
Else
'Property page is about to be opened
'Make sure the form is loaded
Load frmBoltNut
With frmBoltNut
Dim BoltProp As Variant
BoltProp = Graphic.Properties("BoltType")
If VarType(BoltProp) <> vbEmpty Then
i = CInt(BoltProp)
.BoltType(i).Value = True
End If
Dim NutProp As Variant
NutProp = Graphic.Properties("NutType")
If VarType(NutProp) <> vbEmpty Then
j = CInt(NutProp)
.NutType(j).Value = True
End If
' iDiam = Graphic.Properties("Diameter")
' .ListDiam.ListIndex = iDiam
Diameter = Graphic.Properties("Diameter")
Dim Diami#
iDiam = -1
For i = 0 To .ListDiam.ListCount - 1
Diami = CDbl(.ListDiam.List(i))
If Abs(Diameter - Diami) < 0.00001 Then
iDiam = i
End If
Next i
If iDiam = -1 Then iDiam = 4
.ListDiam.ListIndex = iDiam
'If more than one RRect is selected and they do not
'have the same properties, don't set up this field
On Error GoTo NoRType
'When the property page is opening, transfer the numeric
'roundness value from the Graphic to the TextBox
'Get the roundness property value from the Graphic
'Set the TextBox control's text
NoRType:
End With
End If
PageControls = True
Exit Function
Failed:
'For debugging purposes, report that an error occurred
If Err.Number <> 0 Then
MsgBox "Error in PageControls: " & Err.Description
End If
'Return false if an error occurred
PageControls = False
End Function
Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
'Done with form
Unload frmBoltNut
End Function
Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
With frmBoltNut
.Show vbModal
PropertyPages = Not .DialogCanceled
End With
End Function
Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
Wizard = False
End Function
'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
'Do nothing
End Function
'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
'OK to continue with change
OnGeometryChanging = True
End Function
Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
If boolCopy Then
'Vertices are already added for us...
OnNewGraphic = True
Exit Function
End If
On Error GoTo Failed
'New Graphic being created
'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
Set grfChild = grfThis.Graphics.AddLineSingle(X(1), Y(1), 0#, X(3), Y(3), 0#)
grfChild.Cosmetic = True
'2
Set grfChild = grfThis.Graphics.AddLineSingle(X(2), Y(2), 0#, X(4), Y(4), 0#)
grfChild.Cosmetic = True
'3
Set grfChild = grfThis.Graphics.AddLineSingle(X(5), Y(5), 0#, X(6), Y(6), 0#)
grfChild.Cosmetic = True
'4
Set grfChild = grfThis.Graphics.AddLineSingle(X(7), Y(7), 0#, X(9), Y(9), 0#)
grfChild.Cosmetic = True
'5
Set grfChild = grfThis.Graphics.AddLineSingle(X(8), Y(8), 0#, X(10), Y(10), 0#)
grfChild.Cosmetic = True
End If
'Add visible child Graphics
End If
grfThis.RegenUnlock
Exit Function
FailedLock:
'Remove lock
grfThis.RegenUnlock
Failed:
End Function
Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
'Return True if we did the redraw (no further processing necessary, no children will be drawn).
'Since this is just a test, we return False to let TurboCAD do the drawing operation.
Draw = False
End Function
' Form string from string with symbols
Private Function StringToSize(Str As String) As Double
Dim CharInt(10) As String, j%
CharInt(0) = "0"
CharInt(1) = "1"
CharInt(2) = "2"
CharInt(3) = "3"
CharInt(4) = "4"
CharInt(5) = "5"
CharInt(6) = "6"
CharInt(7) = "7"
CharInt(8) = "8"
CharInt(9) = "9"
Dim StrLen%, i%
Dim Char$, ResStr$
ResStr = ""
StrLen = Len(Str)
For i = 1 To StrLen
Char = VBA.Mid(Str, i, 1)
If Char = "0" Or Char = "1" Or Char = "2" Or Char = "3" Or Char = "4" Or Char = "5" Or Char = "6" Or Char = "7" Or Char = "8" Or Char = "9" Or Char = "." Or Char = "," Then
