home *** CD-ROM | disk | FTP | other *** search
/ The Houseplan Collection / HRCD2005.ISO / data1.cab / Zusatz / 3DS / DATA2.Z / SnapAnd3DEvents.frm < prev    next >
Text File  |  1999-10-08  |  8KB  |  210 lines
  1. VERSION 5.00
  2. Begin VB.Form SnapAnd3DEvents 
  3.    Caption         =   "Schnappende Objekte & 3D Ereignisse"
  4.    ClientHeight    =   3195
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4680
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   3195
  10.    ScaleWidth      =   4680
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.ListBox Ausgabe 
  13.       Height          =   2985
  14.       Left            =   120
  15.       TabIndex        =   0
  16.       Top             =   120
  17.       Width           =   4455
  18.    End
  19. End
  20. Attribute VB_Name = "SnapAnd3DEvents"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = False
  23. Attribute VB_PredeclaredId = True
  24. Attribute VB_Exposed = False
  25. Option Explicit
  26.  
  27. ' Falls dieses Programm im VB Debugger lΣuft, wird App.Path nicht auf das
  28. ' ben÷tigte Verzeichnis mit der ACO Datei zeigen, dann wird ersatzweise
  29. ' dieser Pfad benutzt:
  30. Const defaultPath As String = "\ArCon-SPU\Demos\Visual Basic\Schnappen3D"
  31.  
  32. ' Name des geladenen schnappenden Demo-Objektes
  33. Const acoName As String = "BendedCyl.ACO"
  34.  
  35. Dim WithEvents theExe As ArCon.ArCon
  36. Attribute theExe.VB_VarHelpID = -1
  37.  
  38. ' Kleine Demo-Situation aufbauen, um das Schnappen prⁿfen zu k÷nnen
  39. Private Sub Form_Load()
  40.     Set theExe = New ArCon.ArCon
  41.     theExe.StartMe hWnd, ""
  42.     
  43.     ' Wir brauchen ein Projekt
  44.     If theExe.Mode = AC_NoMode Then
  45.         theExe.CreateProject theExe.NewProject
  46.     End If
  47.     theExe.Mode = AC_ModeConstruct
  48.     
  49.     ' Eine Wand in der NΣhe des Ursprungs aufbauen
  50.     Dim w As ArCon.Wall
  51.     theExe.CurrentStory.PlaceWall theExe.NewWall(0), -1, -1, -1, 1
  52.     
  53.     ' Weiter im Einrichtungsmodus
  54.     theExe.Mode = AC_ModeDesign
  55.     
  56.     ' Ein ACO Objekt laden
  57.     Dim c As ObjectConstructor
  58.     Set c = theExe.LoadObjectConstructor(App.Path & "\" & acoName, ACO_DURATION_CACHEABLE)
  59.     If c Is Nothing Then
  60.         Set c = theExe.LoadObjectConstructor(defaultPath & "\" & acoName, ACO_DURATION_CACHEABLE)
  61.     End If
  62.     
  63.     ' Eine Instanz des ACO Objektes erzeugen und am Ursprung einfⁿgen
  64.     Dim i As Object3D
  65.     Set i = c.Create(Nothing, False)
  66.     i.InsertIntoWorld False
  67.     
  68.     ' Allgemeine Fangeinstellungen:
  69.     Const snapFlags As Long = ACDMSB_anWaenden _
  70.                          Or ACDMSB_anKonstruktionsobjekten _
  71.                          Or ACDMSB_anDesignobjekten _
  72.                          Or ACDMSB_anGruppen _
  73.                          Or ACDMSB_anFlaechen _
  74.                          Or ACDMSB_anKanten _
  75.                          Or ACDMSB_anEcken _
  76.                          Or ACDMSB_GruppenBeimVerschieben
  77.     theExe.SetDesignModeSnapSettings True, 25, Deg2Rad(45), snapFlags
  78.  
  79.     ' Ein Fangobjekt zu diesem ACO erstellen (das ist natⁿrlich Objektspezifisch)
  80.     ' und mit dem ACO verbinden
  81.     Dim s As SnapObject
  82.     Set s = theExe.NewSnapObject
  83.     CreateSnapObject s
  84.     i.InitSnapObject s, False
  85.     
  86.     ' Alles sichtbar machen
  87.     theExe.ShowAll
  88.     
  89.     ' Soweit dieser Teil - wir wollen aber noch alles m÷gliche ⁿber 3D Objekte
  90.     ' mitgeteilt bekommen:
  91.     theExe.SetObject3DEventMask i, ACO3D_EVENT_DBLCLK Or ACO3D_EVENT_MOVED Or ACO3D_EVENT_TEXTURE_DROPPED Or ACO3D_EVENT_MATERIAL_DROPPED
  92.     
  93.     ' Und neue 3D Objekte:
  94.     Dim oldTypeMask As Long
  95.     theExe.ChangeTypeNotifyMask AC_OBJTYPE_Object3D, AC_CHANGE_Inserted, 0, oldTypeMask
  96. End Sub
  97.  
  98. ' Gr÷▀e anpassen
  99. Private Sub Form_Resize()
  100.     If ScaleWidth < 20 Then Exit Sub
  101.     If ScaleHeight < 20 Then Exit Sub
  102.     Ausgabe.Left = 10
  103.     Ausgabe.Top = 10
  104.     Ausgabe.Width = ScaleWidth - 20
  105.     Ausgabe.Height = ScaleHeight - 20
  106. End Sub
  107.  
  108. ' AufrΣumen, wenn das Programm beendet wird
  109. Private Sub Form_Unload(Cancel As Integer)
  110.     If Not theExe Is Nothing Then
  111.         theExe.EndMe
  112.         Set theExe = Nothing
  113.     End If
  114. End Sub
  115.  
  116. ' Ein neues Objekt wurde vom Benutzer in die Welt eingefⁿgt - auch dafⁿr
  117. ' Events anmelden
  118. Private Sub theExe_Object3DInserted(ByVal obj As ArCon.Object3D, ByVal SnapWallSeg As ArCon.WallSegment, ByVal SnapObj As ArCon.Object3D, Position As Variant, PositionChanged As Boolean)
  119.     Dim s As String
  120.     s = "Neues Objekt eingefⁿgt: '" & obj.Name & "'"
  121.     Ausgabe.AddItem s
  122.     Debug.Print s
  123.     theExe.SetObject3DEventMask obj, ACO3D_EVENT_DBLCLK Or ACO3D_EVENT_MOVED Or ACO3D_EVENT_TEXTURE_DROPPED Or ACO3D_EVENT_MATERIAL_DROPPED
  124.     Dim i As Integer, j As Integer
  125.     For i = 0 To 3
  126.         For j = 0 To 3
  127.             Dim o As String
  128.             Debug.Print Left(Format(Position(j, i), "#,##0.000") & Space(10), 8); " ";
  129.         Next
  130.         Debug.Print
  131.     Next
  132.     ' Hier kann die Einfⁿgeposition noch beeinflu▀t werden:
  133.     ' eine halben Meter in X Richtung verschieben
  134.     Position(0, 3) = Position(0, 3) + 0.5
  135.     PositionChanged = True  ' nur mit dieser Zuweisung wird die Matrix ⁿbernommen!
  136. End Sub
  137.  
  138. ' Wenn ArCon beendet wird, Verbindung abbauen und uns selbst beenden
  139. Private Sub theExe_ProgramExit()
  140.     If Not theExe Is Nothing Then
  141.         theExe.EndMe
  142.         Set theExe = Nothing
  143.     End If
  144.     Unload Me
  145. End Sub
  146.  
  147. ' Erzeuge ein Snap-Objekt zu unserem Beispiel-ACO
  148. Private Sub CreateSnapObject(ByRef snap As ArCon.SnapObject)
  149.     With snap
  150.         .SetBoundingBox 0.2, -0.213, -0.2, -0.213, 0.213, 0.213
  151.         .AddPoint 0.2, 0, 0, AC_SNAP_P_USE_DIR1, -1, 0, 0, 0, 0, 0, _
  152.             &HFFFFFFFF, &HFFFFFFFF, 0
  153.         .AddArea _
  154.             -0.2, -0.2, -0.2, _
  155.             -0.2, -0.2, 0.2, _
  156.             -0.2, 0.2, 0.2, _
  157.             -0.2, 0.2, -0.2, _
  158.             AC_SNAP_A_ISQUAD Or AC_SNAP_A_ISTWOSIDED Or AC_SNAP_A_SNAP_E0 Or AC_SNAP_A_SNAP_E1 Or AC_SNAP_A_SNAP_E2 Or AC_SNAP_A_SNAP_E3, _
  159.             &HFFFFFFFF, &HFFFFFFFF, 0
  160.     End With
  161. End Sub
  162.  
  163. ' Grad in Bogenma▀ konvertieren
  164. Private Function Deg2Rad(deg As Single) As Single
  165.     Deg2Rad = deg / 180 * 3.1415926
  166. End Function
  167.  
  168. ' Ein Objekt wurde doppeltgeklickt
  169. Private Sub theExe_WorldObject3DDoubleClicked(ByVal selObj As ArCon.Object3D, ByVal clickedObj As ArCon.Object3D, ByVal objectPartID As Long, Modified As Boolean)
  170.     Dim s As String
  171.     s = "Das Objekt '" & clickedObj.Name & "' wurd doppeltgeklickt, selektiert ist '" & selObj.Name & "'"
  172.     Debug.Print s
  173.     Ausgabe.AddItem s
  174. End Sub
  175.  
  176. ' Ein Material wurde gedropped
  177. Private Sub theExe_WorldObject3DMaterialDropped(ByVal obj As ArCon.Object3D, ByVal evnt As Long, ByVal hitX As Single, ByVal hitY As Single, ByVal hitZ As Single, ByVal pickedMat As ArCon.Material, ByVal objectPartID As Long, ByVal oldMat As ArCon.Material, ByVal newMat As ArCon.Material, mayDrop As Boolean)
  178.     Dim s As String
  179.     If (evnt And AC_DRAG_N_DROP_DROP) = 0 Then Exit Sub    ' ist nur Drag-Over, noch kein Drop
  180.     s = "Beim Objekt '" & obj.Name & "' wurde im Objektteil " & objectPartID & " das Material ausgetauscht"
  181.     Ausgabe.AddItem s
  182.     Debug.Print s
  183. End Sub
  184.  
  185. ' Ein Objekt wurde bewegt - Anzeigen und Matrix in der Debug-Ausgabe ausgeben
  186. Private Sub theExe_WorldObject3DMoved(ByVal obj As ArCon.Object3D, ByVal snappingWallSeg As ArCon.WallSegment, ByVal snappingObject As ArCon.Object3D, ByVal MC_WC As Variant)
  187.     Dim s As String
  188.     s = "Das Objekt '" & obj.Name & "' wurde bewegt"
  189.     Debug.Print s
  190.     Ausgabe.AddItem s
  191.     
  192.     Dim i As Integer, j As Integer
  193.     For i = 0 To 3
  194.         For j = 0 To 3
  195.             Dim o As String
  196.             Debug.Print Left(Format(MC_WC(j, i), "#,##0.000") & Space(10), 8); " ";
  197.         Next
  198.         Debug.Print
  199.     Next
  200. End Sub
  201.  
  202. ' Eine Textur wurde gedropped
  203. Private Sub theExe_WorldObject3DTextureDropped(ByVal obj As ArCon.Object3D, ByVal evnt As Long, ByVal hitX As Single, ByVal hitY As Single, ByVal hitZ As Single, ByVal pickedMat As ArCon.Material, ByVal objectPartID As Long, ByVal oldTexName As String, ByVal newTexName As String, mayDrop As Boolean)
  204.     Dim s As String
  205.     If (evnt And AC_DRAG_N_DROP_DROP) = 0 Then Exit Sub    ' ist nur Drag-Over, noch kein Drop
  206.     s = "Beim Objekt '" & obj.Name & "' wurd im Objektteil " & objectPartID & " die Textur '" & oldTexName & "' durch '" & newTexName & "' ersetzt"
  207.     Debug.Print s
  208.     Ausgabe.AddItem s
  209. End Sub
  210.