---

Hallo,
da mir in diesem Forum schon viel geholfen wurde, möchte ich auch mal was konstruktives beisteuern.

Das Tool erzeugt ein Auswahl-Listenfeld.

;Das LISP-Programm: ListeDN.lsp
(defun C:ListeDN ()

  (setq NAMES '("DN10" "DN20" "DN25" "DN30" "DN40" "DN50"
"DN65" "DN80" "DN100" "DN125" "DN150" "DN200")
  )
  (setq dcl_id (load_dialog "ListeDN.dcl"))
  (if (not (new_dialog "ListeDN" dcl_id)
      )
    (exit)
  )
  (start_list "selections")
  (mapcar 'add_list NAMES)
  (end_list)
  (action_tile
    "accept"
    (strcat
      "(progn

      (setq SIZ (atof (get_tile \"selections\")))"
      "(done_dialog) (setq userclick T))"
    )
  )
  (action_tile "cancel" "(done_dialog) (setq userclick nil)")
  (start_dialog)
  (unload_dialog dcl_id)
  (if userclick
    (progn   
      (setq SIZ (fix SIZ))
      (setq SIZ (nth SIZ NAMES))
      (command "_text" "p" "ul" (getpoint "\n=> Einfügepunkt") 3 pause SIZ)
    )
  )
(princ)
)
(princ)

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

//Das Listen-Programm: ListeDN.dcl
ListeDN : dialog { //dialog name
        label = " Leitungsdurchmesser" ; //give it a label
: list_box { //define list box
        key = "selections"; //give it a name
        height = 15;
allow_accept = true; //allow double click
} //end list

        ok_cancel ; //predefined OK/Cancel button

        } //end dialog

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

---

Hallo Vision,

Ich finde das echt super, dass du ungefragt! einfach deine Lösung hier postest!
Verstehe das folgende bitte als konstruktive Kritik!

Du musst dir unbedingt das Variablenhandling anschauen
(defun name (parameter / lokaleVariablen)
Alles was hinter dem / als lokale variable deklariert ist, wird bei Beendigung der Routine wieder auf nil gesetzt (gelöscht). Beachtest du dieses ersparst du dir sehr viel Fehlersuche, weshalb ein Tool mal läuft, und an einem anderen Tag mal wieder nicht.
Die Parameter stehen vor dem /. Diese Variablen werden durch das aufrufende Programm mit Werten gefüttert. Ein (setq ..) ist somit überflüssig. Es geht hierbei nicht um die Einsparung einer Programmzeile, es geht vielmehr darum, diese Sachen auch sinnvoll für sich einsetzen zu können. Ziel ist es wieder verwendbaren Code zu schreiben.
Deshalb ist es notwendig, deine Lisp in 2 Lisp's zu teilen. Eine übernimmt das Handling des Dialogfensters, die andere ruft dieses auf und verarbeitet den Rückgabewert. Auf diese Weise kannst du sehr schnell viele unterschiedliche Funktionen erzeugen. (Lisp over night!)
Ich habe Deinen Code dahingehend angepasst und auch gleich noch eine zusätzliche Funktion definiert.

Code:

---

(defun c:listeDN (/ wert)
  (setq wert
(DIA:Liste
  '("DN10" "DN20" "DN25" "DN30" "DN40" "DN50"
    "DN65" "DN80" "DN100" "DN125" "DN150" "DN200")
  )
)
  (if wert
    (command "_text" "p" "ul" (getpoint "\n=> Einfügepunkt") 3 pause wert)
    (princ "\nAbbruch")
    )
  )
(defun c:listeAnrede (/ wert)
  (setq wert
(DIA:Liste
  '("Hallo" "Guten Tag" "Hi" "Guten Abend" "Salü" "Tach")
  )
)
  (if wert
    (command "_text" "p" "ul" (getpoint "\n=> Einfügepunkt") 3 pause wert)
    (princ "\nAbbruch")
    )
  )
(defun DIA:Liste (NAMES / dcl_id ns SIZ)
  (setq dcl_id (load_dialog "ListeDN.dcl"))
  (if (not (new_dialog "ListeDN" dcl_id)
  )
    (exit)
    )
  (start_list "selections")
  (mapcar 'add_list NAMES)
  (end_list)
  (action_tile "accept" "(setq SIZ (atoi (get_tile \"selections\")))(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
  (setq ns (start_dialog))
  (unload_dialog dcl_id)
  (if (/= 0 ns)
    (nth SIZ NAMES)
    )
)

---

Am Dialogfenster habe ich nichts geändert.
Allerdings am Aufruf. Die Funktiopn (start_dialog) gibt den Wert zurück, der im (action_tile...) dem (done_dialog 0) übergeben wird. Auf diese weise ist es nicht nur möglich wieder ein (setq..) zu sparen, sondern einfach alle möglichen Zustände, weshalb ein Dialogfenster verlassen/ausgeblendet wird zu erfassen. Als Bsp sei das Schraffur-Dialogfenster genannt, welches man nicht nur über ok oder Abbrechen verlassen kann.

Nochmal: Super!

Bei Fragen ...

Grüße Holger

------------------
Holger Brischke
(defun - Lisp over night!
AutoLISP-Programmierung für AutoCAD
Da weiß man, wann man's hat!

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

---

danke euch beiden für das/die Lisp-Programm(e). 20 Unities sind da mehr als gerechtfertigt.

------------------
"Lisp?!?! Why the Hell did you pick the most arcane, obscure, and hopelessly-rooted-in-the-computer-science-department language in the world for an AutoCAD programming language?"  Read the whole story: The Autodesk File ca. 890 Seiten | 7500 KB PDF

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

---

Hi,

wie kann man sich eigentlich die Listeneinträge aus einer bestimmten editierbaren externen Text-Datei holen. Das hätte den Vorteil, dass in der LISP-Datei nicht permanent rumfummeln muss, sondern einfach nur die externe Datei erweitern muss. Ansonsten finde ich das Tool superscharf.

Gruß

CAD-Tötti 

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

---

Hallo CAD-Tötti,

die Frage wäre ohnehin besser im LISP-Forum aufgehoben, deshalb schau mal hier.

Bei Fragen ...

Grüße Holger

------------------
Holger Brischke
(defun - Lisp over night!
AutoLISP-Programmierung für AutoCAD
Da weiß man, wann man's hat!

[Diese Nachricht wurde von Brischke am 10. Feb. 2004 editiert.]

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

---

Lisp.zip

Servus

Hier ist mein Senf dazu.

Mit dem Tool kann man aus zwei (Variabel) Listen auswählen.

Ist nur ein Aufruf nötig "textliste".

-1. Fenster kommt die Listenauswahl
-2. Fenster Textauswahl
-Wie der Text geschrieben werden soll (Mtext/Leader/Bemassung)
-Postion je nach vorhäriger Wahl

------------------
Same shit, different DAU. DAU Jones

  Bernd P.     

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

---

habe acad 2004 und folgende meldung:

Befehl: textliste
; Fehler: Beenden/Verlassen abbrechen

Befehl:

???

Grüße

CAD-Tötti 

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

---

Liste.zip

Servus

OOPS hab die Falsche DCL noch drinnen stehen.

Jetzt müsste es funktioniern

------------------
Same shit, different DAU. DAU Jones

  Bernd P.     

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

---

Echt gut wäre es jetzt ja noch, wenn die Textwerte in einer externen Text-Datei (erweiterbar) stehen würden, ohne immer in der LISP-Datei rumfummeln zu müssen. Naturlich muß das DCL-Feld auch diese (unendliche) Länge mitmachen können. Schon mal darüber nachgedacht ? Kriegste das hin ?

Grüße

CAD-Tötti 

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

---

Tagchen,

eine sehr schöne Idee wie ich finde!
Weiter so!

Da verteil ich doch mal was!

Alpschorsch

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

---

Jau

Das mit der Datei wär nicht schlächt. Dafür reichen aber meine Lisp Wissen nicht aus.

Hab für das Lisp nur das Obere umgeschrieben.

Das mit der DCl-Breite muss ich noch schauen.

------------------
Same shit, different DAU. DAU Jones

  Bernd P.     

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

---

Ach,

wo ich das gerade hier sehe!
An die Experten gerichtet!

Wieso sind in ACAD eigentlich so viele DCL-Felder in einer fixen Größe? z.B. _insert!
Warum macht man die nicht allgemein immer variabel?
Oder ist das programmiermäßig ein Problem?
Ich finde die kleinen Fenster nicht sehr bequem!

Nur mal so in den Raum gefragt!

Mfg Alpschorsch

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

---

Hülfe, hülfe  Experten, wo seid Ihr?

Habe mich vor Wochen auf Rat von Brischke mal ein wenig mit dieser externen Datei beschäftigt -> kam irgendwie nur Murks bei raus, muß das noch mal verinnerlichen  .

Aber das mit der variablen DCL-Box-Breite ist auch so'n Thema.

Grüße

CAD-Tötti 

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

---

erstellt von Alpschorsch:
Ach,

Wieso sind in ACAD eigentlich so viele DCL-Felder in einer fixen Größe? z.B. _insert!
Warum macht man die nicht allgemein immer variabel?
Oder ist das programmiermäßig ein Problem?
Ich finde die kleinen Fenster nicht sehr bequem!

Mfg Alpschorsch[/QUOTE]

das kannst du doch selbst in der acad.dcl oder der base.dcl ändern

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

---

@AsSchu

aber aber, wenn Er es könnte (selbst nachgelesen und getestet hätte), dann hätte er doch nicht gefragt !

------------------
- Sebastian Mattis -

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

---

Ups!

Das geht! Nadann ma los!
Wo steht was! Oder wie läuft das?

Mfg Alpschorsch

--------------------
Welcome to the Dateijungle!

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

---

Wie immer: AutoCAD eigene Hilfeseiten
oder im Forum nach DCL suchen (oder so)

(über den "Such-Verweis" nicht aufregen - ich habe selbst die Antowrt nicht parat..  )

und über einen Thread stolpern wo es evtl direkt beschrieben steht
(war glaube ich nicht allzulang her, da wollte ein Mädel mal sowas ändern und hat es gefunden / gepostet)

------------------
- Sebastian Mattis -

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

---

Mädel find ich gut! 
Dann lauf ich mal dem Täubchen hinterher! 
Aber gut zu wissen das es geht!

Alpschorsch läuft  und schaut hinterher 

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

---

Servus

HabŽs gefunden, aber da is leider nix mehr weiter gegangen.
"http://ww3.cad.de/foren/ubb/Forum54/HTML/003989.shtml

------------------
Same</A>  shit, different DAU. DAU Jones

  Bernd P.         

[Diese Nachricht wurde von Bernd P am 25. Feb. 2004 editiert.]

[Diese Nachricht wurde von Bernd P am 25. Feb. 2004 editiert.]

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

---

Vielleicht wollt ihr mal mein Textausrichten ausprobieren.
Vorsicht!!! Die Texte werden in das jeweilige Koordinatensystem gedreht. Die Drehung erfolgt um den EP des Textes, der Text wird dann erst verschoben. Der Einsetzpunkt wird in die jeweilige Lage verschoben, d.h. wenn der EP oben mittig ist und ich wähle linksbündig, wird er nach oben links gelegt.

Die Befehle können z.B. so wie folgt aufgerufen werden, wobei acad.dvb!Modify durch eure Werte ersetzt werden muß

Code:

---

(defun C:txtAusrRechts () (vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrRechts"))
(defun C:txtAusrLinks () (vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrLinks"))
(defun C:txtAusrMitte () (vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrMitte"))
(defun C:txtAusrEinpassen () (vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrEinpassen"))
(defun C:txtAusrAusgerichtet () (vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrAusgerichtet"))

---

Code:

---

Option Explicit

Public UCSX As Variant
Public UCSY As Variant

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' RoSiNiNo 21.11.2003
Public Sub txtAusrRechts()
    Call TextDrehenAusrichtenExecute(acHorizontalAlignmentRight)
End Sub

Public Sub txtAusrLinks()
    Call TextDrehenAusrichtenExecute(acHorizontalAlignmentLeft)
End Sub

Public Sub txtAusrMitte()
    Call TextDrehenAusrichtenExecute(acHorizontalAlignmentCenter)
End Sub

Public Sub txtAusrEinpassen()
    Call TextDrehenAusrichtenExecute(acHorizontalAlignmentFit)
End Sub

Public Sub txtAusrAusgerichtet()
    Call TextDrehenAusrichtenExecute(acHorizontalAlignmentAligned)
End Sub

Public Sub TextDrehenAusrichtenExecute(ByRef HorAlignment As AcHorizontalAlignment)
   
    Dim obj As AcadEntity
    Dim FltTypes(0 To 4) As Integer
    Dim FltData(0 To 4) As Variant
    Dim SS As AcadSelectionSet
    Dim Pt1 As Variant
    Dim Pt2 As Variant
    Dim Pt1Temp As Variant
    Dim Pt2Temp As Variant
    Dim objEP As Variant
    Dim objEPTemp As Variant
    Dim objEPNew As Variant
    Dim objAPNew As Variant
    Dim objAPTemp As Variant
    Dim objAttachmentPoint As AcAttachmentPoint
   
    Dim objUtil As AcadUtility
   
   
    ' Erstelle SelectionSet
    Set SS = CreateSelectionSet("TextDrehenAusrichtenAuswahl")

    FltTypes(0) = -4: FltData(0) = "<OR"
    FltTypes(1) = 0: FltData(1) = "TEXT"
    FltTypes(2) = 0: FltData(2) = "MTEXT"
    FltTypes(3) = 0: FltData(3) = "ATTDEF"
    FltTypes(4) = -4: FltData(4) = "OR>"
    SS.Clear
    SS.SelectOnScreen FltTypes, FltData
   
    If SS.Count = 0 Then GoTo Exit_Here
   
    On Error GoTo Err_Control
    Set objUtil = ThisDrawing.Utility
    Pt1 = objUtil.GetPoint(, vbCr & "Ausrichtungspunkt: ")
    Pt1Temp = objUtil.TranslateCoordinates(Pt1, acWorld, acUCS, False)
    If HorAlignment = acHorizontalAlignmentAligned Or HorAlignment = acHorizontalAlignmentFit Then
        Pt2 = objUtil.GetPoint(, vbCr & "zweiter Ausrichtungspunkt: ")
        Pt2Temp = objUtil.TranslateCoordinates(Pt2, acWorld, acUCS, False)
    End If
   
    For Each obj In SS
        Select Case obj.EntityType
            Case acText, acAttribute
           
                Dim transWinkel As Double
                Dim TextRot As Double
               
                GetUCSVector UCSX, UCSY
                If UCSX(0) = 1 And UCSY(1) = 1 Then
                    TextRot = 0
                ElseIf UCSX(0) = -1 And UCSY(1) = -1 Then
                    TextRot = funPI
               
                Else
                    transWinkel = Arccos(UCSX(0))
                    If Sgn(UCSX(1)) < 0 Then transWinkel = 2 * funPI + transWinkel
                    TextRot = transWinkel
                End If
               
                If obj.Alignment = 0 Or obj.Alignment = 3 Or obj.Alignment = 5 Then
                    objEP = obj.InsertionPoint
                Else
                    objEP = obj.TextAlignmentPoint
                End If
               
                If obj.Rotation <> TextRot Then TextScaleRot obj, TextRot
               
                objEPTemp = objUtil.TranslateCoordinates(objEP, acWorld, acUCS, False)
                objEPNew = objUtil.TranslateCoordinates(Point3D(CDbl(Pt1Temp(0)), CDbl(objEPTemp(1)), CDbl(objEPTemp(2))), acUCS, acWorld, False)
               
                If obj.Alignment = 4 Then obj.Alignment = 10
                obj.HorizontalAlignment = HorAlignment
               
                If HorAlignment = acHorizontalAlignmentAligned Or HorAlignment = acHorizontalAlignmentFit Then
                    obj.VerticalAlignment = acVerticalAlignmentBaseline
                End If
               
                If obj.Alignment = 0 Or obj.Alignment = 3 Or obj.Alignment = 5 Then
                    obj.InsertionPoint = objEPNew
                Else
                    obj.TextAlignmentPoint = objEPNew
                End If
               
                If HorAlignment = acHorizontalAlignmentAligned Or HorAlignment = acHorizontalAlignmentFit Then
                    objAPNew = objUtil.TranslateCoordinates(Point3D(CDbl(Pt2Temp(0)), CDbl(objEPTemp(1)), CDbl(objEPTemp(2))), acUCS, acWorld, False)
                    obj.TextAlignmentPoint = objAPNew
                End If
            Case acMtext
               
                objEP = obj.InsertionPoint
                objAttachmentPoint = obj.AttachmentPoint
               
                If obj.Rotation <> 0 Then obj.Rotation = 0
                With obj
                    Select Case HorAlignment
                        Case acHorizontalAlignmentLeft
                            Select Case objAttachmentPoint
                                Case acAttachmentPointBottomCenter, acAttachmentPointBottomRight
                                    .AttachmentPoint = acAttachmentPointBottomLeft
                                Case acAttachmentPointMiddleCenter, acAttachmentPointMiddleRight
                                    .AttachmentPoint = acAttachmentPointMiddleLeft
                                Case acAttachmentPointTopCenter, acAttachmentPointTopRight
                                    .AttachmentPoint = acAttachmentPointBottomLeft
                            End Select
                        Case acHorizontalAlignmentCenter
                            Select Case objAttachmentPoint
                                Case acAttachmentPointBottomLeft, acAttachmentPointBottomRight
                                    .AttachmentPoint = acAttachmentPointBottomCenter
                                Case acAttachmentPointMiddleLeft, acAttachmentPointMiddleRight
                                    .AttachmentPoint = acAttachmentPointMiddleCenter
                                Case acAttachmentPointTopLeft, acAttachmentPointTopRight
                                    .AttachmentPoint = acAttachmentPointBottomCenter
                            End Select
                        Case acHorizontalAlignmentRight
                            Select Case objAttachmentPoint
                                Case acAttachmentPointBottomLeft, acAttachmentPointBottomCenter
                                    .AttachmentPoint = acAttachmentPointBottomRight
                                Case acAttachmentPointMiddleLeft, acAttachmentPointMiddleCenter
                                    .AttachmentPoint = acAttachmentPointMiddleRight
                                Case acAttachmentPointTopLeft, acAttachmentPointTopCenter
                                    .AttachmentPoint = acAttachmentPointBottomRight
                            End Select
                        Case acHorizontalAlignmentAligned, acHorizontalAlignmentFit
                            Select Case objAttachmentPoint
                                Case acAttachmentPointBottomLeft, acAttachmentPointBottomRight
                                    .AttachmentPoint = acAttachmentPointBottomCenter
                                Case acAttachmentPointMiddleLeft, acAttachmentPointMiddleRight
                                    .AttachmentPoint = acAttachmentPointMiddleCenter
                                Case acAttachmentPointTopLeft, acAttachmentPointTopRight
                                    .AttachmentPoint = acAttachmentPointBottomCenter
                            End Select
                    End Select
                End With
                If HorAlignment = acHorizontalAlignmentAligned Or HorAlignment = acHorizontalAlignmentFit Then
                    objEPTemp = objUtil.TranslateCoordinates(objEP, acWorld, acUCS, False)
                    objEPTemp = Point3D(CDbl(Pt1Temp(0)), CDbl(objEPTemp(1)), CDbl(objEPTemp(2)))
                    objAPTemp = Point3D(CDbl(Pt2Temp(0)), CDbl(objEPTemp(1)), CDbl(objEPTemp(2)))
                    objEPNew = objUtil.TranslateCoordinates(funMP(objEPTemp, objAPTemp), acUCS, acWorld, False)
                    obj.Width = funDist(objEPTemp, objAPTemp)
                Else
                    objEPTemp = objUtil.TranslateCoordinates(objEP, acWorld, acUCS, False)
                    objEPNew = objUtil.TranslateCoordinates(Point3D(CDbl(Pt1Temp(0)), CDbl(objEPTemp(1)), CDbl(objEPTemp(2))), acUCS, acWorld, False)
                End If
                obj.InsertionPoint = objEPNew
        End Select
    Next obj
   
Exit_Here:
    SS.Delete
   
    Exit Sub
   
Err_Control:
   
    Resume Exit_Here
   
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Public Sub TextScaleRot(Text, TxtRot)
    Dim TxtRotate As Double
   
    TxtRotate = TxtRot
    ' sollte der Text FIT sein nehmen wir an sein Einsetzpunkt ist links unten
    TxtRotate = -Text.Rotation
    Select Case Text.HorizontalAlignment
    Case Is = 5
        Text.Rotate Text.InsertionPoint, TxtRotate
    Case Else
        If Text.HorizontalAlignment = 0 And Text.VerticalAlignment = 0 Then
            Text.Rotate Text.InsertionPoint, TxtRotate
        Else
            Text.Rotate Text.TextAlignmentPoint, TxtRotate
        End If
    End Select
    Text.Update
End Sub

Public Function CreateSelectionSet(Optional ssName As String = "SS") As AcadSelectionSet

    Dim objSelSet As AcadSelectionSet
    Dim objSelCol As AcadSelectionSets
   
    Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = ssName Then
        objSelCol.Item(ssName).Delete
        Exit For
      End If
    Next
    Set objSelSet = objSelCol.Add(ssName)
    Set CreateSelectionSet = objSelSet

End Function

Public Sub GetUCSVector(UCSX, UCSY)
   
    UCSX = ThisDrawing.GetVariable("UCSXDIR")
    UCSY = ThisDrawing.GetVariable("UCSYDIR")

End Sub

Public Function Point3D(x As Double, y As Double, Optional z As Double = 0) As Variant

    Dim retVal(0 To 2) As Double
   
    retVal(0) = x: retVal(1) = y: retVal(2) = z
   
    Point3D = retVal

End Function

Public Function funPI()

    funPI = 4 * Atn(1)

End Function

Public Function Arccos(x)
    Arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function

'Mittelpunkt zwischen zwei Punkten
Public Function funMP(Punkt1, Punkt2)
       
    Dim punkt(2) As Double
       
    punkt(0) = (Punkt1(0) + Punkt2(0)) / 2
    punkt(1) = (Punkt1(1) + Punkt2(1)) / 2
    punkt(2) = (Punkt1(2) + Punkt2(2)) / 2
   
    funMP = punkt
   
End Function

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

---

Freue mich über Verbesserungsvorschläge.

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

[Diese Nachricht wurde von RoSiNiNo am 03. Mrz. 2004 editiert.]

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

---

Hallo RoSiNiNo,

hab Dein Tool mal ausprobiert!

Bekomme folgende Meldungen:  Fehlerhafte Funktion: 2
Automatisierungsfehler Konnte VBA-Makro nicht ausführen

Weißt Du warum?

Mfg Alpschorsch

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

---

Am besten du gehst in eine der ersten vier Sub's und startest mit F8. Dann gehst du Zeile für Zeile durch und sagst mir dann wo der Fehler aufgetreten ist.
So kann ich besser erkennen woran es liegt, vielleicht hab ich ja eine Funktion vergessen.

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

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

---

@ RoSiNiNo,

Wie meinst Du das mit "Gehst Du in einer der vier Sub's?
Also die Sub's finde ich und dann?

Sorry, bin Amateurlispler! Also, wenn überhaupt!

Mfg Alpschorsch

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

---

Z.B. mit dem Cursor in

Code:

---

Public Sub txtAusrLinks()
    Call TextDrehenAusrichtenExecute(acHorizontalAlignmentLeft)
End Sub

---

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

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

---

Die LispŽler haben es mit RoSiNiNo immer recht schwer, geht nicht nur dir so !

------------------
- Sebastian Mattis -

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

---

Wie bitte!?
Wie darf ich das verstehen.

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

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

---

denk nochmal drüber nach 

------------------
- Sebastian Mattis -

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

---

@Alpschorsch
nur um evtl. Mißverständnissen vorzubeugen ...Rosinis Code ist VBA und kein Lisp!

------------------
- Thomas -

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

---

So hab ich es noch nicht betrachtet.  *g*
Also, nochmal.
Mit VBAIDE den VBA-Editor öffnen.
Neues Modul einfügen und umbenennen (z.B. in Modify).
Den obigen Code in dieses Modul einfügen.
Projekt als Acad.dvb speichern (acad.dvb wird automatisch geladen, so wie acad.lsp oder acaddoc.lsp)

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

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

---

Ups!

Da geht das schon los!
Dann muß ich das nochmal probieren!

----schäm-----

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

---

Hi,

ich hab das soweit!
Nur wie benenne ich das Modul um und wie wir das ganz aufgerufen?

Mfg Alpschorsch

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

---

VBA1.gif VBA2.gif

Anbei zwei Bilder die alles erklären sollten.

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

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

---

Ich will aber LISP *quengel* *lach* 

Grüße

CAD-Tötti 

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

---

Was gibt's denn an VBA auszurichten, hast du meine Funktionen schon mal ausprobiert?

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

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

---

Ich habe jetzt den obigen Code geändert, jetzt sollte er auch funktionieren

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

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

---

Noch eine kleine Änderung, jetzt sollte es aber keine Probleme mehr geben.

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

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

---

So, wenn es jetzt nicht funktioniert, dann versteh ich gar nix mehr.

Jetzt hab ich es ganz genau getestet, es sollte also jetzt funktionieren.

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

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

---

@ RoSiNiNo,

ich muß als Amateur nochmal doof fragen!
Hab alles so gemacht, wie beschrieben (glaub ich!)
Wie rufe ich das ganze jetzt auf?
Was sollte dann passieren?

Gruß Alpschorsch

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

---

 

Zitat:

---

(vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrRechts")
(vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrLinks")
(vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrMitte")
(vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrEinpassen")
(vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrAusgerichtet")

---

Wäre der direkte Aufruf, oder aber per Lisp Befehle definieren wie oben beschrieben.

EDIT:

also:

Zitat:

---

(defun C:txtAusrRechts () (vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrRechts"))
(defun C:txtAusrLinks () (vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrLinks"))
(defun C:txtAusrMitte () (vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrMitte"))
(defun C:txtAusrEinpassen () (vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrEinpassen"))
(defun C:txtAusrAusgerichtet () (vla-runmacro(vlax-get-acad-object) "acad.dvb!Modify.txtAusrAusgerichtet"))

---

in eine *.lsp - diese laden und dann kann man das Zeug mit
txtAusrMitte, txtAusrEinpassen etc aufrufen.

------------------
- Sebastian Mattis -

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

---

Fehler: Automatisierungsfehler Konnte VBA-Makro nicht ausführen

und nun?

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

---

Mache alles nochmal so wie von Roland beschrieben, von ganz neu anfangen,
an Supportpfade denken, keine Schreibfehler machen.
Und das ganze in Ruhe. Es klappt dann sicher auch bei dir.

( jetzt wo der Kot endlich klappt  : RoSiNiNo -->   )

------------------
- Sebastian Mattis -

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

---

Ja, ja, es tut mir eh leid

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

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

---

Fehler.jpg

Hi,

ich glaube mir fehlt eine Gehirnwendung!

Vielleicht hat noch jemand die Muße mir das zuerklären!
Stellt euch vor Ihr müßtet es einem Toastbrot erklären!
Vielleicht sollte ich doch besser erstmal ein wenig über das Thema VBA lesen!
Aber das kann dochnicht so schwer sein!

Wenn keiner mehr Lust hat--Mein vollstes Verständnis!---

Ich glaub ich gehe nachhause!

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