| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: ... muß nochmal nerven (873 mal gelesen)
|
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 12. Feb. 2003 08:52 <-- editieren / zitieren --> Unities abgeben:
Guten morgen, ich hab doch mal wieder ein kleines Problem... Ich habe mehrere gleiche Blöcke in einer Zeichnung unter ACAD R14, diese Blöcke haben 10 Attribute. Jetzt soll ein 11. Attribut hinzu und ich wollte diesen Block neu definieren. Doch leider komm ich mit der F1 hilfe nicht recht klar. Wenn mir als jemand einige Zeilen schreibt und sagt wie das geht, würd ich mich riesig freuen. Dankschöööön! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadffm Moderator 良い精神
Beiträge: 21533 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 12. Feb. 2003 08:58 <-- editieren / zitieren --> Unities abgeben: Nur für xconsole
wundert mich das dies noch keiner gesagt hat: TIP http://ww3.cad.de/foren/ubb/Forum54/HTML/001770.shtml !!! die Antwort für 2002 sieht anders aus wie die für 2000 usw... OOoouups ! - Nicht die Zeichnungen sind im r14-Format, sondern du nutzt sogar R14.... naja, dennoch: besuche mal den Link !
Also R14 - suche hier nach "refresh" - ist ein vba, was hoffentlich auch bei R14 läuft... Du hast doch vba-manager , oder wie das hieß installiert ? anke , habe Link neu gesetzt !
------------------ Gruß Sebastian , Ffm Der Feind des Guten ist das Bessere. [Diese Nachricht wurde von cadffm am 12. Februar 2003 editiert.] [Diese Nachricht wurde von cadffm am 12. Februar 2003 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 12. Feb. 2003 09:01 <-- editieren / zitieren --> Unities abgeben:
|
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: 12. Feb. 2003 09:42 <-- editieren / zitieren --> Unities abgeben: Nur für xconsole
|
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 12. Feb. 2003 12:02 <-- editieren / zitieren --> Unities abgeben:
|
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 12. Feb. 2003 12:09 <-- editieren / zitieren --> Unities abgeben:
|
Thomas Rausch Mitglied
Beiträge: 1199 Registriert: 26.03.2001 Intel P4 2,6 GHz 512 MB RAM NVIDIA GeForce FX 5200 . WinXP prof. Autodesk Map 2004 SP 1 WS-Landcad 2004 . Tetris
|
erstellt am: 12. Feb. 2003 12:54 <-- editieren / zitieren --> Unities abgeben: Nur für xconsole
|
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 12. Feb. 2003 13:40 <-- editieren / zitieren --> Unities abgeben:
|
Thomas Rausch Mitglied
Beiträge: 1199 Registriert: 26.03.2001 Intel P4 2,6 GHz 512 MB RAM NVIDIA GeForce FX 5200 . WinXP prof. Autodesk Map 2004 SP 1 WS-Landcad 2004 . Tetris
|
erstellt am: 12. Feb. 2003 14:49 <-- editieren / zitieren --> Unities abgeben: Nur für xconsole
|
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: 13. Feb. 2003 07:54 <-- editieren / zitieren --> Unities abgeben: Nur für xconsole
Hier ist es, mit vbaide vba-Editor starten. Neues Modul erzeugen und folgenden Code einfügen. Code: Option Explicit' Feletic 04.10.2000 Public Sub BlockRefresh() Dim Obj As Object Dim SS As AcadSelectionSet Dim FltTypes(0) As Integer Dim FltData(0) As Variant ' Frage nach den zu bearbeitenden Blöcken On Error Resume Next Set SS = ThisDrawing.SelectionSets("BlöckeNeuzeichAuswahl") If Err Then On Error GoTo 0 Set SS = ThisDrawing.SelectionSets.Add("BlöckeNeuzeichAuswahl") Else On Error Resume Next End If FltTypes(0) = 0: FltData(0) = "INSERT" ' Selectionset erstellen, Benutzer fragen und Filter anwenden SS.Clear SS.SelectOnScreen FltTypes, FltData If SS.Count > 0 Then ' Wir wissen Selset For Each Obj In SS Call BlockRef(Obj) Next Obj Else 'MsgBox "Keine gültigen Elemente ausgewählt" End If SS.Delete End Sub Public Sub BlockRef(Obj) Dim BlOld As AcadBlockReference Dim BlNew As AcadBlockReference Dim AttsOld As Variant Dim AttsNew As Variant Dim NewName As String Dim OldCount As Integer Dim NewCount As Integer Dim TagString As String Dim textString As String Set BlOld = Obj NewName = BlOld.Name ' Wir erstellen einmal die neue Blockreferenz Select Case ThisDrawing.ActiveSpace Case Is = 0 Select Case ThisDrawing.MSpace Case True Set BlNew = ThisDrawing.ModelSpace.InsertBlock(BlOld.insertionPoint, NewName, BlOld.XScaleFactor, _ BlOld.YScaleFactor, BlOld.ZScaleFactor, BlOld.Rotation) Case False Set BlNew = ThisDrawing.PaperSpace.InsertBlock(BlOld.insertionPoint, NewName, BlOld.XScaleFactor, _ BlOld.YScaleFactor, BlOld.ZScaleFactor, BlOld.Rotation) End Select Case Is = 1 Set BlNew = ThisDrawing.ModelSpace.InsertBlock(BlOld.insertionPoint, NewName, BlOld.XScaleFactor, _ BlOld.YScaleFactor, BlOld.ZScaleFactor, BlOld.Rotation) End Select BlNew.layer = BlOld.layer ' Jetzt holen wir die Attribute AttsOld = BlOld.GetAttributes AttsNew = BlNew.GetAttributes For OldCount = UBound(AttsOld) To 0 Step -1 ' Wir lesen die Daten aus dem alten Ding heraus TagString = AttsOld(OldCount).TagString textString = AttsOld(OldCount).textString ' Wir suchen, ob die Daten auch in das neue Ding passen For NewCount = UBound(AttsNew) To 0 Step -1 If AttsNew(NewCount).TagString = TagString Then ' Hurra, wir haben gefunden, was wir gesucht haben AttsNew(NewCount).textString = textString Exit For End If Next NewCount Next OldCount Obj.Erase Set Obj = BlNew End Sub
Der Code ist vielleicht nicht am schönsten programmiert, aber dazu muß ich sagen das es mein erstes Tools war (mein Einstiegsprojekt in VBA). ------------------ Roland 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: 13. Feb. 2003 07:58 <-- editieren / zitieren --> Unities abgeben: Nur für xconsole
|
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 13. Feb. 2003 08:56 <-- editieren / zitieren --> Unities abgeben:
Ok - ok der vba editor kann ich öffnen .... Nur was mache ich dann - ich bin zwar nicht ganz blöd, aber irgendwie hab ich nicht so die ahnung wohin jetzt mit dem Quelltext? - und wo speichern? - wir das vba teil jedesmal mitgeladen? Danke für Hilfe...
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 13. Feb. 2003 09:00 <-- editieren / zitieren --> Unities abgeben:
|
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: 13. Feb. 2003 09:43 <-- editieren / zitieren --> Unities abgeben: Nur für xconsole
Anbei die ersten Schritte im VBA-Editor. Nachdem der Code ins Modul eingefügt wurde, die VBA-Datei unter einem Arbeitspfad mit dem Namen acad.dvb speichern. Mir Befehl vbarun die Prozeduren starten. Wenn du ein Icon möchtest, dem Icon folgenden Text hinzufügen:
Code: ^C^C_-VBARUN;acad.dvb!block.blockrefresh;
------------------ Roland Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 13. Feb. 2003 09:55 <-- editieren / zitieren --> Unities abgeben:
|
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: 13. Feb. 2003 12:48 <-- editieren / zitieren --> Unities abgeben: Nur für xconsole
Zitat: Original erstellt von xconsole: Mmh dauert immer ein bisschen bis der neue text von seinem Profil auc erscheint, oder?
Hab ehrlich gesagt gar nicht ins Forum geschaut, hab nämlich wieder einmal keine Nachrichten über neue Einträge bekommen. ------------------ Roland Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 13. Feb. 2003 14:13 <-- editieren / zitieren --> Unities abgeben:
ok, ok - zu früh gefreut. Wenn amn es so macht wie beschrieben und einen eigenen Butto dafür verwendet stimmt der Pfad nicht mehr -> das heißt es kann nicht gefunden oder geladen werden. In welchen Verzeichnis sucht Autocad nacht der Datei??? Dank im Vorraus 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: 14. Feb. 2003 08:09 <-- editieren / zitieren --> Unities abgeben: Nur für xconsole
|
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 14. Feb. 2003 09:25 <-- editieren / zitieren --> Unities abgeben:
Guten morgen, Leider erhalte ich eine Fehlermeldung bei dem versuch einen Block zu aktualisieren. Vielleicht kennt jemand das Problem und kann mir weiterhelfen oder kennt eine neuere Version des VBA-Scripts. Wäre sehr schön Bis dann 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: 14. Feb. 2003 10:51 <-- editieren / zitieren --> Unities abgeben: Nur für xconsole
Hab ich mir fast gedacht, das ganze nochmal aber hoffentlich richtig. Code: Option Explicit ' Feletic 04.10.2000 Public Sub BlockRefresh() Dim Obj As Object Dim SS As AcadSelectionSet Dim FltTypes(0) As Integer Dim FltData(0) As Variant ' Frage nach den zu bearbeitenden Blöcken On Error Resume Next Set SS = ThisDrawing.SelectionSets("BlöckeNeuzeichAuswahl") If Err Then On Error GoTo 0 Set SS = ThisDrawing.SelectionSets.Add("BlöckeNeuzeichAuswahl") Else On Error Resume Next End If FltTypes(0) = 0: FltData(0) = "INSERT" ' Selectionset erstellen, Benutzer fragen und Filter anwenden SS.Clear SS.SelectOnScreen FltTypes, FltData If SS.Count > 0 Then ' Wir wissen Selset For Each Obj In SS Call BlockRef(Obj) Next Obj Else 'MsgBox "Keine gültigen Elemente ausgewählt" End If SS.Delete End SubPublic Sub BlockRef(Obj) Dim BlOld As AcadBlockReference Dim BlNew As AcadBlockReference Dim AttsOld As Variant Dim AttsNew As Variant Dim NewName As String Dim OldCount As Integer Dim NewCount As Integer Dim TagString As String Dim textString As String Set BlOld = Obj NewName = BlOld.Name ' Wir erstellen einmal die neue Blockreferenz Select Case ThisDrawing.ActiveSpace Case Is = 0 Select Case ThisDrawing.MSpace Case True Set BlNew = ThisDrawing.ModelSpace.InsertBlock(BlOld.insertionPoint, NewName, BlOld.XScaleFactor, _ BlOld.YScaleFactor, BlOld.Rotation) Case False Set BlNew = ThisDrawing.PaperSpace.InsertBlock(BlOld.insertionPoint, NewName, BlOld.XScaleFactor, _ BlOld.YScaleFactor, BlOld.Rotation) End Select Case Is = 1 Set BlNew = ThisDrawing.ModelSpace.InsertBlock(BlOld.insertionPoint, NewName, BlOld.XScaleFactor, _ BlOld.YScaleFactor, BlOld.Rotation) End Select BlNew.layer = BlOld.layer ' Jetzt holen wir die Attribute AttsOld = BlOld.GetAttributes AttsNew = BlNew.GetAttributes For OldCount = UBound(AttsOld) To 0 Step -1 ' Wir lesen die Daten aus dem alten Ding heraus TagString = AttsOld(OldCount).TagString textString = AttsOld(OldCount).textString ' Wir suchen, ob die Daten auch in das neue Ding passen For NewCount = UBound(AttsNew) To 0 Step -1 If AttsNew(NewCount).TagString = TagString Then ' Hurra, wir haben gefunden, was wir gesucht haben AttsNew(NewCount).textString = textString Exit For End If Next NewCount Next OldCount Obj.Erase Set Obj = BlNew End Sub
------------------ Roland Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
xconsole Mitglied Student :-)
Beiträge: 49 Registriert: 10.02.2003
|
erstellt am: 14. Feb. 2003 11:36 <-- editieren / zitieren --> Unities abgeben:
|