Personal Computer World 2002 March/PCWMAR02.iso/software/turbocad/v8trial/TurboCADv8ProfessionalNoReg.exe/Data.Cab/F40632_modSelInfo.bas

BASIC Source File | 2001-10-16 | 8.8 KB | 308 lines

Attribute VB_Name = "modSelInfo"
'******************************************************************'
'*                                                                *'
'*                      TurboCAD for Windows                      *'
'*                   Copyright (c) 1993 - 2001                    *'
'*             International Microcomputer Software, Inc.         *'
'*                            (IMSI)                              *'
'*                      All rights reserved.                      *'
'*                                                                *'
'******************************************************************'

Option Explicit

Const lyrname As String = "_SelInfo"

Public Sub ShowSelForm()
    frmSelInfo.Show
End Sub

Sub ClearInfoLayer()
    On Error Resume Next
    Dim lyr As Layer

    Set lyr = ActiveDrawing.Layers.Item(lyrname)
    If Not lyr Is Nothing Then
        lyr.Clear
    End If
    ActiveDrawing.ActiveView.Refresh
End Sub

Sub PrintInfoToFile(ByVal fname As String, ByVal all As Boolean)
    On Error GoTo BadFile
    Dim sel As Selection
    Dim grs As Graphics
    Dim gfc As Graphic

    Open fname For Output As #1

    On Error Resume Next

    If all Then
        Set grs = ActiveDrawing.Graphics
        For Each gfc In grs
            PrintGraphicInfoToFile gfc, 0
        Next
    Else
        Set sel = ActiveDrawing.Selection
        For Each gfc In sel
            PrintGraphicInfoToFile gfc, 0
        Next
    End If
    Close #1
    MsgBox "File '" & fname & "' saved."
    Exit Sub

BadFile:
    MsgBox "Could not open file '" & fname & "'!"
End Sub

Private Sub PrintGraphicInfoToFile(gfc As Graphic, lvl As Integer)
    On Error Resume Next
    Dim i, count As Integer
    Dim s As String

    Print #1, ""
    Print #1, "--------"
    Print #1, "Graphic At Level " & lvl & ":"
    Print #1, "   ID " & gfc.ID
    Print #1, " Name " & gfc.Name
    Print #1, " Type " & gfc.Type
    s = "<Err>"
    s = gfc.RegenType
    Print #1, "Regen " & s
    s = ""
    If gfc.Builtin Then s = s & "Bilt "
    If gfc.Closed Then s = s & "Clsd "
    If gfc.Cosmetic Then s = s & "Cosm "
    If gfc.Deleted Then s = s & "Dele "
    If gfc.Editable Then s = s & "Edit "
    If gfc.Unbounded Then s = s & "Ubnd "
    If gfc.Visible Then s = s & "Vis  "
    Print #1, "Flags " & s

    count = gfc.Vertices.count
    Print #1, ""
    Print #1, "      " & count & " Vertices:"
    Dim vtx As Vertex
    For i = 0 To count - 1
        Set vtx = gfc.Vertices(i)
        Print #1,
        Print #1, "[" & i & "] at (" & vtx.x & ", " & vtx.y & ", " & vtx.z & ")"
        s = ""
        If vtx.PenDown Then s = s & "Down " Else s = s & "Up   "
        If vtx.Bulge Then s = s & "Blge "
        If vtx.Calculated Then s = s & "Calc "
        If vtx.Editable Then s = s & "Edit "
        If vtx.Linkable Then s = s & "Link "
        If vtx.Selectable Then s = s & "Sel  "
        If vtx.Snappable Then s = s & "Snap "
        Print #1, "Flags " & s
    Next i

    Print #1, ""
    PrintPropertiesToFile gfc.Properties

    Dim blk As Block
    Set blk = gfc.Block
    If Not blk Is Nothing Then
        s = blk.Name
        Print #1, ""
        Print #1, "      Block: " & s
        Set vtx = blk.Anchor
        Print #1,
        Print #1, "Anchor at (" & vtx.x & ", " & vtx.y & ", " & vtx.z & ")"
        count = blk.Graphics.count
        Print #1, ""
        Print #1, "      " & count & " Children:"
        For i = 0 To count - 1
            PrintGraphicInfoToFile blk.Graphics(i), lvl + 1
        Next i
        Print #1, "      End Block"
    End If

    'Sanity check
    If lvl > 4 Then Exit Sub

    count = gfc.Graphics.count
    Print #1, ""
    Print #1, "      " & count & " Children:"
    For i = 0 To count - 1
        PrintGraphicInfoToFile gfc.Graphics(i), lvl + 1
    Next i
End Sub


Sub DrawVertices(ByVal all As Boolean)
    Dim sel As Selection
    Dim grs As Graphics
    Dim gfc As Graphic
    Dim bbox As BoundingBox
    Dim sclX, sclY As Double

    If all Then
        Set grs = ActiveDrawing.Graphics
        For Each gfc In grs
            Set bbox = gfc.CalcBoundingBox
            sclX = Abs(bbox.Max.x - bbox.Min.x)
            sclY = Abs(bbox.Max.y - bbox.Min.y)
            If sclX < sclY Then sclX = sclY
            DrawGraphicVertices gfc, 0, sclX
        Next
    Else
        Set sel = ActiveDrawing.Selection
        For Each gfc In sel
            Set bbox = gfc.CalcBoundingBox
            sclX = Abs(bbox.Max.x - bbox.Min.x)
            sclY = Abs(bbox.Max.y - bbox.Min.y)
            If sclX < sclY Then sclX = sclY
            DrawGraphicVertices gfc, 0, sclX
        Next
    End If
End Sub

Private Sub DrawGraphicVertices(gfc As Graphic, lvl As Integer, ByVal scl As Double)
    On Error Resume Next
    Dim i, count As Integer
    Dim s As String
    Dim r, x, y, z As Double
    Dim lyr As Layer
    Dim vtx As Vertex
    Dim gi, gr1, gr2 As Graphic

    'Find or create special layer
    Set lyr = gfc.Drawing.Layers.Item(lyrname)
    If lyr Is Nothing Then
        Set lyr = gfc.Drawing.Layers.Add(lyrname)
    End If

    If lyr Is Nothing Then
        MsgBox "Couldn't access layer '" & lyrname & "'"
        Exit Sub
    End If

    Set gi = lyr.Add
    If gi Is Nothing Then
        MsgBox "Couldn't add graphic to layer"
        Exit Sub
    End If

    r = scl * 0.125
    z = (-lvl - 1) * scl / 4
    count = gfc.Vertices.count
    Set gr2 = lyr.Add
    For i = 0 To count - 1
        Set vtx = gfc.Vertices(i)
        x = vtx.x
        y = vtx.y
        Set gr1 = lyr.AddCircle(x, y, z)
        gr2.Vertices.Add x, y, z
    Next
    gr2.Properties("PenColor") = &HFF00

    'Sanity check
    If lvl > 4 Then Exit Sub

    count = gfc.Graphics.count
    For i = 0 To count - 1
        lvl = lvl + 1
        DrawGraphicVertices gfc.Graphics(i), lvl, scl
    Next
End Sub

Public Sub DebugPrintSelInfo()
    DebugPrintInfo False
End Sub

Sub DebugPrintInfo(ByVal all As Boolean)
    On Error Resume Next
    Dim sel As Selection
    Dim grs As Graphics
    Dim gfc As Graphic

    If all Then
        Set grs = ActiveDrawing.Graphics
        For Each gfc In grs
            DebugPrintGraphicInfo gfc, 0
        Next
    Else
        Set sel = ActiveDrawing.Selection
        For Each gfc In sel
            DebugPrintGraphicInfo gfc, 0
        Next
    End If
End Sub

Private Sub DebugPrintGraphicInfo(gfc As Graphic, lvl As Integer)
    On Error Resume Next
    Dim i, count As Integer
    Dim s As String

    Debug.Print ""
    Debug.Print "--------"
    Debug.Print "Graphic At Level " & lvl & ":"
    Debug.Print "   ID " & gfc.ID
    Debug.Print " Name " & gfc.Name
    Debug.Print " Type " & gfc.Type
    s = "<Err>"
    s = gfc.RegenType
    Debug.Print "Regen " & s
    s = ""
    If gfc.Builtin Then s = s & "Bilt "
    If gfc.Closed Then s = s & "Clsd "
    If gfc.Cosmetic Then s = s & "Cosm "
    If gfc.Deleted Then s = s & "Dele "
    If gfc.Editable Then s = s & "Edit "
    If gfc.Unbounded Then s = s & "Ubnd "
    If gfc.Visible Then s = s & "Vis  "
    Debug.Print "Flags " & s

    count = gfc.Vertices.count
    Debug.Print ""
    Debug.Print "      " & count & " Vertices:"
    Dim vtx As Vertex
    For i = 0 To count - 1
        Set vtx = gfc.Vertices(i)
        Debug.Print
        Debug.Print "[" & i & "] at (" & vtx.x & ", " & vtx.y & ", " & vtx.z & ")"
        s = ""
        If vtx.PenDown Then s = s & "Down " Else s = s & "Up   "
        If vtx.Bulge Then s = s & "Blge "
        If vtx.Calculated Then s = s & "Calc "
        If vtx.Editable Then s = s & "Edit "
        If vtx.Linkable Then s = s & "Link "
        If vtx.Selectable Then s = s & "Sel  "
        If vtx.Snappable Then s = s & "Snap "
        Debug.Print "Flags " & s
    Next i

    Dim blk As Block
    Set blk = gfc.Block
    If Not blk Is Nothing Then
        s = blk.Name
        Debug.Print ""
        Debug.Print "      Block: " & s
        Set vtx = blk.Anchor
        Debug.Print
        Debug.Print "Anchor at (" & vtx.x & ", " & vtx.y & ", " & vtx.z & ")"
        count = blk.Graphics.count
        Debug.Print ""
        Debug.Print "      " & count & " Children:"
        For i = 0 To count - 1
            DebugPrintGraphicInfo blk.Graphics(i), lvl + 1
        Next i
        Debug.Print "      End Block"
    End If

    'Sanity check
    If lvl > 4 Then Exit Sub

    count = gfc.Graphics.count
    Debug.Print ""
    Debug.Print "      " & count & " Children:"
    For i = 0 To count - 1
        DebugPrintGraphicInfo gfc.Graphics(i), lvl + 1
    Next i
End Sub