乐筑天下

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

暗淡的文本值/文本的不同颜色...

[复制链接]

46

主题

118

帖子

23

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
291
发表于 2008-2-25 08:42:22 | 显示全部楼层 |阅读模式
嗨,
这是给所有VBAist的!
我想,如果可能的话,能够以不同的颜色显示所有维度,这取决于它们是否显示真正的暗淡值或它们的文本已被覆盖...
例如,如果一个维度的文本已被以任何方式编辑,我希望文本是一种颜色,例如蓝色,但是...如果维度显示其真实的维度值并且在文本覆盖中没有任何内容被编辑,那么将此文本着色为红色...
可以做到这一点吗,如果可以,有人能给我指出我需要的任何方向或开始我...
干杯,
Paul
base point Designzltd...
XP Pro/AutoCAD 2008...
奔腾核心2 Q6600四核
华硕P5N-E SLI主板
4GB DDR2 RAM
2 x SLI NVIDIA 8500GT SLi 1024MB DDR2 PCI-Express显卡

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

46

主题

118

帖子

23

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
291
发表于 2008-2-25 09:08:35 | 显示全部楼层
极简主义快速和肮脏的概念验证代码。不检查锁定图层等。此外,颜色是相反的,红色=覆盖,蓝色=真。
  1. Sub ColorByOveride()
  2.     Dim block  As AcadBlock, _
  3.         ent    As AcadEntity, _
  4.         diment As AcadDimension
  5.         
  6.     For Each block In ThisDrawing.Blocks
  7.         If block.IsLayout Then
  8.             For Each ent In block
  9.                 If ent.ObjectName Like "AcDb*Dimension" Then
  10.                     Set diment = ent
  11.                     diment.TextColor = IIf(diment.TextOverride = "", acBlue, acRed)
  12.                 End If
  13.             Next ent
  14.         End If
  15.     Next block
  16. End Sub

回复

使用道具 举报

46

主题

118

帖子

23

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
291
发表于 2008-2-28 10:15:27 | 显示全部楼层
嘿,MP,谢谢你的代码,工作一个梦想,只是需要尝试添加一些其他因素,但不知道如何.想要检查TextOverride的“”尺寸值代码,并且不要为这些值着色,也不为任何字符串值着色,如“TBC”或“PANEL LENGTH”等,只是任何被覆盖的数值等价值,所以例如............未编辑维度(无文本重写)将是白色(正常暗色)文本。
显示维度值的文本值的编辑(覆盖)维度将为绿色。
被覆盖的尺寸(如“纸张长度”)将是白色(正常的暗色)文本。
用文本度量值加字符串值(如“2400 SHEET LENGTH”)覆盖的维度对于字符串将是白色文本,但对于数字是绿色。我希望这是有道理的,它对我来说确实如此,但它会,哈哈。。
回复

使用道具 举报

46

主题

118

帖子

23

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
291
发表于 2008-2-29 06:52:16 | 显示全部楼层
分享您的代码,以便我们查看并为您指明正确的方向。
回复

使用道具 举报

46

主题

118

帖子

23

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
291
发表于 2008-2-29 07:26:11 | 显示全部楼层
嗨,MP,
我完全有你之前给我的东西,好吧,也许有一些小的调整,但现在没什么疯狂的。
  1. Sub DimOverrideMarker()
  2. Dim blockX As AcadBlock
  3. Dim entX As AcadEntity
  4. Dim dimentX As AcadDimension
  5.    
  6. For Each blockX In ThisDrawing.Blocks
  7.     If blockX.IsLayout Then 'If its a layout..
  8.         For Each entX In blockX
  9.             If entX.ObjectName Like "AcDb*Dimension" Then
  10.                 Set dimentX = entX
  11.                 dimentX.TextColor = IIf(dimentX.TextOverride = "", acWhite, acGreen)
  12.             End If
  13.         Next entX
  14.     End If
  15. Next blockX
  16. End Sub

回复

使用道具 举报

46

主题

118

帖子

23

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
291
发表于 2008-2-29 08:39:38 | 显示全部楼层

很高兴听到它有所帮助。既然你请客,我就要一个泛银河漱口杯;谢了。
回复

使用道具 举报

46

主题

118

帖子

23

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
291
发表于 2008-2-29 11:13:11 | 显示全部楼层
啊...道格拉斯·亚当斯先生...四部分的三部曲...遗憾地错过了。我会在“餐馆”给你买一个...干杯,格伦。
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-6 06:19 , Processed in 1.031785 second(s), 66 queries .

© 2020-2025 乐筑天下

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