---

Hallo,

ich möchte mit VBA ein Attribut zu vorhandenen Blöcken hinzufügen ?
Läuft aber nicht so, hab keine Ahnung von VBA was ist falsch ?

Public Sub Block()
Set blockObj = ThisDrawing.Blocks.Item("2ig_082e")

Dim attributeObj As AcadAttribute
Dim height As Double
Dim mode As Long
Dim prompt As String
Dim insertionPoint(0 To 2) As Double
Dim tag As String
Dim value As String
height = 1
mode = acAttributeModeVerify
prompt = "Neue Eingabeaufforderung"
insertionPoint(0) = 5
insertionPoint(1) = 5
insertionPoint(2) = 0
tag = "Neuer Tag"
value = "Neuer Wert"
Set attributeObj = blockObj.AddAttribute(height, mode, _
prompt, insertionPoint, tag, value)

End Sub

Gruß, Jürgen

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

---

Vielleicht hilft dir  erstmal dieser Beitrag weiter, aber den hast du ja scheinbar schon gelesen??

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

[Diese Nachricht wurde von CADmium am 27. Feb. 2005 editiert.]

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

---

Hallo Cadmium,

Danke für den Hinweis, hab jetzt festgestellt das das Programm funktioniert, nach einem attsync ist das Attribut am Block, wie gewünscht !

Eine ganz andere Frage wie lassen sich unter VBA ACAD-Befehle ausführen ? (So wie in lisp (command "Befehl" "" ....) ??

Gruß, Jürgen

---------www.pc-ideal.de

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

---

mit sendcommand

z.B.
Sub Example_SendCommand()
  ' This example sends a command for evaluation to the AutoCAD command line
  ' of a particular drawing
 
  ' Create a Circle in the active drawing and
  ' zoom to display the entire circle
  ThisDrawing.SendCommand "_Circle" & vbCr & "2,2,0" & vbCr & "4" & vbCr
  ThisDrawing.SendCommand "_zoom" & vbCr & "a" & vbCr
 
  ' Refresh view
  ThisDrawing.Regen acAllViewports
 
  MsgBox "A circle command has been sent to the command line of the current drawing."
End Sub

------------------
- 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

---

Danke Cadmium,

funktioniert, der Code sieht dann so aus, das VBA scheint mir gar nicht so schlecht, gefällt mir !

Public Sub Block()
    Set blockObj = ThisDrawing.Blocks.Item("2ig_082e")
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim tag As String
    Dim value As String
    height = 0.25
    mode = acAttributeModeNormal
    prompt = "Attribute Prompt"
    tag = "Neuer Tag"
    value = "Neuer Wert"
   
    MsgBox "Basispunkt des Blocks auf den 0-Punkt der Zeichnung legen, Block mit 1 skaliert !"
   
    returnPnt = ThisDrawing.Utility.GetPoint(, "Punkt wählen: ")
   
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, returnPnt, tag, value)
   
    ThisDrawing.SendCommand "_attsync" & vbCr & "name" & vbCr & "2ig_082e" & vbCr
   
    End Sub

Gruß, Jürgen

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