[VBA程序]：怎样用VBA来修改属性块中的值

lh869

请教各位大侠，这个问题已经捆扰我好久了，就是怎样才能利用VBA（或者是VB也行）将我这属性中的数值相乘并写入当前这个属性块中呢？？拜托各位了！

前提是必须要用VB语言来写的哦！

tsuihan

不复杂的；

借花献佛，把Autocad自带的例子给你看看。

================================================
================================================
================================================


Sub Example_GetAttributes()
' This example creates a block. It then adds attributes to that
' block. The block is then inserted into the drawing to create
' a block reference.

' Create the block
Dim blockObj As AcadBlock
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "TESTBLOCK")

' Define the attribute definition
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 = "Attribute Prompt"
insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0
tag = "Attribute Tag"
value = "Attribute Value"

' Create the attribute definition object in model space
Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value)


' Insert the block
Dim blockRefObj As AcadBlockReference
insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "TESTBLOCK", 1#, 1#, 1#, 0)
ZoomAll

' Get the attributes for the block reference
Dim varAttributes As Variant
varAttributes = blockRefObj.GetAttributes

' Move the attribute tags and values into a string to be displayed in a Msgbox
Dim strAttributes As String
Dim I As Integer
For I = LBound(varAttributes) To UBound(varAttributes)
strAttributes = strAttributes & " Tag: " & varAttributes(I).TagString & _
" Value: " & varAttributes(I).textString & " "
Next
MsgBox "The attributes for blockReference " & blockRefObj.name & " are: " & strAttributes, , "GetAttributes Example"

' Change the value of the attribute
' Note: There is no SetAttributes. Once you have the variant array, you have the objects.
' Changing them changes the objects in the drawing.
varAttributes(0).textString = "NEW VALUE!"

' Get the attributes
Dim newvarAttributes As Variant
newvarAttributes = blockRefObj.GetAttributes

' Again, display the tags and values
strAttributes = ""
For I = LBound(varAttributes) To UBound(varAttributes)
strAttributes = strAttributes & " Tag: " & varAttributes(I).TagString & _
" Value: " & varAttributes(I).textString & " "
Next '''//// 修改属性值！你要的在这儿。。。。

MsgBox "The attributes for blockReference " & blockRefObj.name & " are: " & strAttributes, , "GetAttributes Example"

End Sub



================================================
================================================
================================================.

lh869

谢谢你的回复，麻烦你可以真对我的那个例子来具体说明以一下吗？

macula55

Sub Ji()
  Dim a As AcadBlockReference
  Dim v As Variant
  Dim s As Variant
  Dim i As Integer
  Dim c1 As String, c2 As String
  Dim cs As Double, bcs As Double
  
  v = ThisDrawing.Utility.GetPoint(, vbCrLf & "指定插入点：")
  
  c1 = ThisDrawing.Utility.GetString(False, vbCrLf & "输入乘数值：")
  c2 = ThisDrawing.Utility.GetString(False, vbCrLf & "输入被乘数值：")
  
  Set a = ThisDrawing.ModelSpace.InsertBlock(v, "求积", 1#, 1#, 1#, 0)
  

  If a.HasAttributes Then
    s = a.GetAttributes
   
    For i = LBound(s) To UBound(s)
      If s(i).TagString = "CHENGSHU" Then
        s(i).TextString = c1
        cs = CDbl(s(i).TextString)
      ElseIf s(i).TagString = "BEICHENGSHU" Then
        s(i).TextString = c2
        bcs = CDbl(s(i).TextString)
      End If
    Next
   
    For i = LBound(s) To UBound(s)
      If s(i).TagString = "JI" Then s(i).TextString = CStr(cs * bcs)
    Next
   
  End If
  
  Set a = Nothing
End Sub

lh869

谢谢您的回复！
指定插入点,那就是又添加了一个同样的块，而我要的是在原来的块上面做修改的效果啊！！
也就是选中这个块按右键（或回车）即可自动求出积并写入该块中！
谢！

macula55

这个应该可以了吧！

Sub Ji()
Dim a As AcadBlockReference
Dim obj As AcadEntity
Dim v As Variant
Dim s As Variant
Dim i As Integer
Dim cs As Double, bcs As Double

ThisDrawing.Utility.GetEntity obj, v, vbCrLf & "选择块对象："

If obj.ObjectName = "AcDbBlockReference" Then Set a = obj

If a.HasAttributes Then
  s = a.GetAttributes

  For i = LBound(s) To UBound(s)
    If s(i).TagString = "CHENGSHU" Then
      cs = CDbl(s(i).TextString)
    ElseIf s(i).TagString = "BEICHENGSHU" Then
      bcs = CDbl(s(i).TextString)
    End If
  Next

  For i = LBound(s) To UBound(s)
    If s(i).TagString = "JI" Then s(i).TextString = CStr(cs * bcs)
  Next

End If

Set a = Nothing
Set obj = Nothing
End Sub

lh869

还得麻烦一下楼上这位大哥，怎样才能一次就选折多个属性块进行相乘的运算呢？？
以上的代码应该怎样修改一下呢？？小弟在此先谢谢了！
热切期盼您的回复！！

tsuihan

过分！这不是在学习；你到底有在学吗？是来这里让人帮你做事吧？