topic Old School VBA question in Developers Questions

Old School VBA question

jaykapalczynski — Wed, 08 Jun 2016 12:56:43 GMT

I am referencing an old VBA script to place a rosette tool in my map.

[ArcGIS 9.x] Rose des vents 3D [Archives] - Forum SIG - Systèmes d'Information Géographique et Géomatiqu

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

Re: Old School VBA question

FC_Basson — Wed, 08 Jun 2016 13:02:03 GMT

Space in ScreenDisplay?

Set pCirArc = pRubberCircle.TrackNew(pMxDoc.ActiveView.ScreenDis play, Nothing)

Re: Old School VBA question

jaykapalczynski — Wed, 08 Jun 2016 13:13:36 GMT

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