AutoNumbering Polygons inside another polygon

[Sundar]

Hi all,

I have a task of numbering polygons which are inside another polygon from left to right order.there may be any number of rows of polygons in a big polygon.Need to number from top left to the right go down to next row and number further.Any code of completing this task in VBA? Awaiting your valuable replies.

 

P.S Attached JPEG for further clarrification...

[fixo]

Here you go, a little tested, change to your suit,

I can't help for more

 
Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Sub TestNumberingPlines()
    Dim oPoly As AcadLWPolyline
    Dim oEnt As AcadEntity
    Dim i As Long
    Dim setObj As AcadSelectionSet
    Dim setColl As AcadSelectionSets
    Dim oPline As AcadLWPolyline
    Dim oText As AcadText
    Dim pickPnt As Variant
    Dim setName As String
    Dim selMod As Long
    Dim gpCode(0 To 1) As Integer
    Dim dataValue(0 To 1) As Variant
    Dim dxfcode, dxfdata
    Dim selPts As Variant
    On Error GoTo Err_Control
    gpCode(0) = 0: dataValue(0) = "LWPOLYLINE"
    gpCode(1) = 70: dataValue(1) = 1
    dxfcode = gpCode: dxfdata = dataValue
    setName = "$PolygonSelect$"
    With ThisDrawing
         Set setColl = .SelectionSets
         For Each setObj In setColl
              If setObj.Name = setName Then
                   .SelectionSets.item(setName).Delete
                   Exit For
              End If
         Next
         Set setObj = .SelectionSets.Add(setName)
    End With
    Dim lp As Variant
   
   ' Return a point using a prompt
   lp = ThisDrawing.Utility.GetPoint(, "Enter a lower left point: ")
    Dim up As Variant
'    Dim basePnt(0 To 2) As Double
'    basePnt(0) = 2#: basePnt(1) = 2#: basePnt(2) = 0#
   
   ' Prompt the user to pick second point and returns the point
   up = ThisDrawing.Utility.GetCorner(lp, "Enter Other corner: ")
   Dim ptArr(0 To 11) As Double
   
   ptArr(0) = lp(0): ptArr(1) = lp(1): ptArr(2) = 0
   ptArr(3) = up(0): ptArr(4) = lp(1): ptArr(5) = 0
   ptArr(6) = up(0): ptArr(7) = up(1): ptArr( = 0
   ptArr(9) = lp(0): ptArr(10) = up(1): ptArr(11) = 0
    
    selMod = acSelectionSetCrossingPolygon
    setObj.SelectByPolygon selMod, ptArr, dxfcode, dxfdata
    
    setObj.Highlight True
    
    MsgBox "Selected: " & CStr(setObj.Count) & " blockds" & vbCr & "Do your rest work here"
        Dim pt1(0 To 2) As Double
   Dim pt2(0 To 2) As Double
   Dim accumColl As New Collection
    Dim num As Integer
    num = 1
    For Each oEnt In setObj
    Set oPline = oEnt
      pt1(0) = oPline.Coordinate(0)(0): pt1(1) = oPline.Coordinate(0)(1): pt1(2) = 0
  pt2(0) = oPline.Coordinate(2)(0): pt2(1) = oPline.Coordinate(2)(1): pt2(2) = 0
  Dim tp(2) As Double
  tp(0) = (pt1(0) + pt2(0)) / 2: tp(1) = (pt1(1) + pt2(1)) / 2: tp(2) = 0
  accumColl.Add (tp)
    num = num + 1
    Next
    
    '--------------------------------------------''
         Dim m As Long, k As Long, n As Long
         m = accumColl.Count - 1
         k = 2
         ReDim sortedArray(m, k)
         n = 0
         Dim item
         For Each item In accumColl
         sortedArray(n, 0) = item(0)
         sortedArray(n, 1) = item(1)
         sortedArray(n, 2) = item(2)
         n = n + 1
         Next
''----------------------------------------------
'' Note: Put fuzz variable (15.0) to your suit , say half of height of minimal polygon
sortedArray = SortPointsLikeTable(sortedArray, 10#)
'-----------------------------------------------
For n = LBound(sortedArray, 1) To UBound(sortedArray, 1)
Dim textPt(2) As Double
textPt(0) = sortedArray(n, 0): textPt(1) = sortedArray(n, 1): textPt(2) = sortedArray(n, 2)
Set oText = ThisDrawing.ModelSpace.AddText(CStr(n + 1), textPt, 15#)
oText.Alignment = acAlignmentMiddleCenter
oText.TextAlignmentPoint = textPt
oText.InsertionPoint = oText.TextAlignmentPoint
Next
 
Err_Control:
If Err.Number <> 0 Then
    MsgBox Err.Description
End If
End Sub
Function SortPointsLikeTable(ByVal sourceArr As Variant, fuzz As Double)
         Dim i As Integer
         Dim j As Integer
         Dim tempPt(2)
         For i = UBound(sourceArr) To LBound(sourceArr) Step -1
          For j = LBound(sourceArr) + 1 To i
                     If ((sourceArr(j - 1, 0) - sourceArr(j, 0) > fuzz) Or _
                     ((sourceArr(j - 1, 0) - sourceArr(j, 0) <= fuzz) And _
                     (sourceArr(j - 1, 1) < sourceArr(j, 1))) And _
                     (sourceArr(j - 1, 0) - sourceArr(j, 0) <= fuzz) And _
                     (sourceArr(j - 1, 1) - sourceArr(j, 1) <= fuzz) And _
                     sourceArr(j - 1, 1) < sourceArr(j, 1)) Then
                    tempPt(0) = sourceArr(j - 1, 0)
                    tempPt(1) = sourceArr(j - 1, 1)
                    tempPt(2) = sourceArr(j - 1, 2)
                    sourceArr(j - 1, 0) = sourceArr(j, 0)
                    sourceArr(j - 1, 1) = sourceArr(j, 1)
                    sourceArr(j - 1, 2) = sourceArr(j, 2)
                    sourceArr(j, 0) = tempPt(0)
                    sourceArr(j, 1) = tempPt(1)
                    sourceArr(j, 2) = tempPt(2)
                    End If
          Next j
          Next i
          
SortPointsLikeTable = sourceArr
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Edited March 14, 2013 by fixo
code edited

[Sundar]

Thanks fixo for your code..it works fine..but the problem is "Selectionsetcrossingpolygon" selects the inner objects in the order as they were drawn.but i need to number the objects sequentially from top left to the right irrespective of the order of the objects they were drawn..

[fixo]

Try edited code above again

[Sundar]

thanks fixo..I tried with the edited code and I would like to understand the importance of "fuzz" variable in the "SortPointsLikeTable" function..As per ur Note in code "Note: Put fuzz variable (15.0) to your suit , say half of height of minimal polygon" ,what does that minimal polygon mean ?? do i have to calculate the height of all the polygons inside ??

 

It actually numbers the outer polygon which is not the desired one..that i can manage and edit the code accordingly. The only thing being tough for me is the numbering of polygons in order.hope u can help me out more ... thanks in advance

[fixo]

I have not have a time to help you further with this simple question,

though you may want to get the shortest height by picking 2 points

on screen then pass this value to the program, nothing else