乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 44|回复: 3

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

[复制链接]

19

主题

57

帖子

5

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
133
发表于 2005-5-26 14:12:00 | 显示全部楼层 |阅读模式
我制作了一些块,其中有一两个属性,大家知道在插入块时会要求输入属性值,我想根据输入的属性值来自动设置块的颜色。比如属性如果为A颜色就为红色,为C颜色就为黄色等等。
回复

使用道具 举报

19

主题

57

帖子

5

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
133
发表于 2005-5-27 09:14:00 | 显示全部楼层
我用下面的方法试了一下,但是它是事件触发后CAD才弹出修改块属性的对话框,而我是想修改好属性后才根据属性值来修改颜色的,请帮帮忙啦!
回复

使用道具 举报

72

主题

2726

帖子

9

银币

社区元老

Rank: 75Rank: 75Rank: 75

铜币
3014
发表于 2005-5-27 15:49:00 | 显示全部楼层
不太好办,用我以前做的“永久反应器”试试
回复

使用道具 举报

19

主题

57

帖子

5

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
133
发表于 2005-5-27 16:26:00 | 显示全部楼层
我又修改了那个例子,可以实现简单的功能,当插入或修改块属性时相应修改颜色。
但是当块有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
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-5 13:37 , Processed in 1.155518 second(s), 60 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表