FastFiber
Menu

Toon bijdragen

Deze sectie stelt je in staat om alle bijdragen van dit lid te bekijken. Je kunt alleen de bijdragen zien waar je op dit moment toegang toe hebt.

Toon bijdragen Menu

Berichten - Avatar

#1
VBA / Re: Macro uitbreiden van 2D naar 3D help
zo 03 01 2016, 08:00:20
Dit heeft mij inderdaad verder geholpen.
Ik heb deze aan een userform gelinkt en hier en daar wat aangepast.

Ik wil deze nog verder uitwerken door wat variabelen er bij te steken zoal slededikte,voetje ,verdiepdikte.
Ik wil deze ook nog roteren zodat de trap recht op het X Y vlak staat.

maar dat zal nog even zoeken zijn hoor.

Wat is het verschil eigenlijk tussen VBA en Lisp?
#2
VBA / Re: Macro uitbreiden van 2D naar 3D help
vr 01 01 2016, 17:52:45
Ik Heb de vba wat aangepast maar krijg nu een foutmelding.
Run time Error 438


Public Sub trap()
UserForm1.show
End Sub
Private Sub CheckBox1_Click()

End Sub

'werken met totaal niveauverschil
Private Sub tb_niveauverschil_change()
    tb_optrede.Text = tb_niveauverschil.Value / tb_aantaltreden.Value
   
End Sub
Private Sub tb_aantaltreden_change()
    tb_optrede.Text = tb_niveauverschil.Value / tb_aantaltreden.Value
   
End Sub
Private Sub b_reset_Click()
    UserForm1.Hide
   
End Sub
Private Sub voet_Click()
    If (voet = True) Then
        tb_hoogtevoet.Enabled = True
        tb_breedtevoet.Enabled = True
    End If
       
    If (voet = False) Then
        tb_hoogtevoet.Enabled = False
        tb_breedtevoet.Enabled = False
    End If
       
End Sub

Private Sub speling_Click()
    If (speling = True) Then
        tb_speling.Enabled = True
    End If
       
    If (speling = False) Then
        tb_speling.Enabled = False
    End If
       
End Sub
Private Sub bordesonder_Click()
    If (bordesonder = True) Then
        tb_bordesonderdikte.Enabled = True
        tb_bordesonderlengte.Enabled = True
    End If
       
    If (bordesonder = False) Then
        tb_bordesonderdikte.Enabled = False
        tb_bordesonderlengte.Enabled = False
    End If
   
End Sub
Private Sub bordesboven_Click()
    If (bordesboven = True) Then
        tb_bordesbovendikte.Enabled = True
        tb_bordesbovenlengte.Enabled = True
    End If
       
    If (bordesboven = False) Then
        tb_bordesbovendikte.Enabled = False
        tb_bordesbovenlengte.Enabled = False
    End If
   
End Sub

Private Sub verdiepdikte_Click()
    If (verdiepdikte = True) Then
        tb_verdiepdikte.Enabled = True
    End If
       
    If (verdiepdikte = False) Then
        tb_verdiepdikte.Enabled = False
    End If
 
End Sub

Private Sub b_maaktrap_Click()

UserForm1.Hide

' veld invullen en laten tekenen adhv gekozen detail

    Call rechte_trap(UserForm1.tb_aantrede.Value, UserForm1.tb_optrede.Value, UserForm1.tb_aantaltreden.Value, UserForm1.tb_breedte.Value, UserForm1.tb_slede.Value, UserForm1.tb_hoogtevoet.Value, UserForm1.tb_breedtevoet.Value, UserForm1.tb_speling.Value, UserForm1.tb_verdiepdikte.Value, UserForm1.tb_bordesonderdikte.Value, UserForm1.tb_bordesonderlengte.Value, UserForm1.tb_bordesbovendikte.Value, UserForm1.tb_bordesbovenlengte.Value)
   
    If (optdetail1 = False) And (optdetail2 = False) And (optdetail3 = False) Then
    MsgBox "er werd geen trap detail gekozen"
    End If
     
End Sub
   
    Sub rechte_trap(aantrede As Double, optrede As Double, aantaltreden As Integer, breedte As Double, slede As Double, hoogtevoet As Double, breedtevoet As Double, spelingswaarde As Double, verdiepdiktewaarde As Double, bordesonderdikte As Double, bordesonderlengte As Double, bordesbovendikte As Double, bordesbovenlengte As Double)

        Dim trede As Integer
        For trede = 0 To aantaltreden - 1
        Call tekentrap(0 + aantrede * trede, o + optrede * trede, optrede, aantrede, breedte)
        Next trede
       
        'tekenen van voetje
        If voet = True Then
            Dim voetlijn1 As AcadLWPolyline
            Dim voetlijn2 As AcadLWPolyline
            Dim voetlijn3 As AcadLWPolyline
            Dim pvoet1(2) As Double
            Dim pvoet2(2) As Double
            Dim pvoet3(2) As Double
            Dim pvoet4(2) As Double
   
            pvoet1(0) = 0
            pvoet1(1) = 0
            pvoet2(0) = pvoet1(0)
            pvoet2(1) = pvoet1(1) - hoogtevoet
            pvoet3(0) = pvoet2(0) + breedtevoet
            pvoet3(1) = pvoet2(1)
            pvoet4(0) = pvoet3(0)
            pvoet4(1) = ((optrede / aantrede) * breedtevoet) - ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / aantrede)
           
            If breedtevoet = "0" Then
            pvoet4(0) = (pvoet3(1) + (slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / aantrede) * (aantrede / optrede)
            pvoet4(1) = pvoet3(1)
            End If
       
            Set voetlijn1 = ThisDrawing.ModelSpace.AcadLWPolyline(pvoet1, pvoet2)
            voetlijn1.Layer = "0-betontrap"
            Set voetlijn2 = ThisDrawing.ModelSpace.AcadLWPolyline(pvoet2, pvoet3)
            voetlijn2.Layer = "0-betontrap"
            Set voetlijn3 = ThisDrawing.ModelSpace.AcadLWPolyline(pvoet3, pvoet4)
            voetlijn3.Layer = "0-betontrap"
        End If
           
        If speling = True Then
            Dim spelinglijn As AcadLWPolyline
            Dim spelingpunt(2) As Double
           
                spelingpunt(0) = -(Sin(0.2618) * spelingswaarde)
                If (optdetail2 = True) Then
                spelingpunt(0) = x
                End If
                spelingpunt(1) = spelingswaarde
                pvoet4(0) = (spelingpunt(1) + (slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / aantrede) * (aantrede / optrede)
                pvoet4(1) = spelingpunt(1)
           
                Set spelinglijn = ThisDrawing.ModelSpace.AcadLWPolyline(spelingpunt, pvoet4)
                spelinglijn.Layer = "0-betontrap"
           
          End If
         
          If speling = False And voet = False And bordesonder = False Then
            Dim voetlijn4 As AcadLWPolyline
            Dim pvoet5(2) As Double
            Dim pvoet6(2) As Double
           
            pvoet5(0) = 0
            pvoet5(1) = 0
            pvoet6(0) = ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
            pvoet6(1) = 0
           
            Set voetlijn4 = ThisDrawing.ModelSpace.AcadLWPolyline(pvoet5, pvoet6)
            voetlijn4.Layer = "0-betontrap"
        End If
       
        If bordesonder = True Then
            Dim bordesonderlijn1 As AcadLWPolyline
            Dim bordesonderlijn2 As AcadLWPolyline
            Dim bordesonderlijn3 As AcadLWPolyline
       
            pvoet1(0) = 0
            pvoet1(1) = 0
            If (optdetail2 = True) Then
            pvoet2(0) = pvoet1(0) - bordesonderlengte
            End If
            If (optdetail3 = True) Then
            pvoet2(0) = pvoet1(0) - bordesonderlengte - (optrede * Tan(0.2618))
            End If
            If (optdetail1 = True) Then
            pvoet2(0) = pvoet1(0) - bordesonderlengte - ((optrede - 57) * Tan(0.2618))
            End If
            pvoet2(1) = pvoet1(1)
            pvoet3(0) = pvoet2(0)
            pvoet3(1) = pvoet2(1) - bordesonderdikte
            pvoet4(0) = (-bordesonderdikte + (slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / aantrede) * (aantrede / optrede)
            pvoet4(1) = pvoet3(1)
       
            Set bordesonderlijn1 = ThisDrawing.ModelSpace.AcadLWPolyline(pvoet1, pvoet2)
            bordesonderlijn1.Layer = "0-betontrap"
            Set bordesonderlijn2 = ThisDrawing.ModelSpace.AcadLWPolyline(pvoet2, pvoet3)
            bordesonderlijn2.Layer = "0-betontrap"
            Set bordesonderlijn3 = ThisDrawing.ModelSpace.AcadLWPolyline(pvoet3, pvoet4)
            bordesonderlijn3.Layer = "0-betontrap"
        End If
       
        If bordesboven = True Then
            Dim bordesbovenlijn1 As AcadLWPolyline
            Dim bordesbovenlijn2 As AcadLWPolyline
            Dim bordesbovenlijn3 As AcadLWPolyline
            Dim pb1(2) As Double
            Dim pb2(2) As Double
            Dim pb3(2) As Double
            Dim pb4(2) As Double
       
            pb1(0) = (aantaltreden * aantrede) - ((bordesbovendikte * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
            pb1(1) = (aantaltreden * optrede) - bordesbovendikte
            pb2(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte
           
            If (optdetail1 = True) Then
                pb2(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte - ((optrede - 57) * Tan(0.2618))
            End If
           
            If (optdetail3 = True) Then
                pb2(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte - (optrede * Tan(0.2618))
            End If
           
            pb2(1) = pb1(1)
            pb3(0) = pb2(0)
            pb3(1) = (aantaltreden * optrede)
            pb4(0) = (aantaltreden - 1) * aantrede
            pb4(1) = aantaltreden * optrede
           
            Set bordesbovenlijn1 = ThisDrawing.ModelSpace.AcadLWPolyline(pb1, pb2)
            bordesbovenlijn1.Layer = "0-betontrap"
            Set bordesbovenlijn2 = ThisDrawing.ModelSpace.AcadLWPolyline(pb2, pb3)
            bordesbovenlijn2.Layer = "0-betontrap"
            Set bordesbovenlijn3 = ThisDrawing.ModelSpace.AcadLWPolyline(pb3, pb4)
            bordesbovenlijn3.Layer = "0-betontrap"
           
        End If
       
        'tekenen van trapboomlijn
            Dim trapboomlijn1 As AcadLWPolyline
            Dim trapboomlijn2 As AcadLWPolyline
   
            Dim p7(2) As Double
            Dim p8(2) As Double
            Dim p99(2) As Double
            Dim p1010(2) As Double
   
            p7(0) = 0
           
            If (optdetail1 = True) Then
                p7(0) = 0 - ((optrede - 57) * Tan(0.2618))
            End If
           
             If (optdetail3 = True) Then
                p7(0) = 0 - (optrede * Tan(0.2618))
            End If
           
            p7(1) = -500
            p8(0) = p7(0) + (aantaltreden * aantrede)
            p8(1) = -500
            p99(0) = p7(0)
            p99(1) = -500 - breedte
            p1010(0) = p8(0)
            p1010(1) = -500 - breedte
   
        If bordesonder = True Then
            Dim bordeslijn4 As AcadLWPolyline
            If (optdetail1 = True) Then
            p7(0) = -bordesonderlengte - ((optrede - 57) * Tan(0.2618))
            p99(0) = -bordesonderlengte - ((optrede - 57) * Tan(0.2618))
            End If
       
            If (optdetail2 = True) Then
            p7(0) = -bordesonderlengte
            p99(0) = -bordesonderlengte
            End If
           
            If (optdetail3 = True) Then
            p7(0) = -bordesonderlengte - (optrede * Tan(0.2618))
            p99(0) = -bordesonderlengte - (optrede * Tan(0.2618))
            End If
           
           
        End If
       
         If bordesboven = True Then
            Dim bordesbovenlijn As AcadLWPolyline
            p8(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte
            p1010(0) = p8(0)
           
            If (optdetail1 = True) Then
                p8(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte - ((optrede - 57) * Tan(0.2618))
                p1010(0) = p8(0)
            End If
           
            If (optdetail3 = True) Then
                p8(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte - (optrede * Tan(0.2618))
                p1010(0) = p8(0)
            End If
                 
       
        End If
   
    If tandopleg = True Then
        p8(0) = (aantaltreden * aantrede) - ((210 * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede) + 100
        p1010(0) = (aantaltreden * aantrede) - ((210 * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede) + 100
        Dim eindlijn As AcadLWPolyline
        Dim eindpunt(2) As Double
        eindpunt(0) = p8(o)
        eindpunt(1) = -500 - breedte
       
    End If
   
    If verdiepdikte = True Then
        If (optdetail1 = True) Then
            p8(0) = ((aantaltreden - 1) * aantrede) + aantrede - ((optrede - 57) * Tan(0.2618))
            p1010(0) = ((aantaltreden - 1) * aantrede) + aantrede - ((optrede - 57) * Tan(0.2618))
        End If
       
         If (optdetail2 = True) Then
            p8(0) = ((aantaltreden - 1) * aantrede) + aantrede
            p1010(0) = ((aantaltreden - 1) * aantrede) + aantrede
        End If
       
         If (optdetail1 = True) Then
            p8(0) = ((aantaltreden - 1) * aantrede) + aantrede - (optrede * Tan(0.2618))
            p1010(0) = ((aantaltreden - 1) * aantrede) + aantrede - (optrede * Tan(0.2618))
        End If
       
        Dim eindlijn2 As AcadLWPolyline
        Dim eindpunt2(2) As Double
        eindpunt2(0) = p8(o)
        eindpunt2(1) = -500 - breedte
       
    End If
   
   

   
        'tekenen van slede
            Dim sledelijn As AcadLWPolyline
            Dim p9(2) As Double
            Dim p10(2) As Double
   
            p9(0) = ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
            p9(1) = 0
           
            If voet = True Then
                p9(0) = pvoet4(0)
                p9(1) = pvoet4(1)
            End If
           
            If speling = True Then
                p9(0) = pvoet4(0)
                p9(1) = pvoet4(1)
            End If
           
            If bordesonder = True Then
            p9(0) = pvoet4(0)
            p9(1) = pvoet4(1)
            End If
           
            p10(0) = ((aantaltreden - 1) * aantrede)
            p10(1) = ((aantaltreden - 1) * optrede) - ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / aantrede)
           
            If bordesboven = True Then
                p10(0) = (aantaltreden * aantrede) - ((bordesbovendikte * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
                p10(1) = (aantaltreden * optrede) - bordesbovendikte
            End If
           
            If tandopleg = True Then
   
                p10(0) = (aantaltreden * aantrede) - ((210 * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
                p10(1) = (aantaltreden * optrede) - 210
                Dim ptand1(2) As Double
                ptand1(0) = p10(0)
                ptand1(1) = p10(1) + 110
                Dim ptand2(2) As Double
                ptand2(0) = ptand1(0) + 100
                ptand2(1) = ptand1(1)
                Dim ptand3(2) As Double
                ptand3(0) = ptand2(0)
                ptand3(1) = ptand2(1) + 100

     
                Set sledelijn = ThisDrawing.ModelSpace.AcadLWPolyline(p10, ptand1)
                sledelijn.Layer = "0-betontrap"
                Set sledelijn = ThisDrawing.ModelSpace.AcadLWPolyline(ptand1, ptand2)
                sledelijn.Layer = "0-betontrap"
                Set sledelijn = ThisDrawing.ModelSpace.AcadLWPolyline(ptand2, ptand3)
                sledelijn.Layer = "0-betontrap"
   
            End If
           
            If verdiepdikte = True Then
   
                p10(0) = (aantaltreden * aantrede) - ((verdiepdiktewaarde * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
                p10(1) = (aantaltreden * optrede) - verdiepdiktewaarde
                Dim puntextra(2) As Double
               
                If (optdetail1 = True) Then
                    puntextra(0) = ((aantaltreden - 1) * aantrede) + aantrede - ((optrede - 57) * Tan(0.2618))
                End If
               
                 If (optdetail2 = True) Then
                    puntextra(0) = ((aantaltreden - 1) * aantrede) + aantrede
                End If
               
                 If (optdetail3 = True) Then
                    puntextra(0) = ((aantaltreden - 1) * aantrede) + aantrede - (optrede * Tan(0.2618))
                End If
               
                puntextra(1) = (aantaltreden * optrede) - verdiepdiktewaarde
                Dim lijnextra As AcadLWPolyline
                Set lijnextra = ThisDrawing.ModelSpace.AcadLWPolyline(p10, puntextra)
                lijnextra.Layer = "0-betontrap"
       
                Dim puntextra2(2) As Double
                puntextra2(0) = puntextra(0)
                puntextra2(1) = aantaltreden * optrede
                Dim lijnextra2 As AcadLWPolyline
                Set lijnextra2 = ThisDrawing.ModelSpace.AcadLWPolyline(puntextra, puntextra2)
                lijnextra2.Layer = "0-betontrap"
       
            End If
   
                Set sledelijn = ThisDrawing.ModelSpace.AcadLWPolyline(p9, p10)
                sledelijn.Layer = "0-betontrap"
           
    End Sub

        Private Sub tekentrap(x, y, optrede As Double, aantrede As Double, breedte As Double)
        'tekenen van zijzicht
        'verklaren van variabelen
            Dim poly1 As AcadLWPolyline
            Dim poly2 As AcadLWPolyline
            Dim poly3 As AcadLWPolyline
           
            Dim p1(2) As Double
            Dim p1a(2) As Double
            Dim p2(2) As Double
            Dim p3(2) As Double
            Dim p4(2) As Double
           
        'uitzetten van punten via coordinaten
            p1(0) = x
            p1(1) = y
            p1a(0) = p1(0) - ((optrede - 57) * Tan(0.2618))
            p1a(1) = p1(1) + (optrede - 57)
            p2(0) = p1(0)
           
            If (optdetail1 = True) Then
                p2(0) = p1a(0)
            End If
           
            If (optdetail3 = True) Then
                p2(0) = p1(0) - (optrede * Tan(0.2618))
            End If
           
            p2(1) = p1(1) + optrede
            p3(0) = p1(0) + aantrede
            p3(1) = p2(1)

        'tekenen van trapvorm adhv coordinaten
             If (optdetail1 = False) Then
                Set poly1 = ThisDrawing.ModelSpace.AcadLWPolyline(p1, p2)
                Set poly2 = ThisDrawing.ModelSpace.AcadLWPolyline(p2, p3)
            End If
           
            If (optdetail1 = True) Then
                Set poly1 = ThisDrawing.ModelSpace.AcadLWPolyline(p1, p1a)
                Set poly2 = ThisDrawing.ModelSpace.AcadLWPolyline(p1a, p2)
                Set poly3 = ThisDrawing.ModelSpace.AcadLWPolyline(p2, p3)
                poly3.Layer = "0-betontrap"
                'Set the bulge of segment 4 of the polyline (ie, index 3) to a value of -1
                poly.SetBulge 3, -1
                'Close the polyline
                poly.Closed = True
                poly1.Layer = "0-betontrap"
                poly2.Layer = "0-betontrap"
               
           End If
           
               
         
               
                End Sub
#3
VBA / Re: Macro uitbreiden van 2D naar 3D help
vr 01 01 2016, 13:21:30
Dat is net het probleem om tot een gesloten omtrek te bekomen.

vanaf dan lijkt het me inderdaad van zelfsprekend.

MVG

#4
VBA / Re: Macro uitbreiden van 2D naar 3D help
wo 30 12 2015, 16:57:18
Dit is de macro in 2D vba

Public Sub trap()
UserForm1.show
End Sub
Private Sub CheckBox1_Click()

End Sub

Private Sub tb_bordesonderlengte_Change()

End Sub

'werken met totaal niveauverschil
Private Sub tb_niveauverschil_change()
    tb_optrede.Text = tb_niveauverschil.Value / tb_aantaltreden.Value
   
End Sub
Private Sub tb_aantaltreden_change()
    tb_optrede.Text = tb_niveauverschil.Value / tb_aantaltreden.Value
   
End Sub
Private Sub b_reset_Click()
    UserForm1.Hide
   
End Sub
Private Sub voet_Click()
    If (voet = True) Then
        tb_hoogtevoet.Enabled = True
        tb_breedtevoet.Enabled = True
    End If
       
    If (voet = False) Then
        tb_hoogtevoet.Enabled = False
        tb_breedtevoet.Enabled = False
    End If
       
End Sub

Private Sub speling_Click()
    If (speling = True) Then
        tb_speling.Enabled = True
    End If
       
    If (speling = False) Then
        tb_speling.Enabled = False
    End If
       
End Sub
Private Sub bordesonder_Click()
    If (bordesonder = True) Then
        tb_bordesonderdikte.Enabled = True
        tb_bordesonderlengte.Enabled = True
    End If
       
    If (bordesonder = False) Then
        tb_bordesonderdikte.Enabled = False
        tb_bordesonderlengte.Enabled = False
    End If
   
End Sub
Private Sub bordesboven_Click()
    If (bordesboven = True) Then
        tb_bordesbovendikte.Enabled = True
        tb_bordesbovenlengte.Enabled = True
    End If
       
    If (bordesboven = False) Then
        tb_bordesbovendikte.Enabled = False
        tb_bordesbovenlengte.Enabled = False
    End If
   
End Sub

Private Sub verdiepdikte_Click()
    If (verdiepdikte = True) Then
        tb_verdiepdikte.Enabled = True
    End If
       
    If (verdiepdikte = False) Then
        tb_verdiepdikte.Enabled = False
    End If
 
End Sub

Private Sub b_maaktrap_Click()

UserForm1.Hide

' veld invullen en laten tekenen adhv gekozen detail

    Call rechte_trap(UserForm1.tb_aantrede.Value, UserForm1.tb_optrede.Value, UserForm1.tb_aantaltreden.Value, UserForm1.tb_breedte.Value, UserForm1.tb_slede.Value, UserForm1.tb_hoogtevoet.Value, UserForm1.tb_breedtevoet.Value, UserForm1.tb_speling.Value, UserForm1.tb_verdiepdikte.Value, UserForm1.tb_bordesonderdikte.Value, UserForm1.tb_bordesonderlengte.Value, UserForm1.tb_bordesbovendikte.Value, UserForm1.tb_bordesbovenlengte.Value)
   
    If (optdetail1 = False) And (optdetail2 = False) And (optdetail3 = False) Then
    MsgBox "er werd geen trap detail gekozen"
    End If
     
End Sub
   
    Sub rechte_trap(aantrede As Double, optrede As Double, aantaltreden As Integer, breedte As Double, slede As Double, hoogtevoet As Double, breedtevoet As Double, spelingswaarde As Double, verdiepdiktewaarde As Double, bordesonderdikte As Double, bordesonderlengte As Double, bordesbovendikte As Double, bordesbovenlengte As Double)

        Dim trede As Integer
        For trede = 0 To aantaltreden - 1
        Call tekentrap(0 + aantrede * trede, o + optrede * trede, optrede, aantrede, breedte)
        Next trede
       
        'tekenen van voetje
        If voet = True Then
            Dim voetlijn1 As AcadLine
            Dim voetlijn2 As AcadLine
            Dim voetlijn3 As AcadLine
            Dim pvoet1(2) As Double
            Dim pvoet2(2) As Double
            Dim pvoet3(2) As Double
            Dim pvoet4(2) As Double
   
            pvoet1(0) = 0
            pvoet1(1) = 0
            pvoet2(0) = pvoet1(0)
            pvoet2(1) = pvoet1(1) - hoogtevoet
            pvoet3(0) = pvoet2(0) + breedtevoet
            pvoet3(1) = pvoet2(1)
            pvoet4(0) = pvoet3(0)
            pvoet4(1) = ((optrede / aantrede) * breedtevoet) - ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / aantrede)
           
            If breedtevoet = "0" Then
            pvoet4(0) = (pvoet3(1) + (slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / aantrede) * (aantrede / optrede)
            pvoet4(1) = pvoet3(1)
            End If
       
            Set voetlijn1 = ThisDrawing.ModelSpace.AddLine(pvoet1, pvoet2)
            voetlijn1.Layer = "1-betontrap"
            Set voetlijn2 = ThisDrawing.ModelSpace.AddLine(pvoet2, pvoet3)
            voetlijn2.Layer = "1-betontrap"
            Set voetlijn3 = ThisDrawing.ModelSpace.AddLine(pvoet3, pvoet4)
            voetlijn3.Layer = "1-betontrap"
        End If
           
        If speling = True Then
            Dim spelinglijn As AcadLine
            Dim spelingpunt(2) As Double
           
                spelingpunt(0) = -(Sin(0.2618) * spelingswaarde)
                If (optdetail2 = True) Then
                spelingpunt(0) = x
                End If
                spelingpunt(1) = spelingswaarde
                pvoet4(0) = (spelingpunt(1) + (slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / aantrede) * (aantrede / optrede)
                pvoet4(1) = spelingpunt(1)
           
                Set spelinglijn = ThisDrawing.ModelSpace.AddLine(spelingpunt, pvoet4)
                spelinglijn.Layer = "1-betontrap"
           
          End If
         
          If speling = False And voet = False And bordesonder = False Then
            Dim voetlijn4 As AcadLine
            Dim pvoet5(2) As Double
            Dim pvoet6(2) As Double
           
            pvoet5(0) = 0
            pvoet5(1) = 0
            pvoet6(0) = ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
            pvoet6(1) = 0
           
            Set voetlijn4 = ThisDrawing.ModelSpace.AddLine(pvoet5, pvoet6)
            voetlijn4.Layer = "1-betontrap"
        End If
       
        If bordesonder = True Then
            Dim bordesonderlijn1 As AcadLine
            Dim bordesonderlijn2 As AcadLine
            Dim bordesonderlijn3 As AcadLine
       
            pvoet1(0) = 0
            pvoet1(1) = 0
            If (optdetail2 = True) Then
            pvoet2(0) = pvoet1(0) - bordesonderlengte
            End If
            If (optdetail3 = True) Then
            pvoet2(0) = pvoet1(0) - bordesonderlengte - (optrede * Tan(0.2618))
            End If
            If (optdetail1 = True) Then
            pvoet2(0) = pvoet1(0) - bordesonderlengte - ((optrede - 57) * Tan(0.2618))
            End If
            pvoet2(1) = pvoet1(1)
            pvoet3(0) = pvoet2(0)
            pvoet3(1) = pvoet2(1) - bordesonderdikte
            pvoet4(0) = (-bordesonderdikte + (slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / aantrede) * (aantrede / optrede)
            pvoet4(1) = pvoet3(1)
       
            Set bordesonderlijn1 = ThisDrawing.ModelSpace.AddLine(pvoet1, pvoet2)
            bordesonderlijn1.Layer = "1-betontrap"
            Set bordesonderlijn2 = ThisDrawing.ModelSpace.AddLine(pvoet2, pvoet3)
            bordesonderlijn2.Layer = "1-betontrap"
            Set bordesonderlijn3 = ThisDrawing.ModelSpace.AddLine(pvoet3, pvoet4)
            bordesonderlijn3.Layer = "1-betontrap"
        End If
       
        If bordesboven = True Then
            Dim bordesbovenlijn1 As AcadLine
            Dim bordesbovenlijn2 As AcadLine
            Dim bordesbovenlijn3 As AcadLine
            Dim pb1(2) As Double
            Dim pb2(2) As Double
            Dim pb3(2) As Double
            Dim pb4(2) As Double
       
            pb1(0) = (aantaltreden * aantrede) - ((bordesbovendikte * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
            pb1(1) = (aantaltreden * optrede) - bordesbovendikte
            pb2(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte
           
            If (optdetail1 = True) Then
                pb2(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte - ((optrede - 57) * Tan(0.2618))
            End If
           
            If (optdetail3 = True) Then
                pb2(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte - (optrede * Tan(0.2618))
            End If
           
            pb2(1) = pb1(1)
            pb3(0) = pb2(0)
            pb3(1) = (aantaltreden * optrede)
            pb4(0) = (aantaltreden - 1) * aantrede
            pb4(1) = aantaltreden * optrede
           
            Set bordesbovenlijn1 = ThisDrawing.ModelSpace.AddLine(pb1, pb2)
            bordesbovenlijn1.Layer = "1-betontrap"
            Set bordesbovenlijn2 = ThisDrawing.ModelSpace.AddLine(pb2, pb3)
            bordesbovenlijn2.Layer = "1-betontrap"
            Set bordesbovenlijn3 = ThisDrawing.ModelSpace.AddLine(pb3, pb4)
            bordesbovenlijn3.Layer = "1-betontrap"
           
        End If
       
        'tekenen van trapboomlijn
            Dim trapboomlijn1 As AcadLine
            Dim trapboomlijn2 As AcadLine
   
            Dim p7(2) As Double
            Dim p8(2) As Double
            Dim p99(2) As Double
            Dim p1010(2) As Double
   
            p7(0) = 0
           
            If (optdetail1 = True) Then
                p7(0) = 0 - ((optrede - 57) * Tan(0.2618))
            End If
           
             If (optdetail3 = True) Then
                p7(0) = 0 - (optrede * Tan(0.2618))
            End If
           
            p7(1) = -500
            p8(0) = p7(0) + (aantaltreden * aantrede)
            p8(1) = -500
            p99(0) = p7(0)
            p99(1) = -500 - breedte
            p1010(0) = p8(0)
            p1010(1) = -500 - breedte
   
        If bordesonder = True Then
            Dim bordeslijn4 As AcadLine
            If (optdetail1 = True) Then
            p7(0) = -bordesonderlengte - ((optrede - 57) * Tan(0.2618))
            p99(0) = -bordesonderlengte - ((optrede - 57) * Tan(0.2618))
            End If
       
            If (optdetail2 = True) Then
            p7(0) = -bordesonderlengte
            p99(0) = -bordesonderlengte
            End If
           
            If (optdetail3 = True) Then
            p7(0) = -bordesonderlengte - (optrede * Tan(0.2618))
            p99(0) = -bordesonderlengte - (optrede * Tan(0.2618))
            End If
           
            Set bordeslijn4 = ThisDrawing.ModelSpace.AddLine(p7, p99)
            bordeslijn4.Layer = "1-betontrap"
        End If
       
         If bordesboven = True Then
            Dim bordesbovenlijn As AcadLine
            p8(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte
            p1010(0) = p8(0)
           
            If (optdetail1 = True) Then
                p8(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte - ((optrede - 57) * Tan(0.2618))
                p1010(0) = p8(0)
            End If
           
            If (optdetail3 = True) Then
                p8(0) = ((aantaltreden - 1) * aantrede) + bordesbovenlengte - (optrede * Tan(0.2618))
                p1010(0) = p8(0)
            End If
                 
            Set bordesbovenlijn = ThisDrawing.ModelSpace.AddLine(p8, p1010)
            bordesbovenlijn.Layer = "1-betontrap"
        End If
   
    If tandopleg = True Then
        p8(0) = (aantaltreden * aantrede) - ((210 * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede) + 100
        p1010(0) = (aantaltreden * aantrede) - ((210 * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede) + 100
        Dim eindlijn As AcadLine
        Dim eindpunt(2) As Double
        eindpunt(0) = p8(o)
        eindpunt(1) = -500 - breedte
        Set eindlijn = ThisDrawing.ModelSpace.AddLine(p8, eindpunt)
        eindlijn.Layer = "1-betontrap"
    End If
   
    If verdiepdikte = True Then
        If (optdetail1 = True) Then
            p8(0) = ((aantaltreden - 1) * aantrede) + aantrede - ((optrede - 57) * Tan(0.2618))
            p1010(0) = ((aantaltreden - 1) * aantrede) + aantrede - ((optrede - 57) * Tan(0.2618))
        End If
       
         If (optdetail2 = True) Then
            p8(0) = ((aantaltreden - 1) * aantrede) + aantrede
            p1010(0) = ((aantaltreden - 1) * aantrede) + aantrede
        End If
       
         If (optdetail1 = True) Then
            p8(0) = ((aantaltreden - 1) * aantrede) + aantrede - (optrede * Tan(0.2618))
            p1010(0) = ((aantaltreden - 1) * aantrede) + aantrede - (optrede * Tan(0.2618))
        End If
       
        Dim eindlijn2 As AcadLine
        Dim eindpunt2(2) As Double
        eindpunt2(0) = p8(o)
        eindpunt2(1) = -500 - breedte
        Set eindlijn2 = ThisDrawing.ModelSpace.AddLine(p8, eindpunt2)
        eindlijn2.Layer = "1-betontrap"
    End If
   
   
        'tekenen van slede
            Dim sledelijn As AcadLine
            Dim p9(2) As Double
            Dim p10(2) As Double
   
            p9(0) = ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
            p9(1) = 0
           
            If voet = True Then
                p9(0) = pvoet4(0)
                p9(1) = pvoet4(1)
            End If
           
            If speling = True Then
                p9(0) = pvoet4(0)
                p9(1) = pvoet4(1)
            End If
           
            If bordesonder = True Then
            p9(0) = pvoet4(0)
            p9(1) = pvoet4(1)
            End If
           
            p10(0) = ((aantaltreden - 1) * aantrede)
            p10(1) = ((aantaltreden - 1) * optrede) - ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / aantrede)
           
            If bordesboven = True Then
                p10(0) = (aantaltreden * aantrede) - ((bordesbovendikte * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
                p10(1) = (aantaltreden * optrede) - bordesbovendikte
            End If
           
            If tandopleg = True Then
   
                p10(0) = (aantaltreden * aantrede) - ((210 * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
                p10(1) = (aantaltreden * optrede) - 210
                Dim ptand1(2) As Double
                ptand1(0) = p10(0)
                ptand1(1) = p10(1) + 110
                Dim ptand2(2) As Double
                ptand2(0) = ptand1(0) + 100
                ptand2(1) = ptand1(1)
                Dim ptand3(2) As Double
                ptand3(0) = ptand2(0)
                ptand3(1) = ptand2(1) + 100

     
   
            End If
           
            If verdiepdikte = True Then
   
                p10(0) = (aantaltreden * aantrede) - ((verdiepdiktewaarde * aantrede) / optrede) + ((slede * ((optrede ^ 2) + (aantrede ^ 2)) ^ (1 / 2)) / optrede)
                p10(1) = (aantaltreden * optrede) - verdiepdiktewaarde
                Dim puntextra(2) As Double
               
                If (optdetail1 = True) Then
                    puntextra(0) = ((aantaltreden - 1) * aantrede) + aantrede - ((optrede - 57) * Tan(0.2618))
                End If
               
                 If (optdetail2 = True) Then
                    puntextra(0) = ((aantaltreden - 1) * aantrede) + aantrede
                End If
               
                 If (optdetail3 = True) Then
                    puntextra(0) = ((aantaltreden - 1) * aantrede) + aantrede - (optrede * Tan(0.2618))
                End If
               
                puntextra(1) = (aantaltreden * optrede) - verdiepdiktewaarde
                Dim lijnextra As AcadLine
                Set lijnextra = ThisDrawing.ModelSpace.AddLine(p10, puntextra)
                lijnextra.Layer = "1-betontrap"
       
                Dim puntextra2(2) As Double
                puntextra2(0) = puntextra(0)
                puntextra2(1) = aantaltreden * optrede
                Dim lijnextra2 As AcadLine
                Set lijnextra2 = ThisDrawing.ModelSpace.AddLine(puntextra, puntextra2)
                lijnextra2.Layer = "1-betontrap"
       
            End If
   
                Set sledelijn = ThisDrawing.ModelSpace.AddLine(p9, p10)
                sledelijn.Layer = "1-betontrap"
           
    End Sub

        Private Sub tekentrap(x, y, optrede As Double, aantrede As Double, breedte As Double)
        'tekenen van zijzicht
        'verklaren van variabelen
            Dim lijn1 As AcadLine
            Dim lijn2 As AcadLine
            Dim lijn3 As AcadLine
           
            Dim p1(2) As Double
            Dim p1a(2) As Double
            Dim p2(2) As Double
            Dim p3(2) As Double
            Dim p4(2) As Double
           
        'uitzetten van punten via coordinaten
            p1(0) = x
            p1(1) = y
            p1a(0) = p1(0) - ((optrede - 57) * Tan(0.2618))
            p1a(1) = p1(1) + (optrede - 57)
            p2(0) = p1(0)
           
            If (optdetail1 = True) Then
                p2(0) = p1a(0)
            End If
           
            If (optdetail3 = True) Then
                p2(0) = p1(0) - (optrede * Tan(0.2618))
            End If
           
            p2(1) = p1(1) + optrede
            p3(0) = p1(0) + aantrede
            p3(1) = p2(1)

        'tekenen van trapvorm adhv coordinaten
             If (optdetail1 = False) Then
                Set lijn1 = ThisDrawing.ModelSpace.AddLine(p1, p2)
                Set lijn2 = ThisDrawing.ModelSpace.AddLine(p2, p3)
            End If
           
            If (optdetail1 = True) Then
                Set lijn1 = ThisDrawing.ModelSpace.AddLine(p1, p1a)
                Set lijn2 = ThisDrawing.ModelSpace.AddLine(p1a, p2)
                Set lijn3 = ThisDrawing.ModelSpace.AddLine(p2, p3)
                lijn3.Layer = "1-betontrap"
            End If
           
                lijn1.Layer = "1-betontrap"
                lijn2.Layer = "1-betontrap"
           
         

        End Sub


Private Sub UserForm_Click()

End Sub


#5
VBA / Macro uitbreiden van 2D naar 3D help
wo 30 12 2015, 11:58:07
wie kan mij op weg helpen?

Ik heb een macro die een betontrap tekent in 2D, nu zou ik die willen aanpassen zodat hij een 3D solid tekent.