乐筑天下

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

用文本替换属性定义。

[复制链接]

154

主题

1274

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1936
发表于 2004-4-12 19:46:35 | 显示全部楼层 |阅读模式
我正在尝试用文本替换模型空间中的所有属性定义。下面的代码将所有属性替换为文本,但由于某种原因,其中一些属性移动到 0,0,0。有人有什么想法吗?
  1. Public Sub remove_attdef()
  2.     Dim SelSet As AcadSelectionSet
  3.     Dim AT As AcadAttribute
  4.     Dim FilterType(0 To 0) As Integer
  5.     Dim FilterData(0 To 0) As Variant
  6.     Dim TXT As AcadText
  7.     Dim YesNo
  8.     'select attribute definitions
  9.     FilterType(0) = 0
  10.     FilterData(0) = "ATTDEF"
  11.     On Error GoTo Exit_Error
  12.         ThisDrawing.SelectionSets.Add "SelSet"
  13.         Set SelSet = ThisDrawing.SelectionSets("SelSet")
  14.         SelSet.Clear
  15.     SelSet.Select acSelectionSetAll, , , FilterType, FilterData
  16.     'if the count is greater than 1 then there are attribute definitions in
  17. modelspace
  18.     If SelSet.Count  0 Then
  19.         YesNo = MsgBox("You Have " & SelSet.Count & " Attribute
  20. Definition(s) in " & ThisDrawing.Name & ". This Program will attempt to
  21. convert them to Text.", _
  22.         vbYesNo + vbCritical + vbDefaultButton1)
  23.         'if "Ok" is pressed then try to replace all of the attribute
  24. definitions with text that has the same properties.
  25.         If YesNo = vbYes Then
  26.             For Each AT In SelSet
  27.                 Set TXT = ThisDrawing.ModelSpace.AddText(AT.TagString,
  28. AT.InsertionPoint, AT.Height)
  29.                 TXT.Alignment = AT.Alignment
  30.                 TXT.Layer = AT.Layer
  31.                 TXT.Color = AT.Color
  32.                 TXT.Rotation = AT.Rotation
  33.                 TXT.Update
  34.                 AT.Delete
  35.             Next
  36.         End If
  37.     End If
  38.     'clear the selection set
  39.     SelSet.Clear
  40.     'rescan the drawing for attribute definitions
  41.     SelSet.Select acSelectionSetAll, , , FilterType, FilterData
  42.     'if it the count is zero then it worked.
  43.     If SelSet.Count = 0 Then
  44.         MsgBox "All attributes were converted to text."
  45.     Else:
  46.         MsgBox "Failed to convert all attributes to text."
  47.     End If
  48. Exit_Error:
  49.    SelSet.Delete
  50.    Set SelSet = Nothing
  51.    Set AT = Nothing
  52.    Set TXT = Nothing
  53. End Sub

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

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

使用道具 举报

154

主题

1274

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1936
发表于 2004-4-12 22:38:36 | 显示全部楼层
你试过“爆破”吗?
回复

使用道具 举报

14

主题

194

帖子

5

银币

后起之秀

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

铜币
250
发表于 2004-4-12 22:57:46 | 显示全部楼层
如果您添加
  1. Dim insertionZero(0 To 2) As Double
  2. insertionZero(0) = 0: insertionZero(1) = 0: insertionZero(2) = 0
  3. TXT.Move insertionZero, AT.InsertionPoint

这应该可以纠正您的问题。
我不知道为什么,但我在使用VBA将文本放入绘图中时遇到了类似的问题。
回复

使用道具 举报

14

主题

194

帖子

5

银币

后起之秀

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

铜币
250
发表于 2004-4-13 08:18:53 | 显示全部楼层
好吧,这个问题是很多人容易忽视的。无论何时使用VBA插入文字并使用对齐点,都应传递两个对齐点
如果文本项定义为左对齐以外的任何内容,Autodesk将使用不同的DXF代码来实现该点。问题是,无论何时,如果初始对齐点是左对齐点,则初始定义一位文本时,InsertionPoint引用的点始终是0,0,0,而无论何时插入左对齐的文本,TextAlignmentPoint所引用的点总是0,0.0,所以
  1.            For Each AT In SelSet
  2.                 Set TXT = ThisDrawing.ModelSpace.AddText(AT.TagString,
  3. AT.InsertionPoint, AT.Height)
  4.                 TXT.Alignment = AT.Alignment
  5.                 TXT.TextAlignmentPoint = AT.TextAlignmentPoint
  6.                 TXT.Layer = AT.Layer
  7.                 TXT.Color = AT.Color
  8.                 TXT.Rotation = AT.Rotation
  9.                 TXT.Update
  10.                 AT.Delete
  11.             Next

所以这应该可以解决这个问题…
只要记住,如果在应用对齐之前应用对齐点,文本有时会做一些事情…
,所以先应用对齐,然后应用对齐点。
回复

使用道具 举报

14

主题

194

帖子

5

银币

后起之秀

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

铜币
250
发表于 2004-4-13 20:27:20 | 显示全部楼层
谢谢伙计们。
我添加了TextAlignmentPoint内容,现在它不会移动所有项目,但会跳过一些属性定义。当我有空的时候,我得靠近一点看一看。
回复

使用道具 举报

18

主题

222

帖子

51

银币

后起之秀

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

铜币
260
发表于 2004-4-13 20:53:13 | 显示全部楼层
下次运行它时关闭错误检查,看看它是否是编码错误。
回复

使用道具 举报

154

主题

1274

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1936
发表于 2004-4-14 21:56:23 | 显示全部楼层
有一次,我正在编写一个lisp,Stig帮我找到了一个解决方案。让我去看看能不能找到。
回复

使用道具 举报

18

主题

222

帖子

51

银币

后起之秀

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

铜币
260
发表于 2004-4-14 22:01:55 | 显示全部楼层
这是怎么回事?
回复

使用道具 举报

18

主题

222

帖子

51

银币

后起之秀

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

铜币
260
发表于 2004-4-15 02:15:48 | 显示全部楼层
谢谢Daron......但是我想在vba中做这件事。我真的不知道Visual lisp,我现在也不打算开始学习它。
回复

使用道具 举报

14

主题

194

帖子

5

银币

后起之秀

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

铜币
250
发表于 2004-4-15 07:59:36 | 显示全部楼层
这太糟糕了。这是一个快速的例程。别客气。
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-15 15:15 , Processed in 0.349120 second(s), 72 queries .

© 2020-2025 乐筑天下

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