CADsite forum

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.

Dat is niet zomaar 123 gedaan.
Heb wel recentelijk een mooie wenteltrapmacro gevonden in het Frans.
Google eens 'Gile Cad lisp' http://gile.pagesperso-orange.fr/LISP/Res_hel.zip

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

Ja mooi dan
Er zijn trouwens ook uitgebreidde mogelijkheden in AutoCAD architecture.
Dan moet je gewoon je baas vragen die investering in een kant en klare 3D omgeving te doen.
'T is maar een idee ik zit niet zo in trappelarij. Succes genwenst met 3d ontwikkeling.

Op hoofdlijnen is het eenvoudig:
1.
Maak een region (AddRegion) van een aantal objecten die een gesloten omtrek vormen.
2.
Extrudeer de region (AddExtrudedSolid) zodat een solid ontstaat.
3.
Optioneel: Herhaal de vorige stappen als meerdere solids nodig zijn (boom+treden+boom).
4.
Optioneel: Voeg de solids samen (Boolean acUnion) tot een enkele solid.

De feitelijke implementatie is vanzelfsprekend complexer. Een zekere voorkennis van VBA is vereist om deze opdracht tot een goed einde te brengen.

Dat is net het probleem om tot een gesloten omtrek te bekomen.

vanaf dan lijkt het me inderdaad van zelfsprekend.

MVG

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

Hieronder een voorbeeld dat je wellicht verder kan helpen. Ik ben overigens zelf vooral een Lisp-man. Laat dat een waarschuwing zijn.
Function Trap_Omtrek_Trede(x As Double, y As Double, aantrede As Double, optrede As Double) As AcadLWPolyline
    Dim punten(0 To 5) As Double
    punten(0) = x: punten(1) = y
    punten(2) = x: punten(3) = y + optrede
    punten(4) = x + aantrede: punten(5) = y + optrede
    Set Trap_Omtrek_Trede = ThisDrawing.ModelSpace.AddLightWeightPolyline(punten)
End Function

Function Trap_Omtrek_Overig(aantalTreden As Integer, aantrede As Double, optrede As Double) As AcadLWPolyline
    Dim punten(0 To 7) As Double
    punten(0) = 0: punten(1) = 0
    punten(2) = aantrede: punten(3) = 0
    punten(4) = aantrede * aantalTreden: punten(5) = optrede * (aantalTreden - 1)
    punten(6) = aantrede * aantalTreden: punten(7) = optrede * aantalTreden
    Set Trap_Omtrek_Overig = ThisDrawing.ModelSpace.AddLightWeightPolyline(punten)
End Function

Function Trap_Solid(aantalTreden As Integer, breedte As Double, aantrede As Double, optrede As Double) As Acad3DSolid
    Dim omtrekPoly() As AcadEntity
    Dim omtrekRegion As Variant
    Dim trap As Acad3DSolid
    Dim i As Integer
    ReDim omtrekPoly(aantalTreden)
    For i = 0 To aantalTreden - 1
        Set omtrekPoly(i) = Trap_Omtrek_Trede(i * aantrede, i * optrede, aantrede, optrede)
    Next i
    Set omtrekPoly(aantalTreden) = Trap_Omtrek_Overig(aantalTreden, aantrede, optrede)
    omtrekRegion = ThisDrawing.ModelSpace.AddRegion(omtrekPoly)
    Set trap = ThisDrawing.ModelSpace.AddExtrudedSolid(omtrekRegion(0), breedte, 0)
    'Wissen tijdelijke polylines:
    For i = 0 To aantalTreden
        omtrekPoly(i).Delete
    Next i
    'Wissen tijdelijke region(s):
    For i = 0 To UBound(omtrekRegion)
        omtrekRegion(i).Delete
    Next i
    Set Trap_Solid = trap
End Function

Sub Trap_04()
  Dim trap As Acad3DSolid
  Set trap = Trap_Solid(4, 1000, 240, 180)
  trap.Color = acRed
End Sub

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?

Citaat van: Avatar op zo 03 01 2016, 08:00:20
Wat is het verschil eigenlijk tussen VBA en Lisp?

Het zijn twee nogal verschillende programmeertalen.