home *** CD-ROM | disk | FTP | other *** search
/ The Houseplan Collection / HRCD2005.ISO / data1.cab / Zusatz / 3DS / DATA2.Z / TopoColMain.bas < prev    next >
BASIC Source File  |  1999-05-17  |  7KB  |  182 lines
  1. Attribute VB_Name = "TopoColMain"
  2. ' ----------------------------------------------------------------------------
  3. ' MS Visual Basic Demo-Programm zur Demonstration der ActiveX-FΣhigkeit
  4. ' von ArCon(+).
  5. '
  6. ' Der abgebildete Code dient lediglich Demonstrationszwecken.
  7. ' Es wird keinerlei Garantie fⁿr die Richtigkeit und/oder
  8. ' FunktionsfΣhigkeit ⁿbernommen. Bei Fragen wenden Sie sich bitte an
  9. '
  10. '    mb-Programme
  11. '    Software im Bauwesen GmbH
  12. '    Hermannstra▀e 1
  13. '    D-31785 Hameln
  14. '    e-mail:  arcon@mb-software.de
  15. '    Internet http://www.mb-software.de
  16. '
  17. ' ----------------------------------------------------------------------------
  18. '  TopoCol - einfache topologische Analyse und farbliche Hervorhebung
  19. '            der Ergebnisse im Konstruktionsmodus
  20. '  Demonstriert:
  21. '            Setzen der Raum- und Wandschraffuren sowie (Linien-)farben
  22. '  Anwendung:
  23. '            Sucht in einem geladenenen Projekt (nur im aktuellen Stockwerk)
  24. '            nach Au▀enwΣnden und DurchgangsrΣumen. Diese werden farblich
  25. '            markiert.
  26. ' ----------------------------------------------------------------------------
  27.  
  28. Option Explicit
  29.  
  30. ' Wir ben÷tigen ein Objekt zur Kommunikation mit der ArCon-EXE,
  31. ' hier genⁿgt eine einfache Befehlsverbindung ohne Ereignisverarbeitung:
  32. Dim exe As New ArCon.ArCon
  33.  
  34. ' ----------------------------------------------------------------------------
  35. ' Hauptprogramm:
  36. '            Erstellt eine Verbindung zu ArCon und druchlΣuft alle WΣnde und
  37. '            RΣume im aktuellen Stockwerk. Ruft fⁿr jede Wand/jeden Raum eine
  38. '            entsprechende Analysefunktion auf.
  39. Sub Main()
  40.     Dim w As ArCon.Wall, r As ArCon.Room
  41.  
  42.     exe.StartMe 0, ""
  43.     
  44.     ' Nur wenn wir ein aktuelles Stockwerk haben (also ein Projekt
  45.     ' geladen ist)
  46.     If Not exe.CurrentStory Is Nothing Then
  47.         ' Alle WΣnde untersuchen
  48.         For Each w In exe.CurrentStory.Walls
  49.             CheckWall w
  50.         Next
  51.         ' Alle RΣume untersuchen
  52.         For Each r In exe.CurrentStory.Rooms
  53.             CheckRoom r
  54.         Next
  55.     End If
  56.     
  57.     exe.EndMe
  58. End Sub
  59.  
  60. ' ----------------------------------------------------------------------------
  61. ' Teste, ob diese Wand eine Au▀enwand ist. Wenn ja, markiere
  62. ' sie durch eine entsprechende Schraffur und Σndere die Linienfarbe
  63. ' der Au▀ensegmente
  64. Sub CheckWall(theWall As ArCon.Wall)
  65.     Dim seg As ArCon.WallSegment
  66.     Dim found As Boolean
  67.     
  68.     found = False
  69.     For Each seg In theWall.WallSegments
  70.         If seg.Visible And seg.Room Is Nothing Then
  71.             ' Dies ist ein Segment an der Au▀enseite des GebΣudes
  72.             seg.SetLineColor RGB(0, 0, 255)
  73.             found = True
  74.         End If
  75.     Next
  76.     If found Then
  77.         ' gesamte Wand schraffieren
  78.         theWall.SetHatchStyle ACHS_FDIAGONAL, RGB(0, 0, 255)
  79.     End If
  80. End Sub
  81.  
  82. ' ----------------------------------------------------------------------------
  83. ' Teste, ob dieser Raum ein Durchgangsraum ist. Wenn ja, schraffiere
  84. ' ihn.
  85. ' Der Einfachheit halber zΣhlen wir einen Raum als Durchgangsraum, wenn
  86. ' er Verbindungen (sprich: Tⁿr oder Treppenhaus) zu mindestens zwei
  87. ' verschiedenen anderen RΣumen hat
  88. Sub CheckRoom(theRoom As ArCon.Room)
  89.     Dim otherRoom As Long   ' ID eines anderen Raumes
  90.     Dim testRoom As Long
  91.     Dim storyBelow As ArCon.Story
  92.     Dim st As ArCon.StairCase
  93.     Dim r As ArCon.Room
  94.     Dim c As ArCon.Contur
  95.     Dim seg As ArCon.WallSegment
  96.     Dim d As ArCon.Door
  97.     Dim x As Single, y As Single
  98.     Dim found As Boolean
  99.     
  100.     otherRoom = 0   ' bisher kein anderer Raum gefunden
  101.     found = False   ' bisher kein Durchgangsraum
  102.     
  103.     ' ZunΣchst die Treppen suchen
  104.     For Each st In theRoom.Story.Stairs
  105.         With st
  106.             x = (.X1 + .X2 + .X3) / 3
  107.             y = (.Y1 + .Y2 + .Y3) / 3
  108.             Set r = theRoom.Story.FindRoom(x, y)
  109.             If r Is theRoom Then
  110.                 ' Der Raum hat eine Treppe: es ist ein Durchgangsraum
  111.                 found = True
  112.                 Exit For
  113.             End If
  114.         End With
  115.     Next
  116.     
  117.     ' Nichts ist einfach in der "wahren Welt": wir mⁿssen auch
  118.     ' Treppen im Stockwerk unter dem aktuellen betrachten, falls sie
  119.     ' von unten eine Verbindung zu diesem Raum herstellen
  120.     If Not found Then
  121.         Set storyBelow = FindStoryBelow(theRoom.Story)
  122.         If Not storyBelow Is Nothing Then
  123.             For Each st In storyBelow.Stairs
  124.                 With st
  125.                     x = (.X1 + .X2 + .X3) / 3
  126.                     y = (.Y1 + .Y2 + .Y3) / 3
  127.                     Set r = theRoom.Story.FindRoom(x, y)
  128.                     If r Is theRoom Then
  129.                         ' Der Raum hat eine Treppe: es ist ein Durchgangsraum
  130.                         found = True
  131.                         Exit For
  132.                     End If
  133.                 End With
  134.             Next
  135.         End If
  136.     End If
  137.     
  138.     ' Falls wir noch nicht sicher sind...
  139.     If Not found Then
  140.         ' alle Tⁿren in allen Konturen untersuchen
  141.         For Each c In theRoom.Conturs
  142.             For Each seg In c.WallSegments
  143.                 For Each d In seg.Doors
  144.                     ' Ermittle die ID des Raumes auf der anderen Seite der Tⁿr
  145.                     If d.LeftSegment.Room Is theRoom Then
  146.                         testRoom = d.RightSegment.Room.id
  147.                     ElseIf d.RightSegment.Room Is theRoom Then
  148.                         testRoom = d.LeftSegment.Room.id
  149.                     End If
  150.                     ' Entweder dies ist der erste andere Raum oder es mu▀ der
  151.                     ' gleiche sein, ansonsten ist dies ein Durchgangsraum
  152.                     If otherRoom = 0 Then
  153.                         otherRoom = testRoom
  154.                     ElseIf otherRoom <> testRoom Then
  155.                         found = True
  156.                         Exit For
  157.                     End If
  158.                 Next
  159.                 If found Then Exit For
  160.             Next
  161.             If found Then Exit For
  162.         Next
  163.     End If
  164.     
  165.     If found Then
  166.         ' Durchgangsraum: schraffieren
  167.         theRoom.SetHatchStyle ACHS_BDIAGONAL, RGB(0, 255, 0)
  168.     End If
  169. End Sub
  170.  
  171. ' ----------------------------------------------------------------------------
  172. ' Finde das Stockwerk unter dem ⁿbergebenen Stockwerk
  173. Function FindStoryBelow(aStory As ArCon.Story) As ArCon.Story
  174.     Dim s As ArCon.Story, old As ArCon.Story
  175.     Set old = Nothing
  176.     For Each s In exe.CurrentBuilding.Stories
  177.         If s Is aStory Then Exit For
  178.         Set old = s
  179.     Next
  180.     Set FindStoryBelow = old
  181. End Function
  182.