CADsite forum

Misschien is dit de oplossing: http://through-the-interface.typepad.com/through_the_interface/2006/09/automatic_loadi.html?

Steven.

Waarschijnlijk dien je FILEDIA op 1 te zetten.
Zal nu op 0 ingesteld staan.


Steven.

Dit kan je doen door de code in een module te plakken,
dan dubbelklikken op je CommandButton op je UserForm, en volgende code toevoegen:

Call Module1.rijboring

Waarbij Module1 de naam van je module is, en rijboring de methode die je wil aanroepen.
Zie voorbeeld in bijlage.

Probeer dit eens:

Public Sub rijboring()

'Variabelen
Dim retObj1 As AcadObject
Dim retObj2 As AcadObject

Dim retPunt1(0 To 2) As Double
Dim retPunt2(0 To 2) As Double

Dim Cirkel1 As AcadCircle
Dim Cirkel2 As AcadCircle

Dim punt1(0 To 2) As Double
Dim punt2(0 To 2) As Double

Dim lengte As Double
Dim minAfstand As Double
minAfstand = 100
Dim afstand As Double
Dim aantal As Double

'Duid de eerste cirkel aan
Cirkel1:
ThisDrawing.Utility.GetEntity retObj1, retPunt1, "Duid de eerste cirkel aan..."

'Controleer of het een cirkel is
If retObj1.ObjectName = "AcDbCircle" Then
   
    Set Cirkel1 = retObj1
   
    punt1(0) = Cirkel1.center(0)
    punt1(1) = Cirkel1.center(1)
    punt1(2) = Cirkel1.center(2)

Else

    MsgBox "Geen cirkel!"
    GoTo Cirkel1

End If

'Duid de tweede cirkel aan
Cirkel2:
ThisDrawing.Utility.GetEntity retObj2, retPunt2, "Duid de tweede cirkel aan..."

'Controleer of het een cirkel is
If retObj2.ObjectName = "AcDbCircle" Then

    Set Cirkel2 = retObj2

    punt2(0) = Cirkel2.center(0)
    punt2(1) = Cirkel2.center(1)
    punt2(2) = Cirkel2.center(2)

Else

    MsgBox "Geen cirkel!"
    GoTo Cirkel2

End If

'rijboring in Y richting
If punt1(0) = punt2(0) Then

    lengte = Abs(punt1(1) - punt2(1))
    aantal = Round(((lengte - (minAfstand * 2)) / 32), 0)
    afstand = ((lengte - (32 * aantal)) / 2)
   
        If punt1(1) < punt2(1) Then
       
            Yrichting punt1(0), punt1(1), afstand, aantal
           
        Else
       
            Yrichting punt2(0), punt2(1), afstand, aantal
       
        End If
       

End If

'rijboring in X richting
If punt1(1) = punt2(1) Then

    lengte = Abs(punt1(0) - punt2(0))
    aantal = Round((lengte - (minAfstand * 2)) / 32)
    afstand = ((lengte - (32 * aantal)) / 2)
   
    If punt1(0) < punt2(0) Then
       
            Xrichting punt1(0), punt1(1), afstand, aantal
           
        Else
       
            Xrichting punt2(0), punt2(1), afstand, aantal
       
        End If

End If


End Sub

Sub Yrichting(xPunt As Double, yPunt As Double, afstand As Double, aantal As Double)

    Dim rijboring As AcadCircle
    Dim center(0 To 2) As Double
    center(0) = xPunt
    center(1) = yPunt
    center(2) = 0
   
    For i = 1 To aantal - 1
       
        center(1) = yPunt + afstand + (32 * i)
        Set rijboring = ThisDrawing.ModelSpace.AddCircle(center, 2.5)
   
    Next i

End Sub


Sub Xrichting(xPunt As Double, yPunt As Double, afstand As Double, aantal As Double)

    Dim rijboring As AcadCircle
    Dim center(0 To 2) As Double
    center(0) = xPunt
    center(1) = yPunt
    center(2) = 0
   
    For i = 1 To aantal - 1
       
        center(0) = xPunt + afstand + (32 * i)
        Set rijboring = ThisDrawing.ModelSpace.AddCircle(center, 2.5)
   
    Next i

End Sub


En waar staat deze schaal dan op 1/1?
In de Modelspace teken ik altijd alles op ware grootte, de schaal pas ik in de Layout aan.

Ik denk dat in uw layout de schaal niet op 1/1 staat. Rechtsklik op de viewport in de layout (de kader in volle lijn),
en klik vervolgens op Properties. En kijk dan of de Standard scale onder Misc staat op 1/1, zoniet moet je deze op 1/1 zetten.

Bedankt, was net wat ik zocht.

Als je bv 5 layouts hebt (1,2,3,4 & 5) en je wil bv layout 3 voorlaatste plaatsen, rechtsklik dan op layout 3, kies Move or Copy.
in de lijst met layouts klik je op de layout waarvoor je deze layout wil plaatsen, in dit geval layout5, en klik dan OK.

Als deze hatch een juiste extensie heeft (.pat), kun je deze gewoon plakken in de map C:\Documents and Settings\User\Application Data\Autodesk\AutoCAD 2009\R17.2\enu\Support. In jouw geval zal het AutoCAD LT 2008 zijn ipv AutoCAD 2009, wanneer je nu de volgende keer AutoCAD opstart zal deze in het tabblad 'Custom' van de hatches staan.



Steven

Beste,

Ik denk dat je enkele zaken door elkaar haalt:

- In Model Space teken je altijd op schaal 1/1, die schaal instellingen die jij aanhaalt (Scale List) is enkel van toepassing in Paper Space (Layout).
- In Model Space dien je wel de correcte "units" in te stellen, Format - Units.
- Het beste is om in Model Space je tekening te plaatsen, en je opmaak (tekst, dimensionering, ...) in de layouts.

Zie bijlage voor meer uitleg.


Steven.

Weet iemand waar je in Belgie, liefst in de provincie Antwerpen, een "Autodesk Authorized Trainingcenter" hebt waar je een "AutoCAD Certified Professional" of een "AutCAD Certified User" certificaat kunt behalen?
Ik heb al ongeveer 5 jaar ervaring met AutoCAD, 3 jaar op de Hogeschool Gent en 2 jaar bij mijn werkgever, maar zou nu ook graag nog een certificaat behalen.
Iemand hier ervaringen mee?

Bedankt,

Steven.

Citeer
@ Steven heb je een pm anders stuur ik u mijn code eens door.
Heb jij ook voor graduaat hout gestudeerd.

Inderdaad, ik heb ook graduaat Hout gestudeerd. Ben vorig jaar afgestudeerd.
Heb intussen mijn email adres doorgestuurd.

Steven

Toch niet toevallig student graduaat Hout aan de Hogeschool Gent?
Wat probeer je juist te doen? De layout automatiseren met VBA of ... ?
Waarom niet gewoon een template aanmaken, hiervan een block met attributes maken zodat, telkens je deze template invoegt, je de waarden kan ingeven?
Als je dit wenst te doen met VBA wil ik je gerust helpen maar dan heb ik wel meer gegevens nodig. Welk formaat moet deze template hebben (A4,A3,A2,A1), hoe is deze dan geplaatst (horizontaal of verticaal)?

Tekstijl aanmaken:
Sub Tekststijl()

Dim Tekststijl As AcadTextStyle
Dim Fontname As String
Dim charSet As Long
Dim PitchandFamily As Long

Fontname = "Tahoma"
charSet = 0
PitchandFamily = 34

Set Tekststijl = ThisDrawing.TextStyles.Add("hout vast")

    Tekststijl.SetFont Fontname, False, False, charSet, PitchandFamily
    Tekststijl.Width = 0.5
    Tekststijl.Height = 4

End Sub

Groeten,

Steven

Citaat van: Joop op vr 07 07 2006, 09:23:29
Dit is dus wel een oplossing maar niet echt de goede.

Heb je al eens gekeken naar de gegevens van de UCS zoals die opgeslagen zijn in de tekening?
Deze zijn met VBA eenvoudig te wijzigen.

Misschien is dit beter:


Sub Move_UCS()
   
    Dim Ucs As AcadUCS
   
    origin = ThisDrawing.Utility.GetPoint(, "Duid de oorsprong aan: ")
   
    xAxisPnt = ThisDrawing.Utility.GetPoint(, "Duid een punt op de X-as aan: ")
    yAxisPnt = ThisDrawing.Utility.GetPoint(, "Duid een punt op de Y-as aan: ")
   
   
    Set Ucs = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "NEW_UCS")
   
    ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
    ThisDrawing.ActiveViewport.UCSIconOn = True
    ThisDrawing.ActiveUCS = Ucs
   
End Sub


Dit zou moeten werken:

Private Sub Move_Click()

Dim ssetOb As AcadSelectionSet
Dim Obj As AcadEntity

On Error Resume Next
Set ssetOb = ThisDrawing.SelectionSets.Item("ssetje")
If Err Then
Set ssetOb = ThisDrawing.SelectionSets.Add("ssetje")
Err.Clear
Else
ssetOb.Clear
End If
   
ssetOb.Select acSelectionSetAll

Dim punt1(1 To 3) As Double
Dim punt2(1 To 3) As Double
punt1(1) = 0: punt2(1) = 0
punt1(2) = 0: punt2(2) = Val(Txt2) + 500

For Each Obj In ssetOb

    Obj.Move punt1, punt2
   
Next

ssetOb.Delete

End Sub

Hopelijk ben je er iets mee.

Groeten.