| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Polylinien in Linien aufsplitten (2255 mal gelesen)
|
Benny4 Mitglied Softwareentwickler
Beiträge: 178 Registriert: 16.02.2006 AutoCAD 2010 ZW-CAD 2012
|
erstellt am: 30. Nov. 2007 14:00 <-- editieren / zitieren --> Unities abgeben:
Hallo Forum, ich möchte Polylinien, die auch Kreisbögen enthalten können, in Linien konvertieren. Es sollten z.B. alles 1mm lange Linien entlang der Bögen erzeugt werden. Dadurch ist der Bogen nicht mehr perfekt, aber wenigstens annähernd. Das brauche ich, um mit der Funktion SelectByPolygon arbeiten zu können. Dieser Funktion kann ja nur Punkte geben, und keine Polylinien. Oder Punkte mit einem Bulge-Wert, wie das bei Polylinien der Fall ist. Im Prinzip bräuchte ich in VBA genau das, was mit Lips mit dem Progamm Polyfit gemacht wird-->[URL=http://polyface.de/polyfit/Beschreibung.html][/URL]
Kann mir da jemand weiterhelfen? Oder vielleicht ein anderer Ansatz: Kann ich eine mit einem Lips-Programm modifizierte Polylinie in VBA einlesen, damit ich Koordinaten zur verfügung habe? Natürlich ohne dass der Benutzer was davon mitbekommt.
Danke schon mal für jeden guten Tipp!
------------------ Grüsse Benny Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
tunnelbauer Ehrenmitglied V.I.P. h.c. Bauingenieur
Beiträge: 7085 Registriert: 13.01.2004 ich hab eh keine Probleme damit...
|
erstellt am: 30. Nov. 2007 14:12 <-- editieren / zitieren --> Unities abgeben: Nur für Benny4
|
Benny4 Mitglied Softwareentwickler
Beiträge: 178 Registriert: 16.02.2006 AutoCAD 2010 ZW-CAD 2012
|
erstellt am: 30. Nov. 2007 14:28 <-- editieren / zitieren --> Unities abgeben:
Es hat noch andere Gründe, warum ich das mit VBA mache. Muss z.B. wenn die Polylinie gegen den Uhrzeigersinn gezeichnet wurde, die Polylinie im Uhrzeigersinn nachzeichnen! Gibt es z.B. das Teilen von AutoCAD so auch in VBA? ------------------ Grüsse Benny Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Benny4 Mitglied Softwareentwickler
Beiträge: 178 Registriert: 16.02.2006 AutoCAD 2010 ZW-CAD 2012
|
erstellt am: 30. Nov. 2007 17:27 <-- editieren / zitieren --> Unities abgeben:
|
Stelli1 Moderator Verm.-Ing.
Beiträge: 1521 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 30. Nov. 2007 17:43 <-- editieren / zitieren --> Unities abgeben: Nur für Benny4
|
Benny4 Mitglied Softwareentwickler
Beiträge: 178 Registriert: 16.02.2006 AutoCAD 2010 ZW-CAD 2012
|
erstellt am: 03. Dez. 2007 09:25 <-- editieren / zitieren --> Unities abgeben:
Ich zeichen vom Startpunkt der Polylinie ausgehend einen Kreis mit dem Radius, welcher der Segmentlänge entspricht, wie ich sie haben will. (z. B. 1mm). Dann Zeichen ich vom Schnittpunkt des Kreises und der ´Polylinie ausgehend den nächsten Kreis. Und das so lange, bis ich die ganze Polylinie habe. Und anhand der ganzen Schnittpunkte krieg ich dann meine neue Polylinie raus. ------------------ Grüsse Benny Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Stelli1 Moderator Verm.-Ing.
Beiträge: 1521 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 03. Dez. 2007 20:21 <-- editieren / zitieren --> Unities abgeben: Nur für Benny4
Hallo Benny, es hat mich doch irgendwie nicht in Ruhe gelassen. Ich hab mal eine Routine gemacht die nicht in mm Segmenten arbeitet sondern die Pfeilhöhe (Toleranz) berücksichtigt. Vielleicht kannst du sie ja brauchen
Code: Type Punkt2D Rechts As Double Hoch As Double Bulge As Double End TypeSub polytest() Dim sset As AcadSelectionSet Set sset = ThisDrawing.PickfirstSelectionSet If sset.Count = 0 Then sset.Clear sset.SelectOnScreen End If Dim S_Punkte As Variant Dim Z_Punkte() As Punkt2D Dim LWPolyline As AcadLWPolyline Dim MaxPunkte As Long Set LWPolyline = sset(0) Punkte = LWPolyline.Coordinates MaxPunkte = (UBound(Punkte) + 1) / 2 ReDim Z_Punkte(1 To MaxPunkte) For i = 0 To UBound(Punkte) - 1 Step 2 Z_Punkte(i / 2 + 1).Rechts = Punkte(i) Z_Punkte(i / 2 + 1).Hoch = Punkte(i + 1) Z_Punkte(i / 2 + 1).Bulge = LWPolyline.GetBulge(i / 2) Next i Dim Strecke As Double Dim Pfeilhöhe As Double i = 1 While i < MaxPunkte If Z_Punkte(i).Bulge <> 0 Then dy = Z_Punkte(i + 1).Rechts - Z_Punkte(i).Rechts dx = Z_Punkte(i + 1).Hoch - Z_Punkte(i).Hoch Strecke = Sqr(dy ^ 2 + dx ^ 2) Pfeilhöhe = (Strecke / 2) * Z_Punkte(i).Bulge * -1 If Abs(Pfeilhöhe) > 0.01 Then MaxPunkte = MaxPunkte + 1 ReDim Preserve Z_Punkte(1 To MaxPunkte) ' Alle danach nach oben schieben For z = MaxPunkte To i + 2 Step -1 Z_Punkte(z) = Z_Punkte(z - 1) Next z ' Punkt einrechnen/einfügen Z_Punkte(i + 1).Rechts = Z_Punkte(i).Rechts + (dy / 2) - (Pfeilhöhe / Strecke) * dx Z_Punkte(i + 1).Hoch = Z_Punkte(i).Hoch + (dx / 2) + (Pfeilhöhe / Strecke) * dy Z_Punkte(i + 1).Bulge = Tan(Atn(Z_Punkte(i).Bulge) / 2) Z_Punkte(i).Bulge = Z_Punkte(i + 1).Bulge ' Punkt um eins zurücksetzen i = i - 1 End If End If i = i + 1 Wend Dim LWPunkte() As Double ReDim LWPunkte(0 To MaxPunkte * 2 - 1) ' Punkte als Array abfüllen For i = 1 To MaxPunkte LWPunkte((i - 1) * 2) = Z_Punkte(i).Rechts LWPunkte(((i - 1) * 2) + 1) = Z_Punkte(i).Hoch Next i Set LWPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(LWPunkte) LWPolyline.color = acRed LWPolyline.Update End Sub
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 |