home *** CD-ROM | disk | FTP | other *** search
/ The Houseplan Collection / HRCD2005.ISO / data1.cab / Zusatz / 3DS / DATA2.Z / Dialog.frm < prev    next >
Text File  |  1999-04-30  |  4KB  |  117 lines
  1. VERSION 5.00
  2. Begin VB.Form Dialog 
  3.    Caption         =   "Beispiel fⁿr eine Dach-Holzkonstruktion"
  4.    ClientHeight    =   1875
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   5640
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   1875
  10.    ScaleWidth      =   5640
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton CreateRoof 
  13.       Caption         =   "Dach erzeugen!"
  14.       Height          =   555
  15.       Left            =   1440
  16.       TabIndex        =   0
  17.       Top             =   1080
  18.       Width           =   2655
  19.    End
  20.    Begin VB.Label Label1 
  21.       Caption         =   $"Dialog.frx":0000
  22.       Height          =   495
  23.       Left            =   120
  24.       TabIndex        =   1
  25.       Top             =   120
  26.       Width           =   5415
  27.    End
  28. End
  29. Attribute VB_Name = "Dialog"
  30. Attribute VB_GlobalNameSpace = False
  31. Attribute VB_Creatable = False
  32. Attribute VB_PredeclaredId = True
  33. Attribute VB_Exposed = False
  34. Option Explicit
  35.  
  36. Dim prg As New ArCon.ArCon
  37.  
  38. Private Sub CreateRoof_Click()
  39.     ' Makro mit ArCon verbinden
  40.     prg.StartMe hWnd, ""
  41.     
  42.     ' Testen, ob ein Projekt geladen ist
  43.     If prg.Mode = AC_NoMode Then
  44.         ' Kein Projekt geladen, wir brauchen ein neues
  45.         prg.CreateProject prg.NewProject
  46.     End If
  47.     
  48.     ' In den Konstruktionsmodus schalten
  49.     prg.Mode = AC_ModeConstruct
  50.     
  51.     ' Neue Dachkonstruktion beginnen
  52.     Dim constr As ArCon.RoofConstruction
  53.     Set constr = prg.NewRoofConstruction
  54.     
  55.     With constr
  56.         ' erste DachflΣchen definieren
  57.         .BeginNewArea ACDACH_FlaecheEindeckung
  58.         .AddPoint 0, 0, 0
  59.         .AddPoint 10, 0, 0
  60.         .AddPoint 10, 4, 4
  61.         .AddPoint 0, 4, 4
  62.         
  63.         ' zweite DachflΣchen definieren
  64.         .BeginNewArea ACDACH_FlaecheEindeckung
  65.         .AddPoint 10, 8, 0
  66.         .AddPoint 0, 8, 0
  67.         .AddPoint 0, 4, 4
  68.         .AddPoint 10, 4, 4
  69.         
  70.         ' Balken erzeugen
  71.         Dim i As Integer, dx As Double
  72.         Const PI As Double = 3.1415926
  73.         Const TexDirX As Double = 0
  74.         Const TexDirY As Double = 45 * PI / 180
  75.         Const TexDirZ As Double = 90 * PI / 180
  76.         Const dBreite As Double = 0.08
  77.         Const dDicke As Double = 0.16
  78.         Const dAbstand As Double = 0.8
  79.         dx = 0
  80.         For i = 1 To 10
  81.             ' Neuer Sparren (der Name ist optional)
  82.             .NewRafter ACRWOOD_Sparren, "Sparren", dBreite, dDicke
  83.             ' Ausrichtung festlegen
  84.             .RafterSetGeo ACRAFTER_TextureDir, TexDirX, TexDirY, TexDirZ
  85.             ' Erster Eckpunkt
  86.             .RafterSetGeo ACRAFTER_Left1, dx + 0.2, 0, 0
  87.             .RafterSetGeo ACRAFTER_Right1, dx + 0.28, 0, 0
  88.             ' Zweiter Eckpunkt
  89.             .RafterSetGeo ACRAFTER_Left1, dx + 0.2, 4, 4
  90.             .RafterSetGeo ACRAFTER_Right1, dx + 0.28, 4, 4
  91.             ' Dritter Eckpunkt
  92.             .RafterSetGeo ACRAFTER_Left1, dx + 0.2, 4, 4 - 0.16 / 0.707
  93.             .RafterSetGeo ACRAFTER_Right1, dx + 0.28, 4, 4 - 0.16 / 0.707
  94.             ' Vierter Eckpunkt
  95.             .RafterSetGeo ACRAFTER_Left1, dx + 0.2, 0, 0 - 0.16 / 0.707
  96.             .RafterSetGeo ACRAFTER_Right1, dx + 0.28, 0, 0 - 0.16 / 0.707
  97.             
  98.             dx = dx + dAbstand
  99.         Next
  100.         
  101.         ' Analyse der Geometrie durchfⁿhren (ohne automatische Unterfⁿllung)
  102.         .Analyze False
  103.         
  104.         ' Alles klar?
  105.         If .Fehler <> "" Then
  106.             MsgBox .Fehler
  107.         Else
  108.             ' Die Konstruktion ist vollstΣndig - Dach erzeugen
  109.             .CreateRoof prg.CurrentStory
  110.         End If
  111.     End With
  112.     Set constr = Nothing
  113.     
  114.     ' Fertig, Makro Verbindung zu ArCon terminieren
  115.     prg.EndMe
  116. End Sub
  117.