Topic: Boundary Poly in VBA

[JohnF]

Has anyone created code in VBA to match the Boundary Polyline command?

I have searched and got nothing - just don't want to recreate the wheel.

[Tuoni]

There are really, from my experience, only two ways to do this (or something similar)...

one is to create regions from the polylines then use booleans (I mean as in Subtract etc) to make a region of the required shape, or to fall back on the good ol' SendCommand *shudders*

For an example of this, check here: http://discussion.autodesk.com/thread.jspa?messageID=415313

[Matersammichman]

This should do the trick and more...I made this to calc areas. Just copy it into your app, make the command button, run it, and click inside the closed () where you want an area.

Private Sub cmdArea_Click()
Me.Hide
Dim Pt As Variant, gotpt As Boolean
gotpt = False

Do
On Error Resume Next
Pt = ThisDrawing.Utility.GetPoint(, "Select an Internal Point")
If Err Then

Err.Clear
gotpt = False
Else
gotpt = True
End If
Loop While Not gotpt
On Error GoTo 0
ThisDrawing.SendCommand Chr(3) & Chr(3) & "-boundary" & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr
'''''''''''''''
ThisDrawing.SendCommand "_area" & vbCr & "object" & vbCr & "last" & vbCr
varArea = "_area" & vbCr & "object" & vbCr & "last" & vbCr
ThisDrawing.SendCommand "Erase" & vbCr & "Last" & vbCr & vbCr

''''''''''''''''''
''''''''''''''''''
Dim SysVarName As String
Dim VarData As Variant
Dim intData As Double
SysVarName = "DIMSCALE"
sysVarName2 = "area"
VarData = ThisDrawing.GetVariable(SysVarName)
varArea = Round(Val(ThisDrawing.GetVariable(sysVarName2)) / 144, 0) & " Sq. Ft."
intData = VarData * 0.09375 'for 3/32 text

Dim textObj As AcadText
Dim text As Variant
Dim Height As Variant
Height = intData
Set textObj = ThisDrawing.ModelSpace.AddText(varArea, Pt, Height)

End Sub

[Fatty]

Here is slightly edited version
Tested in A2005 only

Code: [Select]

Option Explicit
'| request check "Break on Unhandled Errors"
'| in Tools -> References -> Options -> General tab
'| -> Error Trapping field
'|---------------------------------------------------|
Private Sub cmdArea_Click()
     Me.Hide
     Dim Pt As Variant, _
         varArea As String, _
         pstr As String, _
         SysVarName As String, _
         sysVarName2 As String, _
         VarData As Variant, _
         intData As Double, _
         textObj As AcadText, _
         text As Variant, _
         Height As Variant, _
         Msg As String

     SysVarName = "DIMSCALE"
     sysVarName2 = "AREA"

     With ThisDrawing

          .SetVariable "OSMODE", 0
          .SetVariable "CMDECHO", 0

          '' Multiple getpoint method by Tony Tanzillo
          Msg = vbCrLf & "Select an Internal Point"

          Do
               On Error Resume Next
               Pt = .Utility.GetPoint(, Msg)
               If Err Then
                    Err.Clear
                    Exit Do
               End If
               On Error GoTo 0

               pstr = Replace(CStr(Pt(0)), ",", ".") & "," & _
                      Replace(CStr(Pt(1)), ",", ".")

               .SendCommand Chr(3) & Chr(3) & "._-boundary" & vbCr & pstr & vbCr & vbCr
               .SendCommand "._area" & vbCr & "_Object" & vbCr & "_Last" & vbCr
               .SendCommand "._erase" & vbCr & "_Last" & vbCr & vbCr

               VarData = .GetVariable(SysVarName)
               varArea = Round(Val(.GetVariable(sysVarName2)) / 144, 2) & " Sq. Ft."
               intData = VarData * 0.09375     'for 3/32 text

               Height = intData
               Set textObj = .ModelSpace.AddText(varArea, Pt, Height)
               textObj.Update

               Msg = vbCrLf & "Next Internal Point or ENTER to exit: "

          Loop
          On Error GoTo 0

          .SetVariable "OSMODE", 703
          .SetVariable "CMDECHO", 1

     End With

     MsgBox "Done"

     Unload Me

End Sub
~'J'~

[Matersammichman]

Thanks Fatty, that's even better!

[Fatty]

C'mon
I am just used your code
Not a big deal though

Regards,

~'J'~