New Rectangle Polygon - negative area, can't select

GregoryLewis · ‎04-03-2012

Hello All,

I have developed a script that creates a new rectangle into an existing shapefile (lease_boundary) based on offsets the user enters in. The rectangle seems to draw correctly but I can not select it afterwards. I am also using another script to create a sample grid and it does not work on it because it lists the area as negative...

I am scratching my head on this one..... any help would be greatly appreciated.:)

The code is:

Sub CreateLease

Dim objNewPoly
Dim dblX
Dim dblY
Dim strOffSetTop
Dim objToolButton
Dim blnLyrExists
Dim pThePage
Dim objFrmNoffset
Dim objFrmSoffset
Dim objFrmWoffset
Dim objFrmEoffset
Dim objFrmRadioMeters
Dim objFrmRadioFeet

   'Get a reference to the tool button object
   Set objToolButton = ThisEvent.Object
   'Initialize blnLyrExists flag to False
   blnLyrExists = False
   'If lease boundary layer exists, set the blnLyrExists flag to true
   Dim objLyr
   For Each objLyr in Map.Layers
If StrComp (objLyr.Name, "lease_boundary", 1) = 0 Then
       blnLyrExists = True
       Exit For
     End If
   Next
   'If lease boundary layer does not exist:
   'Notify the user, return the tool button to its original state, and exit.
   If Not blnLyrExists Then
MsgBox "The lease boundary is not present in the current map.", vbExclamation, "Layer not present"
     objToolButton.Click
     Exit Sub
   End If

'Check if the layer can be made editable
If Not Application.Map.Layers("lease_boundary").CanEdit Then
    MsgBox "Lease boundary cannot be edited.",vbExclamation,"Error"
    Exit Sub
End If
'If the layer is not already editable, make it editable
If Not Application.Map.Layers("lease_boundary").Editable Then
    Application.Map.Layers("lease_boundary").Editable = True
End If
'Create a new rectangle object

   Set objNewPoly = Application.CreateAppObject("rectangle")
Set objFrmRadioMeters = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("rdoMeters")
    Set objFrmRadioFeet = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("rdoFeet")

'Populate the new polygon X and Y from current GPS X and Y
If objFrmRadioMeters.value = True Then
     Set objFrmNoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtNoffset")
     objFrmSoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtSoffset")
   objFrmWoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtWoffset")
      objFrmEoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtEoffset")
   dblX = Map.PointerX
   dblY = Map.PointerY

    objNewPoly.center.X = dblX
    objNewPoly.center.Y = dblY
     objNewPoly.top    = dblY+objFrmNoffset
    objNewPoly.left   = dblX+objFrmEoffset
    objNewPoly.bottom = dblY-objFrmSoffset
       objNewPoly.right = dblX-objFrmWoffset


     Application.Map.AddFeature (objNewPoly), False
Application.ExecuteCommand ("zoomfullextent")
     Set objnewPoly = Nothing

Else

     Set objFrmNoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtNoffset")
     objFrmSoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtSoffset")
   objFrmWoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtWoffset")
                objFrmEoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtEoffset")
   dblX = Map.PointerX
   dblY = Map.PointerY

    objNewPoly.center.X = dblX
    objNewPoly.center.Y = dblY
     objNewPoly.top    = dblY+objFrmNoffset*0.3048
    objNewPoly.left   = dblX+objFrmEoffset*0.3048
    objNewPoly.bottom = dblY-objFrmSoffset*0.3048
       objNewPoly.right = dblX-objFrmWoffset*0.3048


     Application.Map.AddFeature (objNewPoly), False
Application.ExecuteCommand ("zoomfullextent")
     Set objnewPoly = Nothing
End If

End Sub

GregoryLewis · ‎04-09-2012

Hello All,

I am wondering if I haven't set enough of the properties for the rectangle. There is how I am creating the rectangle to be placed into the existing shapefile.

objNewPoly.center.X = dblX
objNewPoly.center.Y = dblY
objNewPoly.top = dblY+objFrmNoffset
objNewPoly.left = dblX+objFrmEoffset
objNewPoly.bottom = dblY-objFrmSoffset
objNewPoly.right = dblX-objFrmWoffset

Do I need to set more of the properties or am I missing a key one?

Thank you,
-Greg-

GregoryLewis · ‎04-09-2012

Maybe I can get the user to create a new polygon in the shapefile and then using VBScript change the geography of that polygon.

Thoughts?

Thanks,
-Greg-

GregoryLewis · ‎04-09-2012

Ok. So I found out that it will be fixed if I:
1) Edit the vertices's of the polygon,
2) Right click on one of them, save move to
3) Hit OK to accept the already populated coordinates
4) Click the Commit feature capture/changes

It works... I have tried adding the Application.ExecuteCommand ("featureok") to my code but it didn't seem to work.

Any ideas?

Thanks,
-Greg-

GregoryLewis · ‎04-09-2012

Hello All,

I eventually got it figured out by added points to a collection to create my polygon, new code looks like this:

Sub CreateLease
Dim pPoints ' Points collection
Dim pPoint ' Single point to be added to the collection
Dim objFrmRadioMeters
Dim objFrmRadioFeet
Dim dblX
Dim dblY
Dim objFrmNoffset
Dim objFrmSoffset
Dim objFrmWoffset
Dim objFrmEoffset
Dim pPoly

Set pPoints = Application.CreateAppObject("Points")
set pPoint = Application.CreateAppObject("Point")
Set objFrmRadioMeters = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("rdoMeters")
Set objFrmRadioFeet = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("rdoFeet")
Set objFrmNoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtNoffset")
Set objFrmSoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtSoffset")
Set objFrmWoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtWoffset")
Set objFrmEoffset = Applets("DSA_Applet").Forms("frmLeaseBoundary").Pages("Page1").Controls("txtEoffset")

dblX = Map.PointerX
dblY = Map.PointerY

'Populate the points collection
If objFrmRadioMeters.value = True Then
pPoint.X = dblX - objFrmWoffset
pPoint.Y = dblY - objFrmSoffset
pPoints.Add pPoint

pPoint.X = dblX - objFrmWoffset
pPoint.Y = dblY + objFrmNoffset
pPoints.Add pPoint

pPoint.X = dblX + objFrmEoffset
pPoint.Y = dblY + objFrmNoffset
pPoints.Add pPoint

pPoint.X = dblX + objFrmEoffset
pPoint.Y = dblY - objFrmSoffset
pPoints.Add pPoint

pPoint.X = dblX - objFrmWoffset
pPoint.Y = dblY - objFrmSoffset
pPoints.Add pPoint

Set pPoly = Application.CreateAppObject("polygon")
Call pPoly.Parts.Add(pPoints)
Call Application.Map.AddFeature (pPoly)

Set pPoly = nothing
Set pPoint = nothing
Set pPoints = nothing

Else
pPoint.X = dblX - objFrmWoffset*0.3048
pPoint.Y = dblY - objFrmSoffset*0.3048
pPoints.Add pPoint

pPoint.X = dblX - objFrmWoffset*0.3048
pPoint.Y = dblY + objFrmNoffset*0.3048
pPoints.Add pPoint

pPoint.X = dblX + objFrmEoffset*0.3048
pPoint.Y = dblY + objFrmNoffset*0.3048
pPoints.Add pPoint

pPoint.X = dblX + objFrmEoffset*0.3048
pPoint.Y = dblY - objFrmSoffset*0.3048
pPoints.Add pPoint

pPoint.X = dblX - objFrmWoffset*0.3048
pPoint.Y = dblY - objFrmSoffset*0.3048
pPoints.Add pPoint

Set pPoly = Application.CreateAppObject("polygon")
Call pPoly.Parts.Add(pPoints)
Call Application.Map.AddFeature (pPoly)

Set pPoly = nothing
Set pPoint = nothing
Set pPoints = nothing

End If

End Sub