如何在插入块时根据输入的属性的不同来改变块的颜色？
我制作了一些块，其中有一两个属性，大家知道在插入块时会要求输入属性值，我想根据输入的属性值来自动设置块的颜色。比如属性如果为A颜色就为红色，为C颜色就为黄色等等。 <FONT color=#000000>我用下面的方法试了一下，但是它是事件触发后CAD才弹出修改块属性的对话框，而我是想修改好属性后才根据属性值来修改颜色的，请帮帮忙啦！</FONT><A href="http://www.mjtd.com/a2/list.asp?id=500" target="_blank" >http://www.mjtd.com/a2/list.asp?id=500</A> 不太好办，用我以前做的“永久反应器”试试 我又修改了那个例子，可以实现简单的功能，当插入或修改块属性时相应修改颜色。
但是当块有2个以上属性时不知为啥没有按照代码设置颜色。还有一个问题就是插入块的时候运行到
strAtt = ThisDrawing.Utility.GetString(True, vbCrLf & "Enter Value for " & varAttributes(I).TagString & ":")
的时候stratt的值会多出_.acad...(记不清了），所以就加了下面一句才行。<BR>strAtt = ThisDrawing.Utility.GetString(False, "")
请高手看看。<BR>
Dim objBlock As AcadBlockReference<BR>Dim strAtt As String
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)<BR>MsgBox CommandName<BR> ' 确认从设计中心的拖放操作<BR> If CommandName = "DROPGEOM" Or CommandName = "INSERT" Or CommandName = "EATTEDIT" Then<BR> <BR> Dim basePoint As Variant<BR> Dim objItem As AcadObject<BR> Dim ssetObj As AcadSelectionSet<BR> <BR> ' 创建新的选择集<BR> Set ssetObj = ThisDrawing.SelectionSets.Add("ADCROT")<BR> <BR> ' 将拖放的对象添加到选择集中<BR> ssetObj.Select acSelectionSetLast<BR> <BR> ' 如果对象并非块，则退出<BR> For Each objItem In ssetObj<BR> <BR> ' 如果对象不是块<BR> If Not objItem.ObjectName = "AcDbBlockReference" Then<BR> <BR> ' 删除选择集<BR> ThisDrawing.SelectionSets.Item("ADCROT").Delete<BR> <BR> ' 退出<BR> GoTo QuitNow<BR> <BR> End If<BR> <BR> Next objItem<BR> <BR> 'On Error GoTo 0<BR> <BR> ' 旋转选择集中的每个对象<BR> For Each objItem In ssetObj<BR> <BR> '修改<BR> Dim varAttributes As Variant<BR> varAttributes = objItem.GetAttributes<BR> <BR> ' Move the attribute tags and values into a string to be displayed in a Msgbox<BR> 'Dim strAttributes As String<BR> Dim I As Integer<BR> Dim color As AcadAcCmColor<BR> Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
For I = LBound(varAttributes) To UBound(varAttributes)<BR> If CommandName = "DROPGEOM" Then<BR> strAtt = ThisDrawing.Utility.GetString(False, "")<BR> strAtt = ThisDrawing.Utility.GetString(True, vbCrLf & "Enter Value for " & varAttributes(I).TagString & ":")<BR> If Trim(strAtt) = "" Then<BR> strAtt = varAttributes(I).TagString<BR> End If<BR> varAttributes(I).TextString = strAtt<BR> End If<BR> <BR> If varAttributes(I).TagString = "MEDIA" Then<BR> color.ColorIndex = SetColorIndex(varAttributes(I).TextString)<BR> objItem.TrueColor = color<BR> End If<BR> <BR> Next I<BR> Next objItem<BR> <BR> ' 删除选择集<BR> ThisDrawing.SelectionSets.Item("ADCROT").Delete<BR> End If<BR> <BR>QuitNow:
End Sub
<BR>Sub temp()<BR> ThisDrawing.SelectionSets.Item("ADCROT").Delete
End Sub
Function SetColorIndex(Media As String) As Integer<BR> Select Case Media<BR> Case "CO2", "N"<BR> SetColorIndex = 253<BR> Case "F"<BR> SetColorIndex = 52<BR> Case "H"<BR> SetColorIndex = 45<BR> Case "P"<BR> SetColorIndex = 255<BR> Case "W"<BR> SetColorIndex = 82<BR> Case Else<BR> <BR> End Select<BR>End Function
页:
[1]