如何在插入块时根据输入的属性的不同来改变块的颜色？

asahix

我制作了一些块，其中有一两个属性，大家知道在插入块时会要求输入属性值，我想根据输入的属性值来自动设置块的颜色。比如属性如果为A颜色就为红色，为C颜色就为黄色等等。

asahix

我用下面的方法试了一下，但是它是事件触发后CAD才弹出修改块属性的对话框，而我是想修改好属性后才根据属性值来修改颜色的，请帮帮忙啦！ http://www.mjtd.com/a2/list.asp?id=500

雪山飞狐_lzh

不太好办，用我以前做的“永久反应器”试试

asahix

我又修改了那个例子，可以实现简单的功能，当插入或修改块属性时相应修改颜色。 但是当块有2个以上属性时不知为啥没有按照代码设置颜色。还有一个问题就是插入块的时候运行到 strAtt = ThisDrawing.Utility.GetString(True, vbCrLf & "Enter Value for " & varAttributes(I).TagString & ":") 的时候stratt的值会多出_.acad...(记不清了），所以就加了下面一句才行。
strAtt = ThisDrawing.Utility.GetString(False, "") 请高手看看。
Dim objBlock As AcadBlockReference
Dim strAtt As String Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
MsgBox CommandName
' 确认从设计中心的拖放操作
If CommandName = "DROPGEOM" Or CommandName = "INSERT" Or CommandName = "EATTEDIT" Then

Dim basePoint As Variant
Dim objItem As AcadObject
Dim ssetObj As AcadSelectionSet

' 创建新的选择集
Set ssetObj = ThisDrawing.SelectionSets.Add("ADCROT")

' 将拖放的对象添加到选择集中
ssetObj.Select acSelectionSetLast

' 如果对象并非块，则退出
For Each objItem In ssetObj

' 如果对象不是块
If Not objItem.ObjectName = "AcDbBlockReference" Then

' 删除选择集
ThisDrawing.SelectionSets.Item("ADCROT").Delete

' 退出
GoTo QuitNow

End If

Next objItem

'On Error GoTo 0

' 旋转选择集中的每个对象
For Each objItem In ssetObj

'修改
Dim varAttributes As Variant
varAttributes = objItem.GetAttributes

' Move the attribute tags and values into a string to be displayed in a Msgbox
'Dim strAttributes As String
Dim I As Integer
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16") For I = LBound(varAttributes) To UBound(varAttributes)
If CommandName = "DROPGEOM" Then
strAtt = ThisDrawing.Utility.GetString(False, "")
strAtt = ThisDrawing.Utility.GetString(True, vbCrLf & "Enter Value for " & varAttributes(I).TagString & ":")
If Trim(strAtt) = "" Then
strAtt = varAttributes(I).TagString
End If
varAttributes(I).TextString = strAtt
End If

If varAttributes(I).TagString = "MEDIA" Then
color.ColorIndex = SetColorIndex(varAttributes(I).TextString)
objItem.TrueColor = color
End If

Next I
Next objItem

' 删除选择集
ThisDrawing.SelectionSets.Item("ADCROT").Delete
End If

QuitNow: End Sub
Sub temp()
ThisDrawing.SelectionSets.Item("ADCROT").Delete End Sub Function SetColorIndex(Media As String) As Integer
Select Case Media
Case "CO2", "N"
SetColorIndex = 253
Case "F"
SetColorIndex = 52
Case "H"
SetColorIndex = 45
Case "P"
SetColorIndex = 255
Case "W"
SetColorIndex = 82
Case Else

End Select
End Function