---

Ich hät' da gern mal ein Problem....

bin gerade beim Basteln eines Makros zur Erstellung einer Abdichtung.
Dabei werden Polygone erzeugt und als Blockreferenz eingefügt.
Der Winkel beim Einfügen stimmt aber nie mit dem überein, der durch zwei Punkte vorher abgegriffen wurde. Weder mit Winkel, noch mit Bogenmaß...

Wahrscheinlich hab' ich jetzt daran schon zu viel herumgepfuscht...!?

Dominik

Sub abdichtung_start()
 
    Application.Preferences.Files.ToolPalettePath = "Pfad"
       
       
    Dim returnPnt As Variant
    Dim returnPnt2 As Variant
    Dim l As Variant
    Dim abschnitt As Double

    Dim n As Single
    Dim plineObj As AcadPolyline
    Dim points(0 To 14) As Double
    Dim blockObj As AcadBlock
    Dim returnReal As Double
    Dim sp As Double
    Dim rw As Double
    Dim insertionPntn(0 To 2) As Double
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    Dim blockRefObj As AcadBlockReference
    Dim i As Single
   
   
    'input
   
    returnReal = ThisDrawing.Utility.GetReal("Dicke: ")
    returnPnt = ThisDrawing.Utility.GetPoint(, "Punkt: ")
    returnPnt2 = ThisDrawing.Utility.GetPoint(, "Punkt: ")
  'vorberechnungen
 
    l = Sqr(((returnPnt(0) - returnPnt2(0)) ^ 2) + ((returnPnt(1) - returnPnt2(1)) ^ 2))
    i = l \ (2 * returnReal)
    abschnitt = l / i
    'block definieren
 
    insertionPntn(0) = 0#: insertionPntn(1) = 0#: insertionPntn(2) = 0#
    Set blockObj = ThisDrawing.Blocks.Add(insertionPntn, "New_Block")
   
   
    'verhinderung teilung durch "0"

If (returnPnt(0) - returnPnt2(0)) = 0 Then
rw = ((90 * pi) / 180)
ElseIf (returnPnt(1) - returnPnt2(1)) = 0 Then
rw = ((0 * pi) / 180)
Else
rw = (Tan((returnPnt2(1) - returnPnt(1)) / (returnPnt2(0) - returnPnt(0))))

End If

'Abdichtung zeichnen

sp = 0
For n = 1 To i Step 2

    'leere Zelle zeichnen

    points(0) = 0 - sp: points(1) = 0: points(2) = 0
    points(3) = abschnitt - sp: points(4) = 0: points(5) = 0
    points(6) = abschnitt - sp: points(7) = returnReal: points(8) = 0
    points(9) = 0 - sp: points(10) = returnReal: points(11) = 0
    points(12) = 0 - sp: points(13) = 0: points(14) = 0
       

    Set plineObj = blockObj.AddPolyline(points)
   
   
    If i = n Then
    Else
   

    sp = sp + (2 * returnReal)
   
   
    'solid zelle zeichnen

    points(0) = 0 - sp: points(1) = 0: points(2) = 0
    points(3) = abschnitt - sp: points(4) = 0: points(5) = 0
    points(6) = abschnitt - sp: points(7) = returnReal: points(8) = 0
    points(9) = 0 - sp: points(10) = returnReal: points(11) = 0
    points(12) = 0 - sp: points(13) = 0: points(14) = 0
       

   

    patternName = "SOLID"
    PatternType = 0
    bAssociativity = True
   

        Set hatchObj = blockObj.AddHatch(PatternType, patternName, bAssociativity)
        Dim outerLoop(0) As AcadEntity
        Set outerLoop(0) = blockObj.AddPolyline(points)
        hatchObj.AppendOuterLoop (outerLoop)
   
   
   
   
   
   

        sp = sp + (2 * returnReal)
    End If

Next n


 
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(returnPnt2, "New_Block", 1#, 1#, 1#, rw)

   
End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dominik,

auf die Schnelle hab ich deinen Code nicht ganz verstanden.
Ich habe mir dafür eine Funktion gebaut. Die rechnet für
die Vermessung den Richtungswinkel.

Code:

---

Public Function x_Riwi#(ya#, xa#, Ye#, Xe#)
Dim dy#, dx#
Dim TanAlpha#
Dim winkel#

dy = Ye - ya
dx = Xe - xa

If dx <> 0 Then
  TanAlpha = dy / dx
  winkel = Atn(TanAlpha) * 200 / 3.141593
  If winkel < 0 Then
      winkel = winkel + 200
  End If
  If dy < 0 Then
      winkel = winkel + 200
  End If
  If winkel = 0 And dx < 0 Then
      winkel = 200
  End If
Else
  If dy >= 0 Then
      winkel = 100
  Else
      winkel = 300
  End If
End If

x_Riwi = winkel
 
End Function

---

In der Vermessung gibts halt 400gon statt 360 Grad und die Y/X Achsen sind vertauscht.
Bei AutoCAD ist die Drehrichtung gegen den Uhrzeigersinn.

Ich glaube das dein Problem im Tangens liegt. Der hat im Interval
0-180 und 180 -360 den geleichen Wert. Du musst über das Vorzeichen
der Delta Werte feststellen im welchen Quadranten der Winkel liegt
und entsprechend einen Halbkreis addieren.

Stelli

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ich werde es mal mit Deinen Codeschnipseln ausprobieren.

Das mit den 4 Quadranten weiß ich, dies ist nicht das Problem. Kommt später.

Mein Code funktioniert jetzt erst einmal mit einer Richtung (1 Punkt links oben, zweiter rechts oben).

Wenn ich allerdings so eine Linie nachfahre, hat der eingefügte Block immer eine Abweichung von ca. 10 Grad.

Vielleicht muß ich eine Variable im Autocad umstellen!?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ich habe noch etwas ausprobiert:

Sub abdichtung_start()
 
    Application.Preferences.Files.ToolPalettePath = "Pfad"
       
   
    'Input
         
    Dim p1 As Variant
    Dim p2 As Variant
    Dim d As Variant
    Dim n As Single
 
    Dim lineObj As AcadLine
    n = 0
   
    d = ThisDrawing.Utility.GetReal("Dicke: ")
    p1 = ThisDrawing.Utility.GetPoint(, "Punkt: ")
   
    On Error GoTo beenden
           
    Do
   
    n = n + 1
   
    p2 = ThisDrawing.Utility.GetPoint(, "Punkt: ")
   
'Zeichen ------------------------------------------------------

'Winkel berechnen

 
 
If p1(0) = p2(0) Then ' wenn deltax = 0
    If (p1(1) - p2(1)) < 0 Then
    winkel = 90
    Else
    winkel = 270
    End If

ElseIf p1(1) = p2(1) Then ' wenn deltay = 0
    If (p1(0) - p2(0)) > 0 Then
    winkel = 180
    Else
    winkel = 0
    End If
   

ElseIf (p1(0) - p2(0)) > 0 Then
        TanAlpha = (p1(1) - p2(1)) / (p1(0) - p2(0))
        winkel = 180 + (Atn(TanAlpha) * 180 / 3.141593)

ElseIf (p1(0) - p2(0)) < 0 Then
        TanAlpha = (p1(1) - p2(1)) / (p1(0) - p2(0))
        winkel = (Atn(TanAlpha) * 180 / 3.141593)
End If

    Dim np(0 To 2) As Double
   

    Dim textObj As AcadText
    Dim height As Double
    height = 0.5
    np(0) = 0
    np(1) = 0
    np(2) = 0
   
    Dim blockObj As AcadBlock
    Set blockObj = ThisDrawing.Blocks.Add(np, "test" & n)
   
   
    Set textObj = ThisDrawing.ModelSpace.AddText(winkel, p2, height)

Dim linienendpunkt(0 To 2) As Double
linienendpunkt(0) = p2(0) - p1(0)
linienendpunkt(1) = p2(1) - p1(1)

    Set lineObj = blockObj.AddLine(np, linienendpunkt)
   
   
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    Dim plineObj As AcadPolyline
    Dim points(0 To 14) As Double
    Dim l As Double
   
    l = Sqr(((p1(1) - p2(1)) ^ 2) + ((p1(0) - p2(0)) ^ 2))
   
   
   
   
   
            points(0) = 0: points(1) = 0: points(2) = 0
            points(3) = l: points(4) = 0: points(5) = 0
            points(6) = l: points(7) = d: points(8) = 0
            points(9) = 0: points(10) = d: points(11) = 0
            points(12) = 0: points(13) = 0: points(14) = 0
   
         
            Set plineObj = blockObj.AddPolyline(points)
   
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
   
   
   
   
   
   
   
   
   
    Dim dtr As Variant ' Winkel in Bogenmaß konvertieren
    dtr = (winkel / 180) * pi
       
       
    Dim blockRefObj As AcadBlockReference
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(p1, "test" & n, 1#, 1#, 1#, dtr)

   
'Zeichen ------------------------------------------------------
   
    p1 = p2
  Loop
   
   
   
beenden:

Err.Clear
Exit Sub

 
   
   

   
End Sub

Wie man sieht, stimmt der Winkel, der berechnet wird. Zum Überprüfen wird er sogar noch als Text eingefügt. Die Linie stimmt auch.

Nur das Polygon im Block liegt immer irgendwie rotiert. Mit Bogenmaß immer horizontal nach rechts, mit Winkel immer von X-5422550 Grad irgendwo.....

Das ist doch zum #!?+*##%GR#??!!!!!!!!!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

1. Ich würde deinen Code erstmal ein bisschen Skruktuieren.
Einrücken, Leerzeilen entfernen etc. so das man die Struktur erkennen kann.
2. Du greifst 2 Punkte ab. Die fügst du als Linie in eine
Blockdefinition und rechnest nochmals den Drehwinkel und
benutzt ihn zum Einfügen des Blocks. Meines Erachtens bringst
du den Winkel zwei mal ins Spiel. Daraus sollte sich die
konstante Verdrehung ergeben.
3. Sollte man den Winkel nicht mit GetAngle abfragen ?
4. Probier doch mal die Einstellungen mit Format/Einheiten

Stelli

------------------

[Diese Nachricht wurde von Stelli1 am 23. Sep. 2005 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

wenn du in deinen Programmen "Option Explicit" angibst
kannst du sehen welche Variablen OK sind oder auch nicht.
Dann fällt auf das PI immer 0 ist und somit der Winkel im
Bogenmaß auch.
Ich habe mal grob aufgeräumt:

Code:

---

'Option Explicit

Sub abdichtung_start()
    Dim p1 As Variant
    Dim p2 As Variant
    Dim d As Variant
    Dim n As Single
 
    Dim lineObj As AcadLine
    n = 0
   
    On Error GoTo beenden
    d = ThisDrawing.Utility.GetReal("Dicke: ")
    p1 = ThisDrawing.Utility.GetPoint(, "Punkt: ")
    On Error GoTo 0
   
    Dim Abbruch As Boolean
    Do While Not Abbruch
        n = n + 1
        On Error Resume Next
        p2 = ThisDrawing.Utility.GetPoint(, "Punkt: ")
        If Err.Number <> 0 Then
           Abbruch = True
        Else
            on error goto 0
            'Winkel berechnen
            If p1(0) = p2(0) Then ' wenn deltax = 0
                If (p1(1) - p2(1)) < 0 Then
                    winkel = 90
                Else
                    winkel = 270
                End If
            ElseIf p1(1) = p2(1) Then ' wenn deltay = 0
                If (p1(0) - p2(0)) > 0 Then
                    winkel = 180
                Else
                    winkel = 0
                End If
            ElseIf (p1(0) - p2(0)) > 0 Then
                TanAlpha = (p1(1) - p2(1)) / (p1(0) - p2(0))
                winkel = 180 + (Atn(TanAlpha) * 180 / 3.141593)
            ElseIf (p1(0) - p2(0)) < 0 Then
                TanAlpha = (p1(1) - p2(1)) / (p1(0) - p2(0))
                winkel = (Atn(TanAlpha) * 180 / 3.141593)
            End If
       
            Dim np(0 To 2) As Double
            Dim textObj As AcadText
            Dim height As Double
            height = 0.5
            np(0) = 0
            np(1) = 0
            np(2) = 0
           
            Dim blockObj As AcadBlock
            Set blockObj = ThisDrawing.Blocks.Add(np, "test" & n)
            Set textObj = ThisDrawing.ModelSpace.AddText(winkel, p2, height)
       
            Dim linienendpunkt(0 To 2) As Double
            linienendpunkt(0) = p2(0) - p1(0)
            linienendpunkt(1) = p2(1) - p1(1)
       
            Set lineObj = blockObj.AddLine(np, linienendpunkt)
            Dim plineObj As AcadPolyline
            Dim points(0 To 14) As Double
            Dim l As Double
            l = Sqr(((p1(1) - p2(1)) ^ 2) + ((p1(0) - p2(0)) ^ 2))
           
            points(0) = 0: points(1) = 0: points(2) = 0
            points(3) = l: points(4) = 0: points(5) = 0
            points(6) = l: points(7) = d: points(8) = 0
            points(9) = 0: points(10) = d: points(11) = 0
            points(12) = 0: points(13) = 0: points(14) = 0
           
            Set plineObj = blockObj.AddPolyline(points)
           
            Dim dtr As Variant ' Winkel in Bogenmaß konvertieren
            ' Woher kommt pi ist null
            ''dtr = (winkel / 180) * pi
            dtr = (winkel / 180) * 3.141593
               
            Dim blockRefObj As AcadBlockReference
            Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(p1, "test" & n, 1#, 1#, 1#, dtr)
           
            p1 = p2
        End If
   
    Loop
beenden:
   
End Sub

---

Stelli

------------------
 

[Diese Nachricht wurde von Stelli1 am 23. Sep. 2005 editiert.]

[Diese Nachricht wurde von Stelli1 am 23. Sep. 2005 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Danke Stelli!

Jetzt weiß ich, wo der Fehler lag!

Bin davon ausgegangen, daß pi eine mathematische Einheit in VB wäre, dabei ist es ja nur eine Variable.
Dann kann ich nun wieder beruhigt weiterprogrammieren... ;-)

Wie sehe ich denn, ob eine Variable "OK" ist?

Dominik

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

schreib mal "Option explicit" oben drüber und Starte dein Programm.
Der Compiler wird meckern: "Variable nicht definiert"

Code:

---

Option Explicit
Public Const vgPi As Double = 3.14

Sub Test()
MsgBox "Pi= " & vgPi
'MsgBox "Mein Pi= " & pi
End Sub

---

Stelli

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

...danke für den Tipp!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

übrigens:
Einrücken und wieder zurück von Blöcken mit vielen Zeilen geht auf einen Rutsch. Alle Zeilen markieren und mit TAB bzw. Shift+TAB einrücken und wieder zurück.

Stelli

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Auch Hallo,

... und auch übrigens:

Option Explicit erreicht man durch Menue > Extras > Optionen > Editor > Variablendeklaration erforderlich,
dort Haken setzen und nie wieder rausnehmen;-)

BTW Stelli, nett.

Gruss Nancy 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP