AutoCAD 2000 - Area of user selected polyline

AutoCAD 2000 - Area of user selected polyline

Anonymous
Not applicable
154 Views
3 Replies
Message 1 of 4

AutoCAD 2000 - Area of user selected polyline

Anonymous
Not applicable
Hi,

I'm running into trouble with a apparently simple task of selecting a
polyline and returning it's area.

Can someone show me some working code for this task ?

I started with the following code (courtesy of Randall Rath)

'Build the selection set
Dim objBlkRef As AcadBlockReference ' Line 1
Dim objGen As Object
Dim varPnt As Variant
Dim intCnt As Integer
Dim varAtts As Variant
Dim strPrompt As String
Dim Tags() As Variant
Dim Text() As String
strPrompt = "Select a block with attributes: "
ThisDrawing.Utility.GetEntity objGen, varPnt, strPrompt
If TypeOf objGen Is AcadBlockReference Then ' Line 11
Set objBlkRef = objGen

I tried various options in lieu of AcadBlockReference from lines 1 and 11.
eg LWPOLYLINE, AcDb2dPolyline.

However, this does not seem to enable me to find the selected polyline to
get its 'area' property.

--

Regards

Laurie Comerford
CADApps
0 Likes
155 Views
3 Replies
Replies (3)
Message 2 of 4

Anonymous
Not applicable
The code you quoted has nothing to do with polyline area. Try something like
this instead:

Dim poly As AcadLWPolyline

ThisDrawing.Utility.GetEntity poly, pt, "Select a polyline: "
Debug.Print poly.Area

This will error out if the user selets anything other than a lightweight
polyline, so you'll want to include some error checking.

--
Attitudes are contagious. Is yours worth catching?
http://www.acadx.com

Laurie Comerford wrote in message
news:20BF3E66D27896626413C18380EB60EB@in.WebX.SaUCah8kaAW...
> Hi,
>
> I'm running into trouble with a apparently simple task of selecting a
> polyline and returning it's area.
>
> Can someone show me some working code for this task ?
>
> I started with the following code (courtesy of Randall Rath)
>
> 'Build the selection set
> Dim objBlkRef As AcadBlockReference ' Line 1
> Dim objGen As Object
> Dim varPnt As Variant
> Dim intCnt As Integer
> Dim varAtts As Variant
> Dim strPrompt As String
> Dim Tags() As Variant
> Dim Text() As String
> strPrompt = "Select a block with attributes: "
> ThisDrawing.Utility.GetEntity objGen, varPnt, strPrompt
> If TypeOf objGen Is AcadBlockReference Then ' Line 11
> Set objBlkRef = objGen
>
> I tried various options in lieu of AcadBlockReference from lines 1 and 11.
> eg LWPOLYLINE, AcDb2dPolyline.
>
> However, this does not seem to enable me to find the selected polyline to
> get its 'area' property.
>
> --
>
> Regards
>
> Laurie Comerford
> CADApps
>
0 Likes
Message 3 of 4

Anonymous
Not applicable
Hi Laurie,
Allow me to continue the courtesy. When you declare a variable using early
binding (which is what we are doing when we declare an object variable as
anything other than "Object" or "Variant" ) you use the Programmatic
Identifier for the object, In this case:

AcadPolyline
or
AcadLWPolyline

The VBA editor will help you locate the correct Identifier if you TYPE in
the statement:

Dim objLWPline As <----- As soon as you enter this "space" character, the
editor will pop open the "Intelli - sense" drop down box. So you continue to
type ---> "AcadLW" and the drop down will continue to follow your typing
showing the nearest match to what you have typed in this case,
"AcadLWPolyline" will be selected. By using the "Tab" key or "Enter" key
when the correct item is selected the editor will automatically enter the
name for you (Tab will leave the cursor on the same line, Enter will move it
to the next line)

And now a possible soulution:

Public Sub Test()
Dim dblPLArea As Double
dblPLArea = PolyLineArea
If dblPLArea > 0 Then
MsgBox dblPLArea
End If
End Sub

Public Function PolyLineArea()
Dim objLWPline As AcadLWPolyline
Dim objPline As AcadPolyline
Dim objGen As AcadEntity
Dim varPnt As Variant
Dim dblArea As Double
Dim strPrompt As String
On Error GoTo Err_Control
strPrompt = vbCrLf & "Select a polyline entity: "
ThisDrawing.Utility.GetEntity objGen, varPnt, strPrompt
If TypeOf objGen Is AcadLWPolyline Then
Set objLWPline = objGen
dblArea = objLWPline.Area
ElseIf TypeOf objGen Is AcadPolyline Then
Set objPline = objGen
dblArea = objPline.Area
End If
PolyLineArea = dblArea
Exit_Here:
Exit Function
Err_Control:
Debug.Print Err.Description
Resume Exit_Here
End Function

You can get a function that allows the user to select multiple entities (any
type) and add their areas on the Source code page:

http://vbdesign.hypermart.net/cadpages/code.htm
Look for the AddArea link (opens a new browser window) in the viewable code
area

If the user selects an entity that does not support an area property, the
procedure alerts them that the entity will not be included in the
calculation, and ask for permission to continue. The page also includes a
function to place the information into an Excel sheet.

Randall Rath
0 Likes
Message 4 of 4

Anonymous
Not applicable
Hi

Thanks to both Randall and Frank for their prompt replies (on a Sunday).
I thought reader's may be interested in how I combined the minimalist and
maximalist solutions offered.
My resultant data has to be written to a Textbox, so I wanted it returned as
a string with a practical limit of about 7 characters.

External to the function as part of my program I establish the Public String
"sCADApps".

Using the objPoly as an AcadObject has the advantage that it doesn't matter
whether I select a polyline, or LWpolyline, for that matter any other
object which has an area. In the application as it will be used the
selected objects will be closed polylines. As written, the User has to
press in the case that there are no objects in the drawing with an
'area' property.

This function does not check if the polyline is closed and returns an area
for unclosed as well a closed objects.

Public Function FindPolyArea() As String
On Error GoTo ErrorFindPolyArea
Dim dArea As Double
Dim vData(0 To 2) As Variant
Dim objPoly As AcadObject ' An AcadObject allows selection of
Polylines, or LWPolylines

ThisDrawing.Utility.GetEntity objPoly, vData, "Select the polyline
enclosing the catchment: "
dArea = objPoly.Area
FindPolyArea = Left$(CStr(dArea), 7)
Exit Function

ErrorFindPolyArea:
MsgBox "Sorry, the selected object is not a polyline: ",
vbInformation, sCADApps
FindPolyArea
End Function

Regards

Laurie Comerford
CADApps
Randall Rath wrote in message
news:201DDAB61A5FE2FFCAC70626199C5FEC@in.WebX.SaUCah8kaAW...
> Hi Laurie,
> Allow me to continue the courtesy. When you declare a variable using early
> binding (which is what we are doing when we declare an object variable as
> anything other than "Object" or "Variant" ) you use the Programmatic
> Identifier for the object, In this case:
>
> AcadPolyline
> or
> AcadLWPolyline
>
> The VBA editor will help you locate the correct Identifier if you TYPE in
> the statement:
>
> Dim objLWPline As <----- As soon as you enter this "space" character, the
> editor will pop open the "Intelli - sense" drop down box. So you continue
to
> type ---> "AcadLW" and the drop down will continue to follow your typing
> showing the nearest match to what you have typed in this case,
> "AcadLWPolyline" will be selected. By using the "Tab" key or "Enter" key
> when the correct item is selected the editor will automatically enter the
> name for you (Tab will leave the cursor on the same line, Enter will move
it
> to the next line)
>
> And now a possible soulution:
>
> Public Sub Test()
> Dim dblPLArea As Double
> dblPLArea = PolyLineArea
> If dblPLArea > 0 Then
> MsgBox dblPLArea
> End If
> End Sub
>
> Public Function PolyLineArea()
> Dim objLWPline As AcadLWPolyline
> Dim objPline As AcadPolyline
> Dim objGen As AcadEntity
> Dim varPnt As Variant
> Dim dblArea As Double
> Dim strPrompt As String
> On Error GoTo Err_Control
> strPrompt = vbCrLf & "Select a polyline entity: "
> ThisDrawing.Utility.GetEntity objGen, varPnt, strPrompt
> If TypeOf objGen Is AcadLWPolyline Then
> Set objLWPline = objGen
> dblArea = objLWPline.Area
> ElseIf TypeOf objGen Is AcadPolyline Then
> Set objPline = objGen
> dblArea = objPline.Area
> End If
> PolyLineArea = dblArea
> Exit_Here:
> Exit Function
> Err_Control:
> Debug.Print Err.Description
> Resume Exit_Here
> End Function
>
> You can get a function that allows the user to select multiple entities
(any
> type) and add their areas on the Source code page:
>
> http://vbdesign.hypermart.net/cadpages/code.htm
> Look for the AddArea link (opens a new browser window) in the viewable
code
> area
>
> If the user selects an entity that does not support an area property, the
> procedure alerts them that the entity will not be included in the
> calculation, and ask for permission to continue. The page also includes a
> function to place the information into an Excel sheet.
>
> Randall Rath
>
0 Likes