| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| SAP PLM zentraler Bestandteil des Lösungsangebots, eine Pressemitteilung
|
Autor
|
Thema: Textausrichten (1976 mal gelesen)
|
vision Mitglied
Beiträge: 113 Registriert: 27.10.2003 AutoCAD 2015 Expresstools Windows 10
|
erstellt am: 20. Jan. 2004 19:46 <-- editieren / zitieren --> Unities abgeben:
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 |
Brischke Ehrenmitglied V.I.P. h.c. CAD on demand GmbH
Beiträge: 4187 Registriert: 17.05.2001 AutoCAD 20XX, defun-tools
|
erstellt am: 20. Jan. 2004 21:44 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
Proxy Ehrenmitglied Stateless-DHCP v6-Paketfragmentierer
Beiträge: 1629 Registriert: 13.11.2003 Tastaturen, Mäuse, Pladden, Monitore, ...
|
erstellt am: 20. Jan. 2004 22:23 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
CAD-Tötti Mitglied
Beiträge: 116 Registriert: 27.09.2003 ACAD 2004
|
erstellt am: 10. Feb. 2004 20:00 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
Brischke Ehrenmitglied V.I.P. h.c. CAD on demand GmbH
Beiträge: 4187 Registriert: 17.05.2001 AutoCAD 20XX, defun-tools
|
erstellt am: 10. Feb. 2004 20:10 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
Bernd P Ehrenmitglied V.I.P. h.c. cook-general
Beiträge: 3424 Registriert: 07.06.2001 W10-64bit, AMD Ryzen 7 3700X,32GB RAM, Sapphire Pulse Radeon RX 570 8G G5, Canon TX-3000 MFP, Maus Cherry MW4500, Sub:Infrastructure Design Suite, Office 365
|
erstellt am: 23. Feb. 2004 17:04 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
CAD-Tötti Mitglied
Beiträge: 116 Registriert: 27.09.2003 ACAD 2004
|
erstellt am: 23. Feb. 2004 19:34 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
Bernd P Ehrenmitglied V.I.P. h.c. cook-general
Beiträge: 3424 Registriert: 07.06.2001 W10-64bit, AMD Ryzen 7 3700X,32GB RAM, Sapphire Pulse Radeon RX 570 8G G5, Canon TX-3000 MFP, Maus Cherry MW4500, Sub:Infrastructure Design Suite, Office 365
|
erstellt am: 24. Feb. 2004 07:47 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
CAD-Tötti Mitglied
Beiträge: 116 Registriert: 27.09.2003 ACAD 2004
|
erstellt am: 24. Feb. 2004 11:50 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 24. Feb. 2004 12:40 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
Bernd P Ehrenmitglied V.I.P. h.c. cook-general
Beiträge: 3424 Registriert: 07.06.2001 W10-64bit, AMD Ryzen 7 3700X,32GB RAM, Sapphire Pulse Radeon RX 570 8G G5, Canon TX-3000 MFP, Maus Cherry MW4500, Sub:Infrastructure Design Suite, Office 365
|
erstellt am: 24. Feb. 2004 12:42 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 24. Feb. 2004 12:47 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
CAD-Tötti Mitglied
Beiträge: 116 Registriert: 27.09.2003 ACAD 2004
|
erstellt am: 24. Feb. 2004 12:48 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
AsSchu Ehrenmitglied Konstrukteur
Beiträge: 1632 Registriert: 27.06.2003 ACAD 2012
|
erstellt am: 24. Feb. 2004 15:37 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
cadffm Moderator 良い精神
Beiträge: 22275 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 24. Feb. 2004 15:42 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 24. Feb. 2004 16:19 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
cadffm Moderator 良い精神
Beiträge: 22275 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 24. Feb. 2004 16:29 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 24. Feb. 2004 16:34 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
Bernd P Ehrenmitglied V.I.P. h.c. cook-general
Beiträge: 3424 Registriert: 07.06.2001 W10-64bit, AMD Ryzen 7 3700X,32GB RAM, Sapphire Pulse Radeon RX 570 8G G5, Canon TX-3000 MFP, Maus Cherry MW4500, Sub:Infrastructure Design Suite, Office 365
|
erstellt am: 24. Feb. 2004 22:24 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 25. Feb. 2004 08:12 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 ExplicitPublic 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 |
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 25. Feb. 2004 08:54 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 25. Feb. 2004 09:15 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 25. Feb. 2004 09:30 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 25. Feb. 2004 09:34 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
cadffm Moderator 良い精神
Beiträge: 22275 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 25. Feb. 2004 09:34 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 25. Feb. 2004 09:35 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
cadffm Moderator 良い精神
Beiträge: 22275 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 25. Feb. 2004 09:38 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
CADmium Moderator Maschinenbaukonstrukteur
Beiträge: 13527 Registriert: 30.11.2003 Hinweis: Meine Mitarbeit auf CAD.DE ist fakultativ, unentgeltlich und beruht nur auf einem ausgeprägtem Helfersyndrom.
|
erstellt am: 25. Feb. 2004 09:39 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 25. Feb. 2004 09:47 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 25. Feb. 2004 09:51 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 25. Feb. 2004 11:38 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 25. Feb. 2004 14:59 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
CAD-Tötti Mitglied
Beiträge: 116 Registriert: 27.09.2003 ACAD 2004
|
erstellt am: 25. Feb. 2004 16:50 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 25. Feb. 2004 16:52 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 03. Mrz. 2004 10:50 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 03. Mrz. 2004 11:14 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 03. Mrz. 2004 11:26 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 03. Mrz. 2004 12:04 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
cadffm Moderator 良い精神
Beiträge: 22275 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 03. Mrz. 2004 12:10 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 03. Mrz. 2004 12:10 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
cadffm Moderator 良い精神
Beiträge: 22275 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 03. Mrz. 2004 12:39 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 03. Mrz. 2004 12:59 <-- editieren / zitieren --> Unities abgeben: Nur für vision
|
Alpschorsch Mitglied Dipl.-Ing.(FH) Architektur
Beiträge: 735 Registriert: 18.11.2003 Grafikkarte: Rage128 Fury ProII 32MB Prozzesor ~1,5MHz Arbeitsspeicher~1,3GB Windows 2000 Professional ACAD 2004 Express Tools(deutsch) Photoshop 7.0 Quark Express 5.5 Acrobat 5.0
|
erstellt am: 03. Mrz. 2004 13:51 <-- editieren / zitieren --> Unities abgeben: Nur für vision
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 |