TheSwamp

Code Red => VB(A) => Topic started by: JohnF on January 22, 2007, 02:22:09 AM

Title: Boundary Poly in VBA
Post by: JohnF on January 22, 2007, 02:22:09 AM

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.

Title: Re: Boundary Poly in VBA
Post by: Tuoni on January 22, 2007, 04:34:24 AM

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 (http://discussion.autodesk.com/thread.jspa?messageID=415313)

Title: Re: Boundary Poly in VBA
Post by: Matersammichman on January 29, 2007, 05:47:30 PM

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

Title: Re: Boundary Poly in VBA
Post by: Fatty on January 30, 2007, 04:06:30 AM

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'~

Title: Re: Boundary Poly in VBA
Post by: Matersammichman on January 30, 2007, 10:17:10 AM

Thanks Fatty, that's even better!

Title: Re: Boundary Poly in VBA
Post by: Fatty on January 30, 2007, 06:02:48 PM

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

Regards,

~'J'~