Strange Function Error

[AGove4123Sonnnnn]

Any Ideas why this guy won't compile?

 

 
Private Function GetPointsFromBlock(strBlockName As String) As IAcadPoint2
'Retreives and groups points from a given block...
'Get AutoCAD, dimension variables and initialize counters
Set ACAD = GetObject(, "AutoCAD.Application")
Set DOCfrom = ACAD.ActiveDocument
Dim i As Integer: i = 0
Dim intPCount As Integer: intPCount = 0
Dim blkActiveBlock As AcadBlock
Dim pntActivePoints() As IAcadPoint2
Set blkActiveBlock = DOCfrom.Blocks(strBlockName)
'Count how many points there are and redim the storage array
For Each Object In blkActiveBlock
If blkActiveBlock.Item(i).EntityType = 22 Then
ReDim pntActivePoints(0 To intPCount)
intPCount = intPCount + 1
End If
i = i + 1
Next
'Place point objects into array
i = 0: intPCount = 0
For Each Object In blkActiveBlock
If blkActiveBlock.Item(i).EntityType = 22 Then
Set pntActivePoints(intPCount) = blkActiveBlock.Item(i)
intPCount = intPCount + 1
End If
i = i + 1
Next


Debug.Print intPCount & " points were found in " & strBlockName & "!"

Set GetPointsFromBlock = pntActivePoints

End Function

Edited January 8, 2014 by AGove4123Sonnnnn
Incorrect formatting

[SLW210]

Please read the Code posting guidelines and edit your post to include the Code in Code Tags.

[RICVBA]

my Autocad2010 VBA doesn't manage IAcadPoint2 class (when selecting this keyword and pressing F1 it sends me to AcadPoint Class (Point Object))

 

so I can only give you the following guessings of mine:

 

1) I'd say you can't set a simple object (like "GetPointsFromBlock as IAcadPoint2" is) to a vector of objects. you need a simple object on the right side of the setting codeline too

 

2) maybe you'l find the following code useful for your purposes

 

 

Option Explicit
Public Type MyPointType
   coord2D(0 To 1) As Double
   coord3D(0 To 2) As Double
End Type
' you can enlarge the properties to match your needs

Sub main()
Dim MyPoints() As MyPointType, MyPoint As MyPointType
Dim Points2D() As Double, Points3D() As Double
Dim AcdPnt As AcadPoint
Dim strBlockName As String
Dim PntsTotNr As Integer, iPnt As Integer
Dim plineObj As AcadPolyline
Dim LWplineObj As AcadLWPolyline
strBlockName = "MyBlock"
Call GetPointsFromBlock2(strBlockName, PntsTotNr, MyPoints, Points2D, Points3D)
'... do whatever you need with:
' - Points() single points vector, every item of which contains both 2D and 3D coordinates vectors of a single point
' - Points2D, containing all points coordinates in 2D form
' - Points3D, containing all points coordinates in 3D form
' for example
' use single point coordinates
For iPnt = 1 To PntsTotNr
   MyPoint = MyPoints(iPnt - 1)
   Set AcdPnt = ThisDrawing.ModelSpace.AddPoint(MyPoint.coord3D)
   AcdPnt.color = acRed
Next iPnt
' use all points coordinates, in the proper 2D/3D form
If PntsTotNr > 1 Then
   ' for methods requiring 2D coordinates
   Set LWplineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points2D)
   LWplineObj.color = acWhite

   ' for methods requiring 3D coordinates
   Set plineObj = ThisDrawing.ModelSpace.AddPolyline(Points3D)
   With plineObj
       .color = acGreen
       .Move MyPoints(0).coord3D, MyPoints(PntsTotNr - 2).coord3D
   End With
End If

ZoomExtents
End Sub


Sub GetPointsFromBlock2(strBlockName As String, PntsTotNr As Integer, Points() As MyPointType, Points2DCoords() As Double, Points3DCoords() As Double)
'Retreives and groups points (and vertices if needed) coordinates from a given block...
'Get AutoCAD, dimension variables and initialize counters
Dim DOCfrom As AcadDocument
Dim Object As AcadObject
Set acad = GetObject(, "AutoCAD.Application")
Set DOCfrom = acad.ActiveDocument
Dim i As Integer: i = 0
Dim intPCount As Integer: intPCount = 0
Dim blkActiveBlock As AcadBlock
Dim pntActivePoints() As IAcadPoint2
Set blkActiveBlock = DOCfrom.Blocks(strBlockName)
Dim retCoord As Variant
Dim objName As String
Dim uBnd As Integer, lBnd As Integer, PntsNr As Integer, CoordDims As Integer
Dim x As Double, y As Double, z As Double
PntsTotNr = 0
'go through every object in the block
For Each Object In blkActiveBlock
   With Object
       objName = .ObjectName
       retCoord = .Coordinates
   End With
   uBnd = UBound(retCoord)
   lBnd = LBound(retCoord)
   ' mark only relevant objects assigning the proper CoordDims
   Select Case objName

       Case "AcDbPoint" '(3D-Polyline)
           ' 3D coordinates
           CoordDims = 3

'in case you need objects vertices coordinates too, uncomment and enhance the following lines
'        Case "AcDbPolyline" ' (LWPolyline)
'            ' 2D coordinates
'            CoordDims = 2
'
'        Case "AcDb3dPolyline" '(3D-Polyline)
'            ' 3D coordinates
'            CoordDims = 3


       Case Else ' not handled objects
           CoordDims = 0

   End Select

   'process relevant blocks only
   If CoordDims > 0 Then
       PntsNr = (uBnd - lBnd + 1) / CoordDims
       PntsTotNr = PntsTotNr + PntsNr
       ReDim Preserve Points(0 To PntsTotNr - 1)
       ReDim Preserve Points2DCoords(0 To 2 * PntsTotNr - 1)
       ReDim Preserve Points3DCoords(0 To 3 * PntsTotNr - 1)

       For i = 1 To PntsNr
           x = retCoord(CoordDims * (i - 1))
           y = retCoord(CoordDims * (i - 1) + 1)
           If CoordDims = 3 Then
               z = retCoord(CoordDims * (i - 1) + 2)
           Else
               z = 0
           End If

           Points2DCoords(2 * intPCount) = x
           Points2DCoords(2 * intPCount + 1) = y

           Points3DCoords(3 * intPCount) = x
           Points3DCoords(3 * intPCount + 1) = y
           If CoordDims = 3 Then Points3DCoords(1) = z

           With Points(intPCount)
               .coord2D(0) = x
               .coord2D(1) = y

               .coord3D(0) = x
               .coord3D(1) = y
               If CoordDims = 3 Then .coord3D(2) = z
           End With

           intPCount = intPCount + 1
       Next i
  End If
Next Object
Set acad = Nothing
End Sub

[AGove4123Sonnnnn]

RICVBA! Your right... what is that IAcadPoint2 type anyway? I got it from the data type autocad was returning while the array was set to a variant. Anyway switching up the code to use the standard AcadPoint worked swimmingly. Thanks for the code ideas too!

 

What worked -

 

 
Private Function GetPointsFromBlock(strBlockName As String)
'Retreives and groups points from a given block...
       'Get AutoCAD, dimension variables and initialize counters
       Set ACAD = GetObject(, "AutoCAD.Application")
       Set DOCfrom = ACAD.ActiveDocument
       Dim i As Integer:   i = 0
       Dim intPCount As Integer:   intPCount = 0
       Dim blkActiveBlock As AcadBlock
       Dim pntActivePoints() As AcadPoint
       Set blkActiveBlock = DOCfrom.Blocks(strBlockName)
   'Count how many points there are and redim the storage array
   For Each Object In blkActiveBlock
       If blkActiveBlock.Item(i).EntityType = 22 Then
           ReDim pntActivePoints(0 To intPCount)
           intPCount = intPCount + 1
       End If
       i = i + 1
   Next
   'Place point objects into array
   i = 0:  intPCount = 0
   For Each Object In blkActiveBlock
       If blkActiveBlock.Item(i).EntityType = 22 Then
               Set pntActivePoints(intPCount) = blkActiveBlock.Item(i)
           intPCount = intPCount + 1
       End If
       i = i + 1
   Next
   
   
       Debug.Print intPCount & " points were found in " & strBlockName & "!"
   
       GetPointsFromBlock = pntActivePoints
   
End Function

[RICVBA]

RICVBA! Your right... what is that IAcadPoint2 type anyway? I got it from the data type autocad was returning while the array was set to a variant. Anyway switching up the code to use the standard AcadPoint worked swimmingly. Thanks for the code ideas too!

 

What worked -

 

 
Private Function GetPointsFromBlock(strBlockName As String)
'Retreives and groups points from a given block...
       'Get AutoCAD, dimension variables and initialize counters
       Set ACAD = GetObject(, "AutoCAD.Application")
       Set DOCfrom = ACAD.ActiveDocument
       Dim i As Integer:   i = 0
       Dim intPCount As Integer:   intPCount = 0
       Dim blkActiveBlock As AcadBlock
       Dim pntActivePoints() As AcadPoint
       Set blkActiveBlock = DOCfrom.Blocks(strBlockName)
   'Count how many points there are and redim the storage array
   For Each Object In blkActiveBlock
       If blkActiveBlock.Item(i).EntityType = 22 Then
           ReDim pntActivePoints(0 To intPCount)
           intPCount = intPCount + 1
       End If
       i = i + 1
   Next
   'Place point objects into array
   i = 0:  intPCount = 0
   For Each Object In blkActiveBlock
       If blkActiveBlock.Item(i).EntityType = 22 Then
               Set pntActivePoints(intPCount) = blkActiveBlock.Item(i)
           intPCount = intPCount + 1
       End If
       i = i + 1
   Next


       Debug.Print intPCount & " points were found in " & strBlockName & "!"

       GetPointsFromBlock = pntActivePoints

End Function

 

Hi Agove

 

glad it works

can't be of any help as to IAcadpoint2 class. maybe other people here could answer you.

 

bytheway I think you could sensibly shorten your code making one "for each-next" loop only out of the two you're using the "Preserve" of ReDim instruction keyword as follows

 

'Count how many points there are [u]while[/u] redim the storage array and place point objects into it
i = 0:  intPCount = 0
For Each Object In blkActiveBlock
   If blkActiveBlock.Item(i).EntityType = 22 Then
       ReDim Preserve pntActivePoints(0 To intPCount)
       Set pntActivePoints(intPCount) = blkActiveBlock.Item(i)
       intPCount = intPCount + 1
   End If
   i = i + 1
Next

 

bye

[AGove4123Sonnnnn]

Thanks for the time saver! It kept deleting my data when I redimmed in the same loop and was running too late to look up the propper preserve syntax.

 

Pce RIC,

-AGove