I am referencing an old VBA script to place a rosette tool in my map.
Although I am seeing an error at this line (In red below)
Set pCirArc = pRubberCircle.TrackNew(pMxDoc.ActiveView.ScreenDis play, Nothing) ...can someone help?
Can anyone please help.....or suggest another Rosette Tool....although I have not found one.
Private Sub Rosette_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pCirArc As ICircularArc
Dim pPoint As IPoint
Dim pRubberCircle As IRubberBand
Set pMxDoc = ThisDocument
Set pMxApp = Application
Set pRubberCircle = New RubberCircle
' Return a new circle from the tracker object using TrackNew
Set pCirArc = pRubberCircle.TrackNew(pMxDoc.ActiveView.ScreenDis play, Nothing)
Call DrawRosette(pCirArc.CenterPoint, pCirArc.Radius)
End Sub
Space in ScreenDisplay?
Set pCirArc = pRubberCircle.TrackNew(pMxDoc.ActiveView.ScreenDis play, Nothing)
Thanks....that does appear to be an issue.....but I think I Have another issue.....
I cannot get into the Sub to Draw the circle? I dont think I can use Rosette_Mousedown because I am not seeing the Msgbox "Hello 2". The "MouseDown" does not see to work
Thougths?
Private Sub Rosette_Click()
MsgBox "Click Center and Drag Radius to Create Compass Rosette", vbOKOnly, "Rosette Tool"
End Sub
Private Sub Rosette_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
MsgBox "Hello 2"
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pCirArc As ICircularArc
Dim pPoint As IPoint
Dim pRubberCircle As IRubberBand
Set pMxDoc = ThisDocument
Set pMxApp = Application
Set pRubberCircle = New RubberCircle
' Return a new circle from the tracker object using TrackNew
Set pCirArc = pRubberCircle.TrackNew(pMxDoc.ActiveView.ScreenDisplay, Nothing)
Call DrawRosette(pCirArc.CenterPoint, pCirArc.Radius)
End Sub