Geen reacties in dit onderwerp

[doebi]

Voor het eerst een programmatje gemaakt in vba Progecad
Progecad is een autocad kloon, bijna 100% compatibel in gebruik, alleen veel veel goedkoper en zonder abonnement
Helaas lijkt het me alsof de VBA van progecad iets afwijkt dan die van grootmeester Autocad, waardoor er niet veel direct
werkbare voorbeelden te vinden zijn op het web

De code laat toe om een kast te generen, op basis van in te stellen parameters,
waaronder de plankdikte, aantal leg planken en de dimensies van de kast

Nog te verwezenlijken :

- een block (wblock)  maken van de gegenereerde kast zodat die als een symbool gebruikt kan worden (nu zijn het letterlijk losse planken)
- een excel lijst generen vanuit dit programma om de planken naar de verzagerij te versturen
- gatenperfonratie om de legplanken te plaatsen en om deuvels te plaatsen

Tips voor deze bovenstaande zaken, of opmerkingen over de code ? Ik hoor het graag

Grtz


Code:

Private Sub CommandButton1_Click()
   
	frmMaakKast.Hide
	Dim dblPlankDikte As Double
	Dim dblKastBreedte As Double
	Dim dblKastHoogte As Double
	Dim dblKastDiepte As Double
	Dim dblSpouwDiepte As Double
	Dim intLegborden As Integer
   
	dblPlankDikte = Val(txtPlankDikte.Text)
	dblKastBreedte = Val(txtKastBreedte.Text)
	dblKastHoogte = Val(txtKastHoogte.Text)
	dblKastDiepte = Val(txtKastDiepte.Text)
	dblSpouwDiepte = Val(txtSpouwDiepte.Text)
	intLegborden = Val(txtLegborden.Text)
   
	Dim myDoc As Document
   
	Dim myStartPt As Point
   
   
   
   
   
	Dim myBox1 As Solid3D
	Dim myBox2 As Solid3D
	Dim myBox3 As Solid3D
	Dim myBox4 As Solid3D
	Dim myBox5 As Solid3D
   
	Dim X As Double
	Dim Y As Double
	Dim Z As Double
   
	Dim OX As Double
	Dim OY As Double
	Dim OZ As Double
   
	Dim pt As Point
	Dim myBox As Solid3D
   
   
   
	' Set pt = Thisdocument.Utility.GetPoint(, "Test : ")
	'Set myBox = Thisdocument.ModelSpace.AddBox(pt, 100, 100, 100)
   
   
   
   
   
		   
	X = dblKastBreedte
	Y = dblKastDiepte
	Z = dblPlankDikte
	OX = 0 + dblKastBreedte / 2
	OY = 0 + dblKastDiepte / 2
	OZ = 0 + dblPlankDikte / 2
	Set myStartPt = Library.CreatePoint(OX, OY, OZ)
	Set myBox1 = Thisdocument.ModelSpace.AddBox(myStartPt, X, Y, Z)
	   
	X = dblKastBreedte
	Y = dblKastDiepte
	Z = dblPlankDikte
	OX = 0 + dblKastBreedte / 2
	OY = 0 + dblKastDiepte / 2
	OZ = (dblPlankDikte / 2) + dblKastHoogte - dblPlankDikte
	Set myStartPt = Library.CreatePoint(OX, OY, OZ)
	Set myBox2 = Thisdocument.ModelSpace.AddBox(myStartPt, X, Y, Z)
   
   
	X = dblPlankDikte
	Y = dblKastDiepte
	Z = dblKastHoogte - dblPlankDikte - dblPlankDikte
	OX = 0 + dblPlankDikte / 2
	OY = 0 + dblKastDiepte / 2
	OZ = dblPlankDikte + (Z / 2)
	Set myStartPt = Library.CreatePoint(OX, OY, OZ)
	Set myBox3 = Thisdocument.ModelSpace.AddBox(myStartPt, X, Y, Z)
   
   
	X = dblPlankDikte
	Y = dblKastDiepte
	Z = dblKastHoogte - dblPlankDikte - dblPlankDikte
	OX = dblKastBreedte - dblPlankDikte + (dblPlankDikte / 2)
	OY = 0 + dblKastDiepte / 2
	OZ = dblPlankDikte + (Z / 2)
	Set myStartPt = Library.CreatePoint(OX, OY, OZ)
	Set myBox4 = Thisdocument.ModelSpace.AddBox(myStartPt, X, Y, Z)
   
   
	X = dblKastBreedte - dblPlankDikte - dblPlankDikte
	Y = dblPlankDikte
	Z = dblKastHoogte - dblPlankDikte - dblPlankDikte
	OX = dblPlankDikte + (X / 2)
	OY = 0 + (Y / 2)
	OZ = dblPlankDikte + (Z / 2)
	OY = OY + dblSpouwDiepte
	Set myStartPt = Library.CreatePoint(OX, OY, OZ)
	Set myBox5 = Thisdocument.ModelSpace.AddBox(myStartPt, X, Y, Z)
   
	Dim dblTussenAfstand As Double
	Dim intLus As Integer
	If intLegborden > 0 Then
	  dblTussenAfstand = (dblKastHoogte - dblPlankDikte - dblPlankDikte) / (intLegborden + 1)
	  X = dblKastBreedte - dblPlankDikte - dblPlankDikte
	  Y = dblKastDiepte - dblSpouwDiepte - dblPlankDikte
	  Z = dblPlankDikte
	  OX = dblPlankDikte + (X / 2)
	  OY = dblSpouwDiepte + dblPlankDikte + (Y / 2)
	  OZ = dblPlankDikte + (Z / 2)
	  For intLus = 1 To intLegborden
		OZ = dblPlankDikte + (dblTussenAfstand * intLus)
		Set myStartPt = Library.CreatePoint(OX, OY, OZ)
		Set myBox5 = Thisdocument.ModelSpace.AddBox(myStartPt, X, Y, Z)
	  Next intLus
	End If
   
   
   
   
   
End Sub

Bijgevoegde Bestanden

•  mijn kast.png   395.54K   3 Aantal bijlagen
•  mijn kast 2.png   26.79K   5 Aantal bijlagen
•  mijn kast 3.png   52.33K   3 Aantal bijlagen