How to call a function

hi, i've been trying to make a subroutine that from a selection of adyacent lines makes a single polilyne so that i can use sendcommand to make a fillet... i found some code for joining lines and i've been trying to call it but i just dont know how... this is the functions i found and the code im using to call

Public Function MeJoinPline(FstPol As AcadLWPolyline, NxtPol As AcadLWPolyline, FuzVal As Double) As Boolean

Dim FstArr() As Double
Dim NxtArr() As Double
Dim TmpPnt(0 To 1) As Double
Dim FstLen As Long
Dim NxtLen As Long
Dim VtxCnt As Long
Dim FstCnt As Long
Dim NxtCnt As Long
Dim RevFlg As Boolean
Dim RetVal As Boolean

With FstPol
FstArr = .Coordinates
NxtArr = NxtPol.Coordinates
FstLen = UBound(FstArr)
NxtLen = UBound(NxtArr)
'<-Fst<-Nxt
If MePointsEqual(FstArr, 1, NxtArr, NxtLen, FuzVal) Then
MeReversePline FstPol
FstArr = .Coordinates
MeReversePline NxtPol
NxtArr = NxtPol.Coordinates
RevFlg = True
RetVal = True
'<-FstNxt->
ElseIf MePointsEqual(FstArr, 1, NxtArr, 1, FuzVal) Then
MeReversePline FstPol
FstArr = .Coordinates
RevFlg = True
RetVal = True
'Fst-><-Nxt
ElseIf MePointsEqual(FstArr, FstLen, NxtArr, NxtLen, FuzVal) Then
MeReversePline NxtPol
NxtArr = NxtPol.Coordinates
RevFlg = False
RetVal = True
'Fst->Nxt->
ElseIf MePointsEqual(FstArr, FstLen, NxtArr, 1, FuzVal) Then
RevFlg = False
RetVal = True
Else
RetVal = False
End If

If RetVal Then
FstCnt = (FstLen - 1) / 2
NxtCnt = 0
.SetBulge FstCnt, NxtPol.GetBulge(NxtCnt)
For VtxCnt = 2 To NxtLen Step 2
FstCnt = FstCnt + 1
NxtCnt = NxtCnt + 1
TmpPnt(0) = NxtArr(VtxCnt)
TmpPnt(1) = NxtArr(VtxCnt + 1)
.AddVertex FstCnt, TmpPnt
.SetBulge FstCnt, NxtPol.GetBulge(NxtCnt)
Next VtxCnt
.Update
NxtPol.Delete
If RevFlg Then
MeReversePline FstPol
End If
End With

MeJoinPline = RetVal

End Function

' -----

Public Function MeReversePline(PolObj As AcadLWPolyline)

Dim NewArr() As Double
Dim BlgArr() As Double
Dim OldArr() As Double
Dim SegCnt As Long
Dim ArrCnt As Long
Dim ArrLen As Long

With PolObj
OldArr = .Coordinates
ArrLen = UBound(OldArr)
SegCnt = (ArrLen - 1) / 2
ReDim NewArr(0 To ArrLen)
ReDim BlgArr(0 To SegCnt + 1)

For ArrCnt = SegCnt To 0 Step -1
BlgArr(ArrCnt) = .GetBulge(SegCnt - ArrCnt) * -1
Next ArrCnt
For ArrCnt = ArrLen To 0 Step -2
NewArr(ArrLen - ArrCnt + 1) = OldArr(ArrCnt)
NewArr(ArrLen - ArrCnt) = OldArr(ArrCnt - 1)
Next ArrCnt

.Coordinates = NewArr

For ArrCnt = 0 To SegCnt
.SetBulge ArrCnt, BlgArr(ArrCnt + 1)
Next ArrCnt
.Update

End With

End Function

' -----

Public Function MePointsEqual(FstArr, FstPos As Long, NxtArr, NxtPos As Long, FuzVal As Double) As Boolean

Dim XcoDst As Double
Dim YcoDst As Double

XcoDst = FstArr(FstPos - 1) - NxtArr(NxtPos - 1)
YcoDst = FstArr(FstPos) - NxtArr(NxtPos)

MePointsEqual = (Sqr(XcoDst ^ 2 + YcoDst ^ 2) < FuzVal)

End Function

--THIS IS WHERE I WANT TO CALL THE FUNCTION ABOVE

Public Sub FilletPolyline()

Dim entity As AcadEntity
Dim filletRadius As Double
Dim pickedPoint As Variant
Dim polyline As AcadLWPolyline

ThisDrawing.Utility.GetEntity entity, pickedPoint, "Select a polyline..."
filletRadius = ThisDrawing.Utility.GetReal("Enter the fillet radius...")

If TypeOf entity Is AcadLWPolyline Then
Set polyline = entity
ThisDrawing.SendCommand "FILLET Radius" & Str(filletRadius) & " Polyline Last "
Else
Call MeJoinPline
End If

End Sub

thanks for your help!

 

public and private SUB's can be run via VBARUN.
public and private FUNCTIONS can't be called via vbarun.

to set up a command in autocad:

(defun c:CBA ()
(vl-vbarun "G:/WARE/vb/utilities.dvb!COPY_BLOCK_ATTS")
)

-c:CBA is the command name to type
-"G:/WARE/vb/utilities.dvb" is the fully qualified path to your project
-COPY_BLOCK_ATTS is the name of the public SUB

 

but can i call the functions above inside the sub so when the sub is called via vbarun it can be also executed?

 

sure. here's an old function that uppercases text.

notice how the function "gettexttomodify" is called from within the sub?

in this particular case the function getTextToModify returns a selection. functions may or may not return a value. if they don't return a value you can simply "call" them using Call FunctionName .

Code:

' upper case text
Public Sub UPPER_CASE_TEXT()
Dim oEnt As AcadEntity
Dim oSS As AcadSelectionSet

Set oSS = getTextToModify

For Each oEnt In oSS
oEnt.TextString = UCase(oEnt.TextString)
oEnt.Update
Next oEnt

Set oEnt = Nothing
Set oSS = Nothing
End Sub

Code:

'return a selection set of text & mtext
Public Function getTextToModify() As AcadSelectionSet
Dim ssetObj As AcadSelectionSet
Dim grpCode(0) As Integer
Dim dataVal(0) As Variant

'start an undo mark in the DB
ThisDrawing.StartUndoMark
'create a new selection set object
Set ssetObj = vbdPowerSet("SS01")

' Build a selection set of group codes and values to filter for: Text or Mtext.
grpCode(1) = 0
dataVal(1) = "TEXT,MTEXT"

'prompt for user to select text
ssetObj.SelectOnScreen grpCode, dataVal
Set getTextToModify = ssetObj

End Function