calling a function to return an entity

[Tipo166]

Hello All,

Let me give a brief outline:

FuncA calls FuncB.

FuncB generates an entity (a region)

How do I "pass" or make usable the new entity (region) to FuncA.

Currently trying to put the new entity in a selection set(???).

 

 

 
Option Explicit
Dim areaName As String

Public Sub BuildingSQFT()
 Dim BuildingSQFT As AcadRegion

 areaName = "Building total area"
 'Call function to generate area (region) required
 RegionGenerator

 'Set BuildingSQFT = regObj

End Sub
Public Sub RegionGenerator()
   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 lngResp As Long
   Dim regObj As AcadRegion
   Dim areaSelSet As AcadSelectionSet

   On Error Resume Next
   MsgBox ("           Pick first point of " & areaName & " boundary region" _
           & Chr(13) & "(Note: This should also be the last Point of the boundary)")

   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)


  oPoly.Delete
 Set areaSelSet = ThisDrawing.SelectionSets.Add("regObj")
 areaSelSet.AddItems regObj

End Sub

[borgunit]

Basic concept..

 

Function GetAnEntity() as AnEntity
DIm YourEntity
   "CREATE YOUR ENTITY"
   Set GetAnEntity = YourEntity
End Function 

[rocheey]

Im assuming your "FuncA" is a SUBROUTINE (not a Function) called "RegionGenerator", and your "FuncB" is a SUBROUTINE (not a Function) called "RegionGenerator".

 

You want to have your

Public Sub RegionGenerator ()

to be

Public Function RegionGenerator ( ) as AcadRegion

 

 

.... and, in the second Routine, where is says

Set regObj = regVar(0)

change it to

Set RegionGenerator = regVar(0)

' yes, the *same name* you gave your function. And then erase all the stuff after that line, its not needed.

Now, in your first routine, you just call it by just using a SET command:

Set BuildingSQFT = RegionGenerator

' you can comment out the line that says ONLY "RegionGenerator", as well.

'-----------------------------------------------

To make your own function, you start out like you are making a SUB (except use the FUNCTION keyword) and then, after the brackets, put in the type of data it returns.

For Instance, a Function that returns a String:

Public Function MyStringFunction() as String

MyStringFunction = "This Is a Test String"

End Function

.. Or a Function That returns a Line (code stolen from Help):

Public Function MyStolenLineFunction() as AcadLine

Dim lineObj As AcadLine

Dim startPoint(0 To 2) As Double

Dim endPoint(0 To 2) As Double

 

' Define the start and end points for the line

startPoint(0) = 1#: startPoint(1) = 1#: startPoint(2) = 0#

endPoint(0) = 5#: endPoint(1) = 5#: endPoint(2) = 0#

 

' Create the line in model space

Set MyStolenLineFunction= ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)

End Function

 

.. the trick here is, that somewhere in your function, you have to create the variable you want to return, using the name you described your function as.

 

Then you can call it, like a regular VBA command.

To call the String Function above, you could do something like this:

MsgBox MyStringFunction

To call the Line Function above, you'd need the SET command, first...

Dim MyLine as AcadLine

Set MyLine = MyStolenLineFunction

' Highlight your new line

MyLine.Highlight True

.. and whats with all these colors now?

 

 

[rocheey]

Im assuming your "FuncA" is a SUBROUTINE (not a Function) called "RegionGenerator", and your "FuncB" is a SUBROUTINE (not a Function) called "RegionGenerator".

 

You want to have your

Public Sub RegionGenerator ()

to be

Public Function RegionGenerator ( ) as AcadRegion

 

 

.... and, in the second Routine, where is says

Set regObj = regVar(0)

 

change it to

 

Set RegionGenerator = regVar(0)

 

' yes, the *same name* you gave your function. And then erase all the stuff after that line, its not needed.

 

Now, in your first routine, you just call it by just using a SET command:

 

Set BuildingSQFT = RegionGenerator

 

' you can comment out the line that says ONLY "RegionGenerator", as well.

 

'-----------------------------------------------

To make your own function, you start out like you are making a SUB (except use the FUNCTION keyword) and then, after the brackets, put in the type of data it returns.

 

For Instance, a Function that returns a String:

 

Public Function MyStringFunction() as String

MyStringFunction = "This Is a Test String"

End Function

.. Or a Function That returns a Line (code stolen from Help):

Public Function MyStolenLineFunction() as AcadLine

Dim lineObj As AcadLine

Dim startPoint(0 To 2) As Double

Dim endPoint(0 To 2) As Double

 

' Define the start and end points for the line

startPoint(0) = 1#: startPoint(1) = 1#: startPoint(2) = 0#

endPoint(0) = 5#: endPoint(1) = 5#: endPoint(2) = 0#

 

' Create the line in model space

Set MyStolenLineFunction= ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)

End Function

 

.. the trick here is, that somewhere in your function, you have to create the variable you want to return, using the name you described your function as.

 

Then you can call it, like a regular VBA command.

To call the String Function above, you could do something like this:

MsgBox MyStringFunction

 

To call the Line Function above, you'd need the SET command, first...

Dim MyLine as AcadLine

Set MyLine = MyStolenLineFunction

' Highlight your new line

MyLine.Highlight True

 

 

.. and whats with all these colors now?

 

 

 

[Tipo166]

Im assuming your "FuncA" is a SUBROUTINE (not a Function)

>>>>>>>>>>>>>> Uhhhmm.......yep!

 

You want to have your

Public Sub RegionGenerator ()

to be

Public Function RegionGenerator ( ) as AcadRegion

>>>>>>>>>>>>>>>>>>> Very helpful

 

put in the type of data it returns.

 

For Instance, a Function that returns a String:

 

Public Function MyStringFunction() as String

MyStringFunction = "This Is a Test String"

End Function

>>>>>>>>>>>>>>>>> clarifying (emberassingly so - but!)

 

Thank you > works great and I understand.

 

Colors > donno? copied and pasted straight from VBA IDE

[CmdrDuh]

you can try and add code tags around your code. I'm guessing the ESC codes are turning the text different colors

[CmdrDuh]

Hello All,

Let me give a brief outline:

FuncA calls FuncB.

FuncB generates an entity (a region)

How do I "pass" or make usable the new entity (region) to FuncA.

Currently trying to put the new entity in a selection set(???).

 

 

 
Option Explicit
Dim areaName As String

Public Sub BuildingSQFT()
 Dim BuildingSQFT As AcadRegion

 areaName = "Building total area"
 'Call function to generate area (region) required
 RegionGenerator

 'Set BuildingSQFT = regObj

End Sub
Public Sub RegionGenerator()
   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 lngResp As Long
   Dim regObj As AcadRegion
   Dim areaSelSet As AcadSelectionSet

   On Error Resume Next
   MsgBox ("           Pick first point of " & areaName & " boundary region" _
           & Chr(13) & "(Note: This should also be the last Point of the boundary)")

   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)


  oPoly.Delete
 Set areaSelSet = ThisDrawing.SelectionSets.Add("regObj")
 areaSelSet.AddItems regObj

End Sub

I used the code tag instead of php tag