---

Wir arbeiten mit acad 2002.
Beispiel: Man ziehe eine Linie, von einem Anfangspunkt in eine beliebige Richtung, beliebig lang.
Aufgabe: Acad erstellt gleichzeitig eine zweite spiegelbildliche Linie oder erstellt eine neue Linie vom Endpunkt der ersten zum Endpunkt der zweiten gespiegelten Linie.
Wäre sehr praktisch beim erstellen von Mittellinien.
Kennt jemand eine Möglichkeit dies zu bewerkstelligen.

Vielen Dank
Jukni

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

---

ich kann dir zumindest sagen das dies geht ! Jo

was für Mittellinien?
Rohre?

------------------
Gruß Sebastian ,FFM

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

---

hi,
also so ganz ist mir die Problematik nicht klar geworden.
Willst du mehrere Linien gleichzeitig zeichnen?
Dann mußt du es mit Multilinie mal versuchen.

------------------

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

---

Hallo Jukni,
eine gute Idee, leicht zu programmieren, drum werde ich das auch machen.
Soll das Tool auch gleichzeitig eine Linie die um 90° gedreht ist zeichnen? Wär doch auch nicht schlecht, oder?

------------------
Roland

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

---

Das wäre nett Roland.
Wenn Du das mal machen könntest.
Danke

jukni

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

---

Einfach in VBA einfügen

Code:

---

Public Sub AchsKreuz()

    Dim MP As Variant
    Dim EP As Variant
   
    Dim Achse1 As AcadLine
    Dim Achse2 As AcadLine
   
    On Error GoTo ENDE
    MP = ThisDrawing.Utility.GetPoint(, "Mittelpunkt: ")
    EP = ThisDrawing.Utility.GetPoint(ThisDrawing.Utility.TranslateCoordinates(MP, acWorld, acUCS, False), "Endpunkt: ")
   
    Select Case ThisDrawing.ActiveSpace
        Case acModelSpace
            Set Achse1 = ThisDrawing.ModelSpace.AddLine(MP, EP)
           
        Case acPaperSpace
            Select Case ThisDrawing.MSpace
                Case True
                    Set Achse1 = ThisDrawing.ModelSpace.AddLine(MP, EP)
                   
                Case False
                    Set Achse1 = ThisDrawing.PaperSpace.AddLine(MP, EP)
               
            End Select
    End Select
   
    Achse1.ScaleEntity EP, 2#
    Set Achse2 = Achse1.Copy
    Achse2.Rotate MP, 4 * Atn(1) / 2
   
ENDE:

End Sub

---

------------------
Roland

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

---

OK, jetzt hab ich überhaupt keine Ahnung mehr worum es ihm ging, aber
im Zusammenhang mit einem Kreis-Achs-Kreuz wäre im LT-Forum der Beitrag "Kreuz im Kreis" :
http://www.cad.de/foren/ubb/Forum53/HTML/000211.shtml

ist garnicht lange her, aber wer sucht schon im Lt-Forum nachŽner
Lisp...

------------------
Gruß Sebastian ,FFM

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

---

Das ganze jetzt auch für ungleiche Achslängen

Code:

---

Public Sub AchsKreuzUngleich()

    Dim MP As Variant
    Dim EP1 As Variant
    Dim EP2 As Variant
   
    Dim Abstand1 As Double
    Dim Abstand2 As Double
   
    Dim Achse1 As AcadLine
    Dim Achse2 As AcadLine
   
    On Error GoTo ENDE
    MP = ThisDrawing.Utility.GetPoint(, "Mittelpunkt: ")
    EP1 = ThisDrawing.Utility.GetPoint(ThisDrawing.Utility.TranslateCoordinates(MP, acWorld, acUCS, False), "Endpunkt der ersten Achse: ")
    On Error GoTo Err_Control
    EP2 = ThisDrawing.Utility.GetPoint(ThisDrawing.Utility.TranslateCoordinates(MP, acWorld, acUCS, False), "Länge der zweiten Achse [Gleich]: ")
EP2:

    Abstand1 = funDist(MP, EP1)
    Abstand2 = funDist(MP, EP2)
    If Abstand1 = 0 Then
        GoTo ENDE
    ElseIf Abstand2 = 0 Then
        GoTo ENDE
    End If
       
   
    Select Case ThisDrawing.ActiveSpace
        Case acModelSpace
            Set Achse1 = ThisDrawing.ModelSpace.AddLine(MP, EP1)
           
        Case acPaperSpace
            Select Case ThisDrawing.MSpace
                Case True
                    Set Achse1 = ThisDrawing.ModelSpace.AddLine(MP, EP1)
                   
                Case False
                    Set Achse1 = ThisDrawing.PaperSpace.AddLine(MP, EP1)
               
            End Select
    End Select
   
    Achse1.ScaleEntity EP1, 2#
    Set Achse2 = Achse1.Copy
    Achse2.Rotate MP, funPI / 2
    Achse2.ScaleEntity MP, Abstand2 / Abstand1
   
ENDE:
    Exit Sub
   
Err_Control:
    Select Case Err.Number
        Case -2145320928
            'User input is keyword or..
            'Right click
            Err.Clear
            EP2 = EP1
            Resume EP2
        Case Else
            Resume ENDE
    End Select

End Sub

Public Function funPI()

    funPI = 4 * Atn(1)

End Function

' Abstand zwischen Punkt1 und Punkt2
Public Function funDist(Punkt1, Punkt2)
    Dim Dist As Double
    Dim I As Long
   
    On Error Resume Next
    For I = LBound(Punkt1) To UBound(Punkt1)
        Dist = Dist + ((Punkt1(I) - Punkt2(I)) ^ 2)
        If Err Then Exit For
    Next

    funDist = Sqr(Dist)
   
End Function

---

------------------
Roland

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

---

Icons.zip

Anbei zwei Icons für den Werkzeugkasten.

Hier der Code für das Menü:

Code:

---

ID_AchskrG    [_Button("Achskreuz gleichschenkelig", "AchskrG.bmp", "AchskrG.bmp")]^C^C-VBARUN;acad.dvb!Block.AchsKreuzGleich;
ID_AchskrUG  [_Button("Achskreuz ungleichschenkelig", "AchskrUG.bmp", "AchskrUG.bmp")]^C^C-VBARUN;acad.dvb!Block.AchsKreuzUngleich;

---

Ich habe das Modul Block genannt (es steht nach dem !), einfach in deinen Namen umbenennen, schon sollte es funktionieren.

------------------
Roland

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

---

Danke Roland für deine Mühe.
Leider weis ich nicht wie ich aus Deinen Listings ein
lauffähiges VBA-Programm machen kann.
Wenn du mir das vielleicht erklären könntest.

mfg

Jürgen

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

---

Hallo Jürgen,
einfach mit vbaide den VBA-Editor aufrufen.
Auf der linken Seite findest du den Projektexplorer, hier auf rchte Maustaste und neues Modul einfügen.
Unter Module das neue Modul auswählen und im Eigenschaftenfenster den Namen auf "Block" ändern. Dann die Datei unter acad.dvb speichern. Warum acad.dvb? Weil diese Datei automatisch geladen wird.

Das Modul mit Doppelklick öffnen.
Dann einfach die obendstehenden Zeilen hineinkopieren, das war's.

Alles klar?

------------------
Roland

[Diese Nachricht wurde von RoSiNiNo am 28. Oktober 2002 editiert.]

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

---

Hey RoSiNiNo,
das ist ein affengeiles Tool!

Danke
Günter

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