---

Hallo hat einer eine Idee wie ich schnell einen Bogen über 3 Koordinaten(Punkte) zeichnen kann??
(es reicht im 2D) (IM VBA)

MFG Chris

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

---

Hi Chris,

Schnell gehts über Sendcommand. 

Du kannst Bögen in VBA nur über addarc mit Angabe vom Zentrum, Radius und Start- und Enwinkel Zeichnen. Da müsstest du dir die Punkte und dafür berechen.

Gruß, Carsten

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

---

Also ich brauchte das ganze mit den Koordinaten denn ich will den erstellten Bogen dann auch noch zu ner Polylinie hinzufügen!
Hat da einer ne Idee wie man das schnell lösen kann???

(ps ich will ne weiche Wärmedämmung programmieren (WD-Keil)
will aber nicht die Lisp Tools verwenden die im Umlauf sind)

Mfg Chris

[Diese Nachricht wurde von c.schojer am 13. Jul. 2007 editiert.]

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

---

Hi Chris,

Schau mal hier, vielleicht ist da das passende für dich dabei.

Gruß, Carsten

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

---

Hallo Chris,

warum erzeugst du nicht gleich eine Polylinie.
Hab das mal ein wenig zusammenkopiert.
Klappt aber 

Code:

---

Option Explicit
Type Fpunkttyp
    Rechtswert As Double
    Hochwert As Double
End Type

Sub Bogensegment()

    Dim p1 As Variant
    Dim p2 As Variant
    Dim p3 As Variant
   
    Dim Punkte(0 To 3) As Double
    Dim FPunkte(1 To 3) As Fpunkttyp
   
    Dim a As Double, b As Double, c As Double
    Dim p As Double, h As Double
    Dim bulge As Double
   
    Dim Bogen As AcadLWPolyline
   
    On Error GoTo exit_sub
    p1 = ThisDrawing.Utility.GetPoint(, Chr$(10) & "1. Punkt:")
    p2 = ThisDrawing.Utility.GetPoint(, Chr$(10) & "2. Punkt:")
    p3 = ThisDrawing.Utility.GetPoint(, Chr$(10) & "3. Punkt:")
    On Error GoTo 0
   
    ' Strecken berechnen
    a = Sqr((p2(0) - p1(0)) ^ 2 + (p2(1) - p1(1)) ^ 2)
    b = Sqr((p3(0) - p2(0)) ^ 2 + (p3(1) - p2(1)) ^ 2)
    c = Sqr((p3(0) - p1(0)) ^ 2 + (p3(1) - p1(1)) ^ 2)
   
    ' Fusspunkt
    p = (c ^ 2 + a ^ 2 - b ^ 2) / (2 * c)
    ' Höhe von Strecke P1->P3 zum Punkt P2
    h = Sqr(a ^ 2 - p ^ 2)
   
    ' Koordinaten der Polylinie (P1->P3)
    Punkte(0) = p1(0)
    Punkte(1) = p1(1)
    Punkte(2) = p3(0)
    Punkte(3) = p3(1)
   
    Dim o As Double
    Dim x As Double
    Dim r As Double
    ' Versatz P1->P3 zum Kreismittelpunkt
    o = c / 2 - p
    x = (c ^ 2 / 4 - h ^ 2 - o ^ 2) / (2 * h)
    r = Sqr((h + x) ^ 2 + o ^ 2)
    ' R-x = Höhe des Bogens zum Scheitelpunkt
   
    ' Punkte für Flächenberechnung
    FPunkte(1).Rechtswert = p1(0)
    FPunkte(1).Hochwert = p1(1)
    FPunkte(2).Rechtswert = p2(0)
    FPunkte(2).Hochwert = p2(1)
    FPunkte(3).Rechtswert = p3(0)
    FPunkte(3).Hochwert = p3(1)
   
    ' Ausbiegung gleich Verhältnis Höhe zur halben Sehne
    bulge = (r - x) / (c / 2)
    ' Richtung (Fläche positiv liegt der Punkt links, negativ leigt der Punkt rechts)
    bulge = bulge * Sgn(gauss_area(FPunkte)) * -1
    ' Polylinie Zeichnen
    Set Bogen = ThisDrawing.ModelSpace.AddLightWeightPolyline(Punkte)
    Bogen.color = acBlue
    Bogen.SetBulge 0, bulge
    Bogen.Update
   
exit_sub:
End Sub

Public Function gauss_area(Punkte() As Fpunkttyp) As Double
  ' Berechnet die Fläche eines Polygons, das durch
  ' Punktkoordinaten gegeben ist
  Dim i As Integer
  Dim Area As Double
  Dim Punktanzahl As Long
  Dim xs As Double, ys As Double, xa As Double, ya As Double
   
  Punktanzahl = UBound(Punkte)
  xs = Punkte(1).Hochwert
  ys = Punkte(1).Rechtswert

  For i = 1 To Punktanzahl
    xa = Punkte(i).Hochwert
    ya = Punkte(i).Rechtswert
       
    Area = Area + (ys + ya) * (xs - xa)
       
    xs = xa
    ys = ya
  Next i
   
  ' der letzte Punkt ist wieder der erste Punkt
  xa = Punkte(1).Hochwert
  ya = Punkte(1).Rechtswert
   
  Area = Area + (ys + ya) * (xs - xa)
   
  ' Rückgabewert
  gauss_area = Area / 2
End Function

---

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Ui danke Vielmals das mit den Polylinien hätte ich eh gebraucht!!

Mfg Chris

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