| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| PNY bietet das umfangreichste Ökosystem von B2B als auch B2C-Lösungen für IT-Akteure auf dem Markt, eine Pressemitteilung
|
Autor
|
Thema: vorhandene Bemassungen ändern (3216 mal gelesen)
|
TomiProg Mitglied Technischer Zeichner
Beiträge: 51 Registriert: 29.04.2004 WinNT4.0(SP6) + AutoCAD 14.01, P3/400MHz(gääähn),256MB,Graphtec KD4620, ATI 3D Rage Pro(8MB)
|
erstellt am: 02. Dez. 2004 12:31 <-- editieren / zitieren --> Unities abgeben:
Hallo zusammen. Ich möchte gerne eine vorhandene Bemassung mittels VBA ändern. Um genau zu sein die Dezimalstellen eins rauf oder runter. Folgender Code habe ich mir ausgedacht. Leider funktioniert der nicht richtig bzw. es wird an der Bemassung nichts geändert: Sub EinheitErhöhen() Dim BemDezi As Integer, AktuellBem As AcadDimStyle Dim DimObj As AcadDimRotated Dim Punkt(2) As Double, BemStilName As String On Error GoTo ErrZeile ThisDrawing.Utility.GetEntity DimObj, Punkt, "Bemassung wählen: " BemStilName = DimObj.StyleName BemDezi = ThisDrawing.GetVariable("DIMDEC") + 1 ThisDrawing.SetVariable "DIMDEC", BemDezi DimObj.StyleName = BemStilName DimObj.Update Exit Sub ErrZeile: Select Case Err.Number Case 13 MsgBox "Keine Bemassung ausgewählt!", vbOKOnly, "M&P" Case Else MsgBox "ErrorCode: " & Err.Number & vbCr & Err.Description End Select End Sub Jeder Bemassung sind doch mehr oder weniger vom aktuellen BemStil abweichende Einstellungen hinterlegt. Wie kann ich diese per VBA abrufen und/oder ändern? In der Hilfe steht nur: Die Einstellungen für einen Bemaßungsstil legen Sie mit Hilfe der Bemaßungs-Systemvariablen fest. und Um den Stil einer vorhandenen Bemaßung zu ändern, wenden Sie die StyleName-Eigenschaft auf die entsprechende Bemaßung an. Kann mir jemand weiterhelfen? Gruß Tomi Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADmium Moderator Maschinenbaukonstrukteur
Beiträge: 13527 Registriert: 30.11.2003 ACAD 2008 Mechanical
|
erstellt am: 02. Dez. 2004 12:43 <-- editieren / zitieren --> Unities abgeben: Nur für TomiProg
|
TomiProg Mitglied Technischer Zeichner
Beiträge: 51 Registriert: 29.04.2004 WinNT4.0(SP6) + AutoCAD 14.01, P3/400MHz(gääähn),256MB,Graphtec KD4620, ATI 3D Rage Pro(8MB)
|
erstellt am: 02. Dez. 2004 12:53 <-- editieren / zitieren --> Unities abgeben:
Leider hilft mir das gar nicht weiter. Dort geht es um krumme Maße zu begradigen. Ich habe schon grade Maße. Nur manche brauchen (vor allem, wenn diese in Metern dargestellt werden) eine Dezi-Stelle mehr z.B. 3.25 in 3.245. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADmium Moderator Maschinenbaukonstrukteur
Beiträge: 13527 Registriert: 30.11.2003 ACAD 2008 Mechanical
|
erstellt am: 02. Dez. 2004 13:07 <-- editieren / zitieren --> Unities abgeben: Nur für TomiProg
dann nimm dies ( auch wenn es Lisp ist) (defun PUTPRECISION(Precision / BLOCK ) (vl-load-com) (vlax-for LAYOUT (vla-get-layouts(vla-get-activedocument(vlax-get-acad-object))) (vlax-for ITEM (setq BLOCK (vla-get-Block LAYOUT)) (if(wcmatch (strcase"AcDbRotatedDimension") "*DIMENSION*") (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-PrimaryUnitsPrecision (list ITEM Precision) ) ) ) ) ) (vla-regen(vla-get-activedocument (vlax-get-acad-object)) acAllViewports) ) der Aufruf in der Befehlszeile (PUTPRECISION 3) stellt dir 3 Dezimalstellen als Genauigkeit bei allen Bemassungen ein ------------------ - Thomas - "Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben." Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
TomiProg Mitglied Technischer Zeichner
Beiträge: 51 Registriert: 29.04.2004 WinNT4.0(SP6) + AutoCAD 14.01, P3/400MHz(gääähn),256MB,Graphtec KD4620, ATI 3D Rage Pro(8MB)
|
erstellt am: 02. Dez. 2004 13:24 <-- editieren / zitieren --> Unities abgeben:
Das Programm funktioniert nicht. Habe die Zeilen im VisualLisp reinkopiert und wie du geschrieben hast den Kommandobefehl ausgeführt. Das Programm meldet nur *Abbruch*. Über Lisp ist zwar auch eine Lösung aber ich hätte das Problem lieber in VBA gelöst. Trotzdem Danke. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADmium Moderator Maschinenbaukonstrukteur
Beiträge: 13527 Registriert: 30.11.2003 ACAD 2008 Mechanical
|
erstellt am: 02. Dez. 2004 13:26 <-- editieren / zitieren --> Unities abgeben: Nur für TomiProg
Wie man ein Lisp lädt, findest du hier ... in VBA ist es aber das gleiche Prinzip, d.h. Zugriff auf die ActivX-Methoden ------------------ - Thomas - "Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben." Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
TomiProg Mitglied Technischer Zeichner
Beiträge: 51 Registriert: 29.04.2004 WinNT4.0(SP6) + AutoCAD 14.01, P3/400MHz(gääähn),256MB,Graphtec KD4620, ATI 3D Rage Pro(8MB)
|
erstellt am: 02. Dez. 2004 13:39 <-- editieren / zitieren --> Unities abgeben:
Bevor ich mit VBA angefangen habe, programmierte ich in Lisp. Ich glaube nicht, daß ich eine Anleitung brauche, wie ich solche Programme zum laufen bekomme Lisp erkennt die Befehle vl-load-com und vla-get-block und einige andere nicht. Keine Ahnung warum. Die werden in meinem Editor auch nicht als bekannte Befehle farbig gekennzeichnet. Vielleicht doch lieber eine Lösung in VBA? [Diese Nachricht wurde von TomiProg am 02. Dez. 2004 editiert.]
[Diese Nachricht wurde von TomiProg am 02. Dez. 2004 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADmium Moderator Maschinenbaukonstrukteur
Beiträge: 13527 Registriert: 30.11.2003 ACAD 2008 Mechanical
|
erstellt am: 02. Dez. 2004 13:44 <-- editieren / zitieren --> Unities abgeben: Nur für TomiProg
nach Zitat.. Habe die Zeilen im VisualLisp reinkopiert und wie du geschrieben hast den Kommandobefehl ausgeführt.
hielt ich meinen Ladehinweis für angebracht sorry .. sehe gerade, das du mit ACAD14 arbeitest...
und da gabs den vlisp-editor? und Activx wurde nicht unterstützt .. ?? ------------------ - Thomas - "Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben." Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
TomiProg Mitglied Technischer Zeichner
Beiträge: 51 Registriert: 29.04.2004 WinNT4.0(SP6) + AutoCAD 14.01, P3/400MHz(gääähn),256MB,Graphtec KD4620, ATI 3D Rage Pro(8MB)
|
erstellt am: 02. Dez. 2004 13:50 <-- editieren / zitieren --> Unities abgeben:
Ja. Das ist ein externes Progamm von Mensch und Maschine. Hat damals einige Mark gekostet. Aber ActiveX ist auch dabei. Aber wahrscheinlich sind nicht alle Befehle dabei, die heute im Vlisp-Editor vorhanden sind Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADwiesel Ehrenmitglied CAD4FM UG
Beiträge: 1989 Registriert: 05.09.2000 AutoCAD, Bricscad Wir machen das Mögliche unmöglich
|
erstellt am: 02. Dez. 2004 13:50 <-- editieren / zitieren --> Unities abgeben: Nur für TomiProg
unter R14 gabs den Visual lisp Editor als englische Installation es war damit möglich schon eine Menge Visual lisp Befehle zu nutzen. Dazu musste aber der Kot als arx kompiliert werden, somit wurde der gesamte Interpreter mit einkompiliert. Deshalb waren die arx'e auch immer so Groß im Verhältniss zum lisp. Also entweder Lisp pur oder besorg dir den VLisp-Editor für R14 ------------------ Gruß CADwiesel Besucht uns im CHAT
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
TomiProg Mitglied Technischer Zeichner
Beiträge: 51 Registriert: 29.04.2004 WinNT4.0(SP6) + AutoCAD 14.01, P3/400MHz(gääähn),256MB,Graphtec KD4620, ATI 3D Rage Pro(8MB)
|
erstellt am: 02. Dez. 2004 13:55 <-- editieren / zitieren --> Unities abgeben:
Den VLisp Editor habe ich ja. Auch wenn ich die obigen Zeile in ARX kompiliere ergibt es kein besseres Ergebnis. Und das mit der Größe ist auch ein Grund, warum ich lieber in VBA programmiere. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADwiesel Ehrenmitglied CAD4FM UG
Beiträge: 1989 Registriert: 05.09.2000 AutoCAD, Bricscad Wir machen das Mögliche unmöglich
|
erstellt am: 02. Dez. 2004 14:14 <-- editieren / zitieren --> Unities abgeben: Nur für TomiProg
|
TomiProg Mitglied Technischer Zeichner
Beiträge: 51 Registriert: 29.04.2004 WinNT4.0(SP6) + AutoCAD 14.01, P3/400MHz(gääähn),256MB,Graphtec KD4620, ATI 3D Rage Pro(8MB)
|
erstellt am: 02. Dez. 2004 14:25 <-- editieren / zitieren --> Unities abgeben:
|
CADmium Moderator Maschinenbaukonstrukteur
Beiträge: 13527 Registriert: 30.11.2003 ACAD 2008 Mechanical
|
erstellt am: 02. Dez. 2004 14:28 <-- editieren / zitieren --> Unities abgeben: Nur für TomiProg
dann mach das so ( obwohl ich überhaupt keinen blassen von VBA habe): ThisDrawing.Utility.GetEntity DimObj, Punkt, "Bemassung wählen: " DimObj.PrimaryUnitsPrecision=3 ------------------ - Thomas - "Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben." 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 ACAD20XX, defun-tools
|
erstellt am: 02. Dez. 2004 14:31 <-- editieren / zitieren --> Unities abgeben: Nur für TomiProg
|
TomiProg Mitglied Technischer Zeichner
Beiträge: 51 Registriert: 29.04.2004 WinNT4.0(SP6) + AutoCAD 14.01, P3/400MHz(gääähn),256MB,Graphtec KD4620, ATI 3D Rage Pro(8MB)
|
erstellt am: 02. Dez. 2004 14:43 <-- editieren / zitieren --> Unities abgeben:
Zitat: Original erstellt von CADmium: dann mach das so ( obwohl ich überhaupt keinen blassen von VBA habe):ThisDrawing.Utility.GetEntity DimObj, Punkt, "Bemassung wählen: " DimObj.PrimaryUnitsPrecision=3
Wäre schön, wenn die Methode funktionieren würde. Tut es leider nicht. Verdamt sei R14 Da hat Brischke leider Recht, daß all die schönen Dinge mit R14 nicht gehen. Um bessere Arbeitsbedingungen zu bekommen, muß ich wohl meine Arbeitsstelle wechseln
[Diese Nachricht wurde von TomiProg am 02. Dez. 2004 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
mapcar Mitglied CADmin
Beiträge: 1250 Registriert: 20.05.2002 Die Phönizier haben das Geld erfunden - aber warum so wenig? (Johann Nepomuk Nestroy)
|
erstellt am: 02. Dez. 2004 19:51 <-- editieren / zitieren --> Unities abgeben: Nur für TomiProg
Ich hab' irgendwie das Gefühl, dass hier mal aufgeräumt werden muss;-) Zunächst mal, Tomi: Lass dich nicht verwirren, einige Antworten waren nicht sehr sachdienlich. Weder geht es hier um Lisp, noch um Layouts... Dein Problem liegt wo ganz anders: Das Programm sieht aus, als sei es für eine noch ältere AutoCAD-Version geschrieben. Da war es tatsächlich so, dass man nur eine Variable wie DIMDEC ändern musste. Ein anschliessendes Update der Bemassungen hat diese dann verändert, es sei denn, es war ein Bemstil gegeben. Das hat regelmäßig ganze Zeichnungen versaut, wenn ohne Bemstil bemaßt wurde. Deswegen wurde das Konzept der Overrides eingeführt - d.h. die Bemaßungsvariablen im Speicher wirken sich nur bei neuen Bemaßungen aus, aber nicht beim Updaten. Code:
BemStilName = DimObj.StyleName BemDezi = ThisDrawing.GetVariable("DIMDEC") + 1 ThisDrawing.SetVariable "DIMDEC", BemDezi DimObj.StyleName = BemStilName DimObj.Update
Das macht so keinen Sinn. Du liest den Bemstil der Bemassung aus und weist ihn hier etwas später wieder zu - ohne dass sich zwischendurch was geändert hätte. Hast du eine Zeile vergessen, die den Stil der Bemaßung auf "keiner" setzt? Oder aber fehlt irgendwas wie DimObj.PrimaryUnitsPrecision = acDimPrecisionFour(...Five,...Six,...)? Also: Dein Code berührt die Bemaßung überhaupt nicht, es wird nur eine Systemvaraible gändert. Selbst wenn die Bemaßung keinen Bemstil hat, läuft das so in R14 nicht mehr - das wäre in R12 noch gegangen, wenn ich mich recht erinnere. Dumm ist nur, dass ich hier auch nur im Gedächtnis wühlen und raten kann, habe derzeit kein R14 mehr (ach ja, muss bei dir wohl ein 14.01 sein, sonst wäre doch kein VBA drin, oder?). Kann nur hoffen, dass mein Beitrag dich jetzt mal wirklich weiter bringt - bisher war das ja eher eine Anti-Hilfe;-) Gruß, Axel Strube-Zettler ------------------ (defun - Lisp over night - AutoLisp-Programmierung für AutoCad - Da weiß man, wann man's hat Meine AutoLisp-Seiten Mein Angriff auf dein Zwerchfell Mein Lexikon der Fotografie Mein gereimtes Gesülze Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CAD-Huebner Ehrenmitglied V.I.P. h.c. Verm.- Ing., ATC-Trainer
Beiträge: 9803 Registriert: 01.12.2003 AutoCAD 2.5 - 2022, LDD, MDT, RD, ADT, Civil Inventor AIP 4-11, 2008 -2022 Win 10
|
erstellt am: 02. Dez. 2004 23:15 <-- editieren / zitieren --> Unities abgeben: Nur für TomiProg
Ich kanns nur in Lisp, das hier sollte wohl auch mit AutoCAD 14 laufen da ich vollständige auf VisalLisp Funktionen verzichtet habe. Dafür ist es auch etwas länger geworden und nicht so elegant wie der Code von CADmium. Code:
; Hauptprogrammm ; Beispielprogramm zum Einsatz der Bemaßungsüberschreibungen ; die in EEDs gespeichert sind. (DEFUN C:BEMU ( / ss cnt) (PROMPT "\nÜbersteuerung von Bemaßungsvariablen hier DIMDEC = 3") (PROMPT "\nBemaßungen wählen:") (SETQ ss (SSGET (LIST (CONS 0 "DIMENSION")))) (IF ss (PROGN (SETQ cnt (SSLENGTH ss)) (PROMPT (STRCAT "\nBearbeite " (ITOA cnt) " Bemaßungsobjekte")) (WHILE (>= (SETQ cnt (1- cnt)) 0) (BEMUEBERSCHREIBUNG (SSNAME ss cnt) 271 1070 3) ; 271 ist der Code von DIMDEC ) ) ) (PRIN1) ) ; Unterprogramm ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (DEFUN Bemueberschreibung (elname BemVarCode WertCode Wert / eliste XDaten NeueXDaten nurnochfertigwerden elementaendern dstyle) (SETQ eliste (ENTGET elname (LIST "ACAD")) Xdaten (CADR (ASSOC -3 eliste)) ) (IF (NOT XDaten) ; Überhaupt keine Stilüberschreibungen vorhanden (PROGN (PRINT (SETQ NeueXDaten (LIST "ACAD" (CONS 1000 "DSTYLE") (CONS 1002 "{") (CONS 1070 BemVarCode) (CONS WertCode Wert) (CONS 1002 "}") ) ) ) (SETQ eliste (APPEND eliste (LIST (LIST -3 NeueXDaten)))) ) (PROGN (FOREACH element XDaten (COND (nurnochfertigwerden) (elementaendern (SETQ element (CONS WertCode Wert) elementaendern NIL nurnochfertigwerden 'T ) ) ((EQUAL element '(1000 . "DSTYLE")); Bemaßungsstilüberschreibungen gefunden (SETQ dstyle 'T) ) ((AND dstyle (EQUAL element '(1002 . "}"))) ; Ende der Bemaßungsstilüberschreibungen gefunden und noch nicht "nurnochfertigwerden" gesetzt (SETQ NeueXDaten (CONS (CONS WertCode Wert) (CONS (CONS 1070 BemVarCode) NeueXDaten)) nurnochfertigwerden 'T dstyle NIL ) ) ((AND dstyle (= (CDR element) BemVarCode)) ; nachfolgende Bemaßungsstilüberschreibung ändern (SETQ elementaendern 'T) ) ) ;ende COND (SETQ NeueXdaten (CONS element NeueXdaten)) ) (SETQ eliste (SUBST (CONS -3 (LIST (REVERSE NeueXDaten))) (ASSOC -3 eliste) eliste ) ) ) ) (ENTMOD eliste) )
Mit freundlichem Gruß Udo Hübner ------------------ Nichts ist so einfach, dass man's nicht falsch machen könnte. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
TomiProg Mitglied Technischer Zeichner
Beiträge: 51 Registriert: 29.04.2004 WinNT4.0(SP6) + AutoCAD 14.01, P3/400MHz(gääähn),256MB,Graphtec KD4620, ATI 3D Rage Pro(8MB)
|
erstellt am: 05. Jan. 2005 12:55 <-- editieren / zitieren --> Unities abgeben:
Nach längerer Überlegungspause bin ich auf die Lösung gekommen und wenn ich die hier gleich bekannt gebe, hauen sich bestimmt manche Leute, die sich mit diesem Thema beschäftigt haben, an die Stirn: Das Geheimnis heißt: XData Hier mal der Code, der das alles hinbekommt: Sub BemFarbÄndern() Dim DimObj As AcadDimRotated, ReturnCode As Variant Dim XData As Variant, XType As Variant, Index As Integer Dim SsetDim As AcadSelectionSet Dim groupValue(0) As Integer, dataValue(0) As Variant Dim groupCode As Variant, dataCode As Variant 'Definiert Auswahlsatz mit Filter nur für Dimensionen Set SsetDim = ThisDrawing.SelectionSets.Add("DimSSET") groupValue(0) = 0: dataValue(0) = "DIMENSION" groupCode = groupValue: dataCode = dataValue SsetDim.SelectOnScreen groupCode, dataCode For Each DimObj In SsetDim ReturnCode = BemDataValue(DimObj) 'Funktion gibt Xdaten zurück XData = ReturnCode(1) Index = PosInField(XData, "147") + 1 XData(Index) = 100 'Wert für Textabstand von der Maßlinie Index = PosInField(XData, "178") + 1 XData(Index) = 252 'Wert für Farbe des Textes Index = PosInField(XData, "177") + 1 XData(Index) = 11 'Wert für Farbe der Maßlinie Index = PosInField(XData, "176") + 1 XData(Index) = 252 'Wert für Farbe der Hilfslinie BemDataValue DimObj, ReturnCode(0), XData 'Funktion gibt geänderte Xdaten-Satz zurück an das Objekt Next DimObj SsetDim.Clear Set SsetDim = Nothing End Sub Function BemDataValue(BemObj As AcadDimRotated, Optional XType As Variant, Optional XData As Variant) As Variant Dim ReturnWert(1) As Variant If IsMissing(XType) Then BemObj.GetXData "", XType, XData ReturnWert(0) = XType ReturnWert(1) = XData BemDataValue = ReturnWert Else BemObj.SetXData XType, XData BemObj.Update BemDataValue = True End If End Function Function PosInField(Feld As Variant, SucheNach As Variant) As Integer Dim Zähler As Integer, MomPos As Variant If SucheNach <> "" Then For Each MomPos In Feld If StrComp(MomPos, SucheNach, vbTextCompare) = 0 Then Exit For Zähler = Zähler + 1 Next If Zähler <= UBound(Feld) Then PosInField = Zähler Else PosInField = -1 End If Else PosInField = -1 End If End Function Danke nochmal an alle, die versucht haben mir zu helfen!
**** Ein frohes neues Jahr **** Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |