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.