Prompt user for polyline then generate / manipulate resultant region

[Tipo166]

Hello All,

I have a feeling there is a very simple solution. I want to prompt the user to create a polyline (should be closing i.e. region but thats another story) then do some things with the resultant region (its the region I'm after). Also, using the acSelectionSetLast collection to aquire the polyline(?).

 

 
Sub buildingSQFT()

Dim Ent As AcadEntity
Dim Sset As AcadSelectionSet

ThisDrawing.ActiveSpace = acModelSpace
MsgBox ("Draw Polyline to define the area.")
WHAT COULD GO HERE TO "WAIT" FOR THE USER TO DRAW THE POLYLINE?

On Error Resume Next
ThisDrawing.SelectionSets.Item("buildingSQFT").Delete

Set Sset = ThisDrawing.SelectionSets.Add("buildingSQFT")
Sset.Select acSelectionSetLast

Sset.Delete

End Sub

 

Thanks guys!

[fixo]

Here is my old one

Feel free to change it to your suit

 

Option Explicit

Public Sub DynDrawPolyline()

   Dim pickPt As Variant
   Dim dblCoors() As Double
   Dim i As Long
   Dim oPoly As AcadLWPolyline
   Dim oEnt(0) As AcadEntity
   Dim regVar As Variant
   Dim oText As AcadText
   Dim lngResp As Long
   Dim regObj As AcadRegion
   Dim cenPt As Variant
   Dim txtPt(2) As Double

   On Error Resume Next
   pickPt = ThisDrawing.Utility.GetPoint(, vbCr & "First point: ")
   If Err = 0 Then
       ReDim dblCoors(1)
       dblCoors(i) = pickPt(0): dblCoors(i + 1) = pickPt(1)
       Do Until Err.Number <> 0
           i = i + 2
           pickPt = ThisDrawing.Utility.GetPoint(pickPt, vbCr & "Pick next point [or press Enter to stop]: ")
           ReDim Preserve dblCoors(UBound(dblCoors) + 2)
           dblCoors(i) = pickPt(0): dblCoors(i + 1) = pickPt(1)
           If oPoly Is Nothing Then
               Set oPoly = ThisDrawing.ModelSpace.AddLightWeightPolyline(dblCoors)
           Else
               oPoly.Coordinates = dblCoors
           End If
       Loop
   End If

   oPoly.Closed = True
   oPoly.Update

   Set oEnt(0) = oPoly
   regVar = ThisDrawing.ModelSpace.AddRegion(oEnt)

   Set regObj = regVar(0)
   cenPt = regObj.Centroid
   Debug.Print "The centroid for the contour is " & cenPt(0) & ", " & cenPt(1), , "Region Example" '<-- for the debug only

   txtPt(0) = cenPt(0): txtPt(1) = cenPt(1): txtPt(2) = 0#
   Set oText = ThisDrawing.ModelSpace.AddText(CStr(Round(regObj.Area, 2)), txtPt, 5#)

   lngResp = MsgBox("Do you want to delete polyline?", vbYesNo, "Region Example")
   If lngResp = 6 Then
       oPoly.Delete
   End If

End Sub

 

~'J'~

[Tipo166]

Thanks J! looks like it will work great.