home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / v8trial / TurboCADv8ProfessionalNoReg.exe / Data.Cab / F38620_Converter.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-30  |  2.9 KB  |  95 lines
  1. Attribute VB_Name = "modConverter"
  2. Global ObjApp As Application
  3. Global Drs As Drawings
  4. Global bConversionRunned As Boolean
  5. Global bInterupt As Boolean
  6. Global sCaption As String
  7. Global isSummInfo As Boolean
  8. 'Global Ftrs As Filters
  9. Global CurCombo As Boolean
  10. Global CurImportFilter As String
  11. Global CurExportFilter As String
  12.  
  13. Declare Function AppGetCurrentApp Lib "DBAPI80.dll" () As Long
  14. Declare Function AppSetupFilter Lib "DBAPI80.dll" (ByVal hApp As Long, ByVal ReadWrite As Boolean, ByVal ext As String, ByVal descr As String) As Boolean
  15. Sub Main()
  16.  
  17. End Sub
  18. 'this function removes duplicates of IDS
  19. Public Function CorrectIDs(ByVal Dr As Drawing)
  20.     On Error GoTo E
  21.     Dim curSpaceMode As ImsiSpaceModeType
  22.     Dim Pss As PaperSpaces
  23.     Dim Ps As PaperSpace
  24.     curSpaceMode = Dr.Properties("TileMode")
  25.     'correct IDs for graphics in blocks table
  26.     Call correctBlockTableIDs(Dr.Blocks)
  27.     Set Pss = Dr.PaperSpaces
  28. ' correct IDs for graphics in PaperSpaces
  29.     For Each Ps In Pss
  30.         Call correctIDGraphic(Ps.Graphics)
  31.     Next
  32. ' correct IDs for graphics in Model spaces
  33.     Set Ps = Nothing
  34.     Set Pss = Nothing
  35.     If curSpaceMode = imsiModelSpace Then
  36.         Call correctIDGraphic(Dr.Graphics)
  37.     Else
  38.         Dr.Properties("TileMode") = imsiModelSpace
  39.         Call correctIDGraphic(Dr.Graphics)
  40.         Dr.Properties("TileMode") = curSpaceMode
  41.     End If
  42.     Exit Function
  43. E:
  44.     MsgBox LoadResString(116), vbOKOnly, "CorectIDS function failed! " & Err.Description
  45. End Function
  46.  
  47. Private Function correctIDGraphic(Grs As Graphics)
  48.     Dim g As Graphic
  49.     Dim g1 As Graphic
  50.     Dim gtmp As Graphic
  51.     Dim grsParent As Graphics
  52.     Dim id As Long
  53.     Dim id1 As Long
  54.     Dim Index As Long
  55.     
  56.     For Each g In Grs
  57.         id = g.id
  58.         g.Deleted = True
  59.         On Error Resume Next
  60.         Set g1 = Grs.GraphicFromID(id)
  61.         Err.Clear
  62.         If Not g1 Is Nothing Then ' And (g <> g1) Then 'Or g.Index <> g1.Index Then
  63.                 g.Deleted = False
  64.                 Set grsParent = g.Parent
  65.                 Index = g.Index
  66.                 Set g = grsParent.Remove(Index)
  67.                 g.id = 0
  68.                 If Index = 0 Then
  69.                     grsParent.AddGraphic g, 0
  70.                 ElseIf (Index = grsParent.Count) Then
  71.                     grsParent.AddGraphic g
  72.                 Else
  73.                     grsParent.AddGraphic g, Index
  74.                 End If
  75. '                If Index <> g.Index Then
  76. '                    MsgBox "ID is not changed"
  77. '                End If
  78.         End If
  79.         g.Deleted = False
  80.         If (g.TypeByValue = imsiGroup) Then
  81.             Call correctIDGraphic(g.Graphics)
  82.         End If
  83.         
  84.         Set g1 = Nothing
  85.         Set g = Nothing
  86.     Next
  87. End Function
  88. Private Function correctBlockTableIDs(Bks As Blocks)
  89.     Dim Bk As Block
  90.     For Each Bk In Bks
  91.         Call correctIDGraphic(Bk.Graphics)
  92.     Next
  93. End Function
  94.  
  95.