| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: custom_mittellinie (1050 mal gelesen)
|
cacysunlee Mitglied Konstruktion, Acad-3D
Beiträge: 67 Registriert: 27.08.2003 AcadMech-2010
|
erstellt am: 12. Jun. 2007 13:36 <-- editieren / zitieren --> Unities abgeben:
hallo zusammen, Wie stelle ich es an, das wenn ich eine normale Linie zeichne, das autocad selber die beiden Ende der Linie um den Faktor 1.1 verlängert. Damit könnte man viel schneller normale Mittelinien zeichnen. (Für Kreise gibt es ja schon von acad was fertiges, aber halt eben nur für Kreise.) Ist sowas möglich? wenn ja wie. Ich habe leider keine großen Erfahrungen mit VBA PS: ich habe acad'08 ------------------ www.amdir.de Meine kleine Rendergallerie aus alten Acad2000 und Acad2005 Zeiten : Reindampferzeuger Kesselraum Heizstation Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1357 Registriert: 24.07.2002
|
erstellt am: 12. Jun. 2007 13:58 <-- editieren / zitieren --> Unities abgeben: Nur für cacysunlee
Hi cacysunlee, Hab mal schnell was zusammen geklöppelt: Code: Option Explicit Public Sub test() Dim Distance As Double Dim Angle As Double Dim Linie As AcadLine Dim promt As String Dim Pickedpoint As Variant On Local Error Resume Next promt = "Linie wählen:" Utility.GetEntity Linie, Pickedpoint, promt If TypeName(Linie) = "IAcadLine" Then Distance = 1.1 Angle = Linie.Angle + 3.14159 Linie.StartPoint = ThisDrawing.Utility.PolarPoint(Linie.StartPoint, Angle, Distance) Linie.EndPoint = ThisDrawing.Utility.PolarPoint(Linie.EndPoint, Linie.Angle, Distance) End If End Sub
Viel Spass damit. Gruß, Carsten 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: 12. Jun. 2007 14:03 <-- editieren / zitieren --> Unities abgeben: Nur für cacysunlee
Hallo, da du hier im VBA Forum bist mal eine Antwort aus dieser Sicht: Das kann man mit VBA schon programmieren. Aber mit wenig VB Kenntnissen sehe ich da nicht viel Chancen. Aber da gibt es bestimmt schon was. Ich denke aber das der Beitrag im "Rund um AutoCAD" Forum besser aufgehoben ist, da hier alle (auch die Lisp'ler ) lesen und einer eine Lösung bzw. einen Tipp hat. Wenn du möchest, können wir den Beitrag dorthin verschieben um Crossposts zu vermeiden. Viel Erfolg 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 |
Stelli1 Moderator Verm.-Ing.
Beiträge: 1521 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 12. Jun. 2007 14:07 <-- editieren / zitieren --> Unities abgeben: Nur für cacysunlee
|
cacysunlee Mitglied Konstruktion, Acad-3D
Beiträge: 67 Registriert: 27.08.2003 AcadMech-2010
|
erstellt am: 13. Jun. 2007 09:19 <-- editieren / zitieren --> Unities abgeben:
Danke für die schnellen Antworten ! Wenn ich das Script als Makro ausführe, erhalten ich folgende Fehlermeldung "Fehler beim Kompilieren. Variable nicht definiert" Dabei markiert VBA das Wort "Utility" an. Bei der Deklaration der Variablen mit dim sind aber auch keine Schreibfehler, deswegen verstehe ich auch nicht, warum die Fehlermeldung kommt. Muss ich vorher was bestimmtes machen, bevor ich das Makro ausführe? ------------------ www.amdir.de Meine kleine Rendergallerie aus alten Acad2000 und Acad2005 Zeiten : Reindampferzeuger Kesselraum Heizstation Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1357 Registriert: 24.07.2002
|
erstellt am: 13. Jun. 2007 09:25 <-- editieren / zitieren --> Unities abgeben: Nur für cacysunlee
Hi, Schreib mal ein "thisdrawing." vor das Utility... , dann sollte es auch in einem Modul funktionieren. Ich hatte das in einen Projekt unter ThisDrawing stehen (Da kann man das ThisDrawing davor weglassen). Gruß, Carsten Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cacysunlee Mitglied Konstruktion, Acad-3D
Beiträge: 67 Registriert: 27.08.2003 AcadMech-2010
|
erstellt am: 13. Jun. 2007 10:28 <-- editieren / zitieren --> Unities abgeben:
Danke, jetzt funktioniert es prima. Frage zu Modifikation : Wo muss ich vorher im Script "ThisDrawing.ModelSpace.AddLine" einfügen und "GetLastEntity Linie" oder sowas. Also quasi, wenn ich das Makro ausführe, dann soll man erstmal eine ganz normale Linie zeichnen und anschließend soll diese automatisch verlängert werden.
------------------ www.amdir.de Meine kleine Rendergallerie aus alten Acad2000 und Acad2005 Zeiten : Reindampferzeuger Kesselraum Heizstation Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1357 Registriert: 24.07.2002
|
erstellt am: 13. Jun. 2007 10:37 <-- editieren / zitieren --> Unities abgeben: Nur für cacysunlee
Hi, Wenn du die Linie per Set Linie = ... erstellt hast kannst du ja einfach mit dem Konstrukt aus dem If-Teil weitermachen, da dort dann ja auf "Linie" verwiesen wird. Du kannst aber auch, wenn du die beiden Punkte (Start- und Endpunkt) hast, direkt mit dem Polarpoint die neuen Linienendpunkte berechnen und dann erst die Linie erstellen. Gruß, Carsten [Diese Nachricht wurde von Carsten1210 am 13. Jun. 2007 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cacysunlee Mitglied Konstruktion, Acad-3D
Beiträge: 67 Registriert: 27.08.2003 AcadMech-2010
|
erstellt am: 13. Jun. 2007 10:53 <-- editieren / zitieren --> Unities abgeben:
Ich schaffe es nicht, den Start- und Endpunkt zu holen Hier der Quellcode : Public Sub mitellinie() 'Variablen deklarieren' Dim Distance As Double Dim Angle As Double Dim Linie As AcadLine Dim StartPoint(0 To 2) As Double Dim EndPoint(0 To 2) As Double Dim promt As String Dim Pickedpoint As Variant StartPoint(0) = 0 StartPoint(1) = 0 StartPoint(2) = 0 EndPoint(0) = 0 EndPoint(1) = 0 EndPoint(2) = 0 On Local Error Resume Next 'Start- und EndPunkt holen' promt = "Start wählen:" ThisDrawing.Utility.GetEntity StartPoint, Pickedpoint, promt promt = "Endpunkt wählen:" ThisDrawing.Utility.GetEntity EndPoint, Pickedpoint, promt 'Berechnung der Mittellinie' If TypeName(Linie) = "IAcadLine" Then Distance = 1.5 Angle = Linie.Angle + 3.14159 Linie.StartPoint = ThisDrawing.Utility.PolarPoint(Linie.StartPoint, Angle, Distance) Linie.EndPoint = ThisDrawing.Utility.PolarPoint(Linie.EndPoint, Linie.Angle, Distance) End If 'Mittellinie zeichnen' Set Linie = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint) 'Layer anpassen' With oAcadLine .color = 256 .Layer = "Linie 05" .Linetype = "ByLayer" .LinetypeScale = 1 .Lineweight = -1 .Thickness = 0 End With End Sub ------------------ www.amdir.de Meine kleine Rendergallerie aus alten Acad2000 und Acad2005 Zeiten : Reindampferzeuger Kesselraum Heizstation Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1357 Registriert: 24.07.2002
|
erstellt am: 13. Jun. 2007 11:45 <-- editieren / zitieren --> Unities abgeben: Nur für cacysunlee
Hi, Hier mal der überarbeitete Code: Code: Public Sub mitellinie() 'Variablen deklarieren' Dim Distance As Double Dim Angle As Double Dim Linie As AcadLine Dim StartPoint As Variant Dim EndPoint As VariantOn Local Error Resume Next 'Start- und EndPunkt holen' StartPoint = ThisDrawing.Utility.GetPoint(, "1. Punkt angeben: ") '1. Punkt abfragen EndPoint = ThisDrawing.Utility.GetPoint(, "2. Punkt angeben: ") '2. Punkt abfragen 'Mittellinie zeichnen' Set Linie = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint) 'Berechnung der Verlängerung der Mittellinie' Distance = 1.5 Angle = Linie.Angle + 3.14159 Linie.StartPoint = ThisDrawing.Utility.PolarPoint(Linie.StartPoint, Angle, Distance) Linie.EndPoint = ThisDrawing.Utility.PolarPoint(Linie.EndPoint, Linie.Angle, Distance) 'Layer anpassen' With Linie .color = 256 .Layer = "Linie 05" .Linetype = "ByLayer" .LinetypeScale = 1 .Lineweight = -1 .Thickness = 0 End With End Sub
Da waren dann doch noch einige Fehler drin. Schau dir das mal an, und wenn noch Fragen sind kannst du dich ja einfach noch mal melden. Gruß, Carsten
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cacysunlee Mitglied Konstruktion, Acad-3D
Beiträge: 67 Registriert: 27.08.2003 AcadMech-2010
|
erstellt am: 13. Jun. 2007 11:55 <-- editieren / zitieren --> Unities abgeben:
|