---

Polyline_01.jpg

Hallo und noch frohe Ostern wünsche ich!

Ich suche die Möglichkeit mittels VBA die Länge und die Stärke einer geschlossenen Polylinie zu ermitteln, siehe Bildchen.

Das Objekt möchte ich per

Code:

---

ThisDrawing.Utility.GetEntity Objekt, PickedPoint, Prompt

---

auswählen.

Wie ermittelt man nun die jeweiligen Start- und Endpunkte, so das man die GetDistance - Methode anwenden kann um die Länge und Stärke automatisch zu ermitteln und diese so dann an eine Variable oder einer TextBox zu übergeben?

Code:

---

Dim Startpoint As Double
Dim EndLaenge As Double
Dim EndStaerke As Double
Dim returnDistLaenge As Double
Dim returnDistStaerke As Double

returnDistLaenge = ThisDrawing.Utility.GetDistance(Startpoint, _
EndLaenge)
returnDistStaerke = ThisDrawing.Utility.GetDistance(Startpoint, _
EndStaerke)

---

Wäre schön, wenn mir da jemand bei helfen könnte.

Vielen Dank im voraus.

Gruß

Dirk

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

---

lies die property Coordinates des Pl-Objektes aus

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Für die Länmge gibts doch das Property LENGTH

Code:

---

Public Sub GibLänge()
Dim Object As Object
Dim promt As String
Dim PickedPoint As Variant
Dim Länge As Double
On Local Error Resume Next
Prompt = "Objekt wählen:"
Utility.GetEntity Object, PickedPoint, Prompt
MsgBox "Objekt: <" & TypeName(Object) & " Länge: " & Object.Length
MsgBox Object.Thickness
End Sub

---

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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

---

 

Zitat:

---

Original erstellt von CAD-Huebner:
Für die Länge gibts doch das Property LENGTH

---

..das war aber nach dem geposteten Bildchen überhaupt nicht gemeint..

------------------
      - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Hallo,

Es geht Dirk im Prinzip um ein Problem zu diesem Thread.

Da hat Thomas schon Recht, das dort die Koordinaten der Polylinie ausgewertet werden müssen um an die Länge zu kommen. Ein Problem wirst du aber bekommen, wenn du den Wert für die Dicke herausbekommen willst, wenn die Schnale kannte nicht Rechtwinkelig zur Dicke ist, oder andere Formen / Fräsungen besitzt.

Für die Dicke würde ich eher über die GetBoundingbox-Methode gehen.

Gruß, Carsten

[Diese Nachricht wurde von Carsten1210 am 24. Mrz. 2008 editiert.]

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

---

Zitat:

---

Original erstellt von CADmium:
  ..das war aber nach dem geposteten Bildchen überhaupt nicht gemeint..

---

Mann, das Bild hab ich übersehen - na dann einfach ignorieren.

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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

---

Hi,

Im Endeffekt hat Dirk so etwas vor:

 

Gruß, Carsten

[Diese Nachricht wurde von Carsten1210 am 24. Mrz. 2008 editiert.]

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

---

PointList.jpg GetBoundingBox.jpg

Hallo zusammen!

Vielen Dank für die Anworten.
Das von Carsten ist schon das was ich erreichen möchte(unter anderem), aber wie kommt man da hin?
Mit der GetBounddingBox leget man ja ein Rechteck um das ausgewählte Objekt. Wie aber liest man dann die benötigten Koordinatenpunkte aus?
Folgendes habe ich nun mal probiert.
Koordinatenliste der Polylinie:

Code:

---

Sub PolylineCoordinatesPoint()
Dim Objekt As Object
Dim Prompt As String
Dim PointsList() As Double

On Local Error Resume Next
Promt = "Wählen Sie eine Linie aus"
ThisDrawing.Utility.GetEntity Objekt, PickedPoint, Prompt
If TypeName(Objekt) = "IAcadPolyline" Or "IAcadLWPolyline" Then
    PointsList = Objekt.Coordinates
End If
End Sub

---

Ergebnis aus dem Überwachungsfenster siehe Bildchen PointList.

Code:

---

Sub PolylineGetBondingBox()
Dim Objekt As Object
Dim Prompt As String
Dim MinPoint As Variant
Dim MaxPoint As Variant

On Local Error Resume Next
Promt = "Wählen Sie eine Linie aus"
ThisDrawing.Utility.GetEntity Objekt, PickedPoint, Prompt
If TypeName(Objekt) = "IAcadPolyline" Or "IAcadLWPolyline" Then
    Objekt.GetBoundingBox MinPoint, MaxPoint
End If
End Sub

---

Siehe Bildchen GetBoundingBox.

Was muß ich da tun, um zu dem gewüschten Ergebnis zu kommen.

Gruß

Dirk

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

---

Hi Dirk,

Wenn du nur die Dicke und die Länge heraus bekommen willst schau dir dieses Beispiel an.

Gruß, Carsten

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

---

Hallo Carsten!

Das ist prima, nur wenn du die *.dvb (zumindest die eine) verschlüsselst, hilft mir das nicht wirklich weiter, da mich ja der Programmcode ansich interessiert.

Für mich wäre wichtig zu wissen, wie berechnet man das, bzw. wie müßte der Quellcode lauten?

Gruß

Dirk

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

---

Hallo Dirk,

Hast du es denn mit der waagerecht liegenden PL hinbekommen?!
Laut der Beitragsüberschrift wolltest du doch nur die Stärke und die Dicke ausgewertet haben.

Für was würdest du denn so eine Funktion benötigen ausser für das Beispiel, was ich weiter oben angefügt habe.
Von dem Beispiel habe ich dir ja schon eine Vorabversion geschickt. Wenn die fertig ist, könnt ihr die, wie schon erwähnt kostenlos nutzen. Andere zahlen dafür. 
Warum willst du dann noch selber das ganze nach programmieren?!
Kannst mich ja anrufen oder ne Mail schicken.

Zu der BoundingBox: Du kannst dir die Box vorstellen, wie eine Kiste wo du deine Polylinie reinpackst, so wie die Polylinie liegt. Es werden die maximalen Abmaße der Polylinie in X- und Y-Achse der Draufsicht zurück gegeben. Überleg mal in die Richtung. 

Gruß, Carsten

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

---

Hallo und guten Morgen Carsten!

Vielen Dank für Dein Angebot, daß ich Dein Programm nutzen kann.
Mich interessiert es einfach wie das funktioniert und wie man das berechnet.
Wo für ich es später genau benötige kann ich noch nicht sagen.

Wie gesagt, mich interessiert es schon sehr, wie der source code lauten müßte.

Gruß

Dirk

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

---

Polylinie_02.jpg

Hallo Carsten!

Ich hab mir das mit der Methode GetBoundingBox mal angesehen.
Damit ermittelt man ja die untere linke und die obere rechte
Ecke als Rechteck um das ausgewählte Objekt gezogen.
Wie wertet man dann aber die benötigten Punkte der Polylinie
PKT0 / PKT1 / PKT2 aus, so das man diese mit der Methode GetDistance
abfragen kann.
Die rote Linie in dem Bildchen stellt den unteren linken und den oberen rechten Punkt dar.

Code:

---

Sub PolylineGetBondingBox()
Dim Objekt As Object
Dim Prompt As String
Dim MinPoint As Variant
Dim MaxPoint As Variant
Dim FromPT(2) As Double
Dim ToPT(2) As Double

On Local Error Resume Next
promt = "Wählen Sie eine Linie aus"
ThisDrawing.Utility.GetEntity Objekt, PickedPoint, Prompt
If TypeName(Objekt) = "IAcadPolyline" Or "IAcadLWPolyline" Then
    Objekt.GetBoundingBox MinPoint, MaxPoint
    FromPT(0) = MinPoint(0)
    FromPT(1) = MinPoint(1)
    ToPT(0) = MaxPoint(0)
    ToPT(1) = MaxPoint(1)
    ThisDrawing.ModelSpace.AddLine FromPT, ToPT
End If
End Sub

---

Wie berechnet bzw. ermittelt man diese 3 Punkte.
Anhand dieser Punkte könnte ich dann ja die Länge und stärke ermitteln.

Beispiel:

Code:

---

Sub GetDistancePointToPoint()
Dim MLaenge As Double
Dim MStaerke As Double

MLaenge = ThisDrawing.Utility.GetDistance(PKT0, PKT1)
MStaerke = ThisDrawing.Utility.GetDistance(PKT0, PKT2)

End Sub

---

Wäre schön wenn Du oder das Forum mir dabei helfen könntet.

Gruß

Dirk

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

---

Hi Dirk,

Schau dir doch mal die Koordinatenliste der Polylinie an. Da sind doch alle Punkte (2d) der Polylinie drin gespeichert.

Das sollte doch nicht so schwer sein, oder?!

Gruß, Carsten

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

---

Poly_01.jpg Poly_02.jpg

Hallo Carsten!
Hallo Forum!

Zitat:

---

Das sollte doch nicht so schwer sein, oder?!

---

Leider doch!!!!
Die Coordinaten der Polylinie auslesen ist OK.
Wie kann ich aber den Punkt 2 lotrecht zu Punkt 0 in den Bildchen berechnen?

Kann mir da jemand weiterhelfen?

Gruß

Dirk

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

---

Zitat:

---

Original erstellt von Dirk.B:
Hallo Carsten!
Hallo Forum!

Leider doch!!!!
Die Coordinaten der Polylinie auslesen ist OK.
Wie kann ich aber den Punkt 2 lotrecht zu Punkt 0 in den Bildchen berechnen?

Kann mir da jemand weiterhelfen?

Gruß

Dirk

---

matrhematisch hast du da zwar Blödsinn geschrieben, aber wenn eine Gerade den Anstieg a=dy/dx hat, dann hat die senkrechte dazu den Anstieg -1/a .. Alles Klar?

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Hallo CADmium!

Irgendwie ist nichts klar  und ich komme da nicht weiter.
Wahrscheinlich sehe ich vor lauter Bäume den Wald nicht.

Dies habe ich bislang:

Code:

---

Public Function MeinDistance(FromPoint, ToPoint) As Double
On Local Error Resume Next
MeinDistance = Sqr((FromPoint(0) - ToPoint(0)) ^ 2 + (FromPoint(1) - ToPoint(1)) ^ 2)
End Function

Private Sub CommandButton2_Click()

Dim Objekt As Object
Dim Prompt As String
Dim PKTList() As Double
Dim FirstPt(2) As Double
Dim SecondPt(2) As Double
Dim LaDist As Variant
Dim StDist As Variant
Dim VarPKT As Variant
Dim StaPKT As Variant
Dim CorList As Variant
Dim StpCount As Variant
Dim PKT0(2) As Double
Dim PKT1(2) As Double
Dim PKT2(2) As Double

Dim MLaenge As Double
Dim MStaerke As Double
Dim MWinkel As Double

On Local Error Resume Next
Me.Hide

promt = "Wählen Sie eine PLinie aus"

ThisDrawing.Utility.GetEntity Objekt, PickedPoint, Prompt
If TypeName(Objekt) = "AcadPolyline" Or "AcadLWPolyline" Then
    PKTList = Objekt.Coordinates
    StaPKT = (UBound(PKTList) + 1) / 2
    VarPKT = Objekt.Coordinate(0)
    CorList = UBound(PKTList) + 1
    StpCount = UBound(PKTList) + 1  '/ CorList

    PKT0(0) = VarPKT(0)
    PKT0(1) = VarPKT(1)

    PKT1(0) = PKTList((StpCount / StpCount) + 1)
    PKT1(1) = PKTList((StpCount / StpCount) + 2)

    PKT2(0) = PKTList((StpCount / StpCount) + 3)
    PKT2(1) = PKTList((StpCount / StpCount) + 4)
 
'MLaenge = MeinDistance(PKT0, PKT1)
'MStaerke = MeinDistance(PKT1, PKT2)
'MWinkel = ThisDrawing.Utility.AngleFromXAxis(PKT0, PKT1)

If MeinDistance(PKT1, PKT2) < MeinDistance(PKT0, PKT1) Then
    MLaenge = MeinDistance(PKT0, PKT1)
    MStaerke = MeinDistance(PKT1, PKT2)
    MWinkel = ThisDrawing.Utility.AngleFromXAxis(PKT0, PKT1)
    Else
    MLaenge = MeinDistance(PKT1, PKT2)
    MStaerke = MeinDistance(PKT0, PKT1)
    MWinkel = ThisDrawing.Utility.AngleFromXAxis(PKT1, PKT2)
End If

TextBox1.Value = ThisDrawing.Utility.RealToString(MLaenge, acDecimal, ThisDrawing.GetVariable("Luprec"))
TextBox2.Value = ThisDrawing.Utility.RealToString(MStaerke, acDecimal, ThisDrawing.GetVariable("Luprec"))
TextBox3.Value = ThisDrawing.Utility.AngleToString(MWinkel, acDegrees, ThisDrawing.GetVariable("Auprec"))
   
End If
End Sub

---

Schönes Restwochenende noch.

Gruß

Dirk

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

---

Hi Dirk,

Probier mal folgendes:

Code:

---

    Dim polarPnt As Variant
    Dim angle As Double
    Dim distance As Double
    angle = (ThisDrawing.Utility.AngleFromXAxis(PKT0, PKT1) + PI / 2)
    distance = MStaerke
    polarPnt = ThisDrawing.Utility.PolarPoint(PKT0, angle, distance)
    Dim lineObj As AcadLine
    Set lineObj = ThisDrawing.ModelSpace.AddLine(PKT0, polarPnt)

---

Der Punkt 2 wird auf Basis der Plattenstärke und dem Winkel der Langen Kante + 90° von Punkt 0 aus mit der Funktion PolarPoint berechnet. Danach wird eine Linie von Punkt 0 nach Punkt 2 erstellt.

Kommst du damit dann weiter?!

Du solltest auch mal dein privates E-Mail Postfach ausmisten. Wenn man dir eine Mail dahin schickt, gibt es eine Fehlermeldung, die Angibt, das dein Postfach voll ist.

Gruß, Carsten

[Diese Nachricht wurde von Carsten1210 am 20. Apr. 2008 editiert.]

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