Quantcast
Channel: MicroStation Programming - Forum - Recent Threads
Viewing all articles
Browse latest Browse all 1677

Re: Export coordinates from elements (cells)

$
0
0

Hope that helps;-)

Private Function GetRowColumnFromPoint(ByRef row As Integer, ByRef column As Integer, p As Point3d) As Boolean

   Dim gridorigin As Point3d

   Dim gridraster As Point2d

   Dim column_double As Double

   Dim row_double As Double

   'Set Grid Origin and Raster manually

   gridorigin.X = 463600.001

   gridorigin.Y = 326400.001

   gridraster.X = 12000

   gridraster.Y = 12000

   column_double = -1 * (p.X - gridorigin.X) / gridraster.X

   column = Int((column_double)) + 1

   row_double = -1 * (p.Y - gridorigin.Y) / gridraster.Y

   row = Int((row_double)) + 1

   GetRowColumnFromPoint = True

End Function

Private Function GetRowNameFromRowIndex(i As Integer) As String

   GetRowNameFromRowIndex = Chr(i + 64)

End Function

Public Sub OpenFile(f As String)

Open f For Output As #1

End Sub

Public Function WriteDataToFile(s As String, row As String, column As Integer)

Dim t As String

t = s + ";" + row + ";" + CStr(column)

Print #1, t

End Function

Public Function CloseFile() As Boolean

Close #1

End Function

Public Sub WriteOutCellsInGrid()

   Dim enu As ElementEnumerator

   Dim sc As ElementScanCriteria

   Dim el As Element

   Dim p As Point3d

   Dim row As Integer

   Dim column As Integer

   Dim rowname As String

   OpenFile "C:\temp\data.txt"

   Set sc = New ElementScanCriteria

   sc.ExcludeAllTypes

   sc.IncludeType msdElementTypeCellHeader

   Set enu = ActiveModelReference.Scan(sc)

   Do While enu.MoveNext

       Set el = enu.Current

       'THIS SHOULD BE ALWAYS A CELL

       If el.AsCellElement.Name <> "" Then

           p = el.AsCellElement.Origin

           Debug.Print el.AsCellElement.Name + "   KOORD: X:" + CStr(p.X) + "  Y:" + CStr(p.Y)

           GetRowColumnFromPoint row, column, p

           rowname = GetRowNameFromRowIndex(row)

           Debug.Print el.AsCellElement.Name + "   ROW:" + rowname + "  COLUMN:" + CStr(column)

           WriteDataToFile el.AsCellElement.Name, rowname, column

       Else

           'SOME CELL THAT ARE NOT INTERSTING

       End If

   Loop

   CloseFile

End Sub


Viewing all articles
Browse latest Browse all 1677

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>