---

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

---

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

---

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

---

Mal wieder zu langsam...

Carsten hat die "Auftragsprogrammierung" schon fertig. 

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

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

---

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

---

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

---

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

---

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

---

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

---

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 Variant

On 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

---

Jetzt funktioniert es bestens !
Vielen Dank für die Hilfe ! 

Und ich habe auch wieder etwas VBA gelernt 

------------------
www.amdir.de

Meine kleine Rendergallerie aus alten Acad2000 und Acad2005 Zeiten :
Reindampferzeuger
Kesselraum
Heizstation

[Diese Nachricht wurde von cacysunlee am 13. Jun. 2007 editiert.]

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