社区 › VB › 用文本替换属性定义。

Keith™ 发表于 2004-4-12 19:46:35

用文本替换属性定义。

我正在尝试用文本替换模型空间中的所有属性定义。下面的代码将所有属性替换为文本，但由于某种原因，其中一些属性移动到 0，0，0。有人有什么想法吗？

Public Sub remove_attdef()
    Dim SelSet As AcadSelectionSet
    Dim AT As AcadAttribute
    Dim FilterType(0 To 0) As Integer
    Dim FilterData(0 To 0) As Variant
    Dim TXT As AcadText
    Dim YesNo
    'select attribute definitions
    FilterType(0) = 0
    FilterData(0) = "ATTDEF"
    On Error GoTo Exit_Error
      ThisDrawing.SelectionSets.Add "SelSet"
      Set SelSet = ThisDrawing.SelectionSets("SelSet")
      SelSet.Clear
    SelSet.Select acSelectionSetAll, , , FilterType, FilterData
    'if the count is greater than 1 then there are attribute definitions in
modelspace
    If SelSet.Count0 Then
      YesNo = MsgBox("You Have " & SelSet.Count & " Attribute
Definition(s) in " & ThisDrawing.Name & ". This Program will attempt to
convert them to Text.", _
      vbYesNo + vbCritical + vbDefaultButton1)
      'if "Ok" is pressed then try to replace all of the attribute
definitions with text that has the same properties.
      If YesNo = vbYes Then
            For Each AT In SelSet
                Set TXT = ThisDrawing.ModelSpace.AddText(AT.TagString,
AT.InsertionPoint, AT.Height)
                TXT.Alignment = AT.Alignment
                TXT.Layer = AT.Layer
                TXT.Color = AT.Color
                TXT.Rotation = AT.Rotation
                TXT.Update
                AT.Delete
            Next
      End If
    End If
    'clear the selection set
    SelSet.Clear
    'rescan the drawing for attribute definitions
    SelSet.Select acSelectionSetAll, , , FilterType, FilterData
    'if it the count is zero then it worked.
    If SelSet.Count = 0 Then
      MsgBox "All attributes were converted to text."
    Else:
      MsgBox "Failed to convert all attributes to text."
    End If
Exit_Error:
   SelSet.Delete
   Set SelSet = Nothing
   Set AT = Nothing
   Set TXT = Nothing
End Sub

**** Hidden Message *****

Keith™ 发表于 2004-4-12 22:38:36

你试过“爆破”吗？

daron 发表于 2004-4-12 22:57:46

如果您添加
Dim insertionZero(0 To 2) As Double
insertionZero(0) = 0: insertionZero(1) = 0: insertionZero(2) = 0
TXT.Move insertionZero, AT.InsertionPoint
这应该可以纠正您的问题。
我不知道为什么，但我在使用VBA将文本放入绘图中时遇到了类似的问题。

daron 发表于 2004-4-13 08:18:53

好吧，这个问题是很多人容易忽视的。无论何时使用VBA插入文字并使用对齐点，都应传递两个对齐点
如果文本项定义为左对齐以外的任何内容，Autodesk将使用不同的DXF代码来实现该点。问题是，无论何时，如果初始对齐点是左对齐点，则初始定义一位文本时，InsertionPoint引用的点始终是0,0,0，而无论何时插入左对齐的文本，TextAlignmentPoint所引用的点总是0,0.0，所以
         For Each AT In SelSet
                Set TXT = ThisDrawing.ModelSpace.AddText(AT.TagString,
AT.InsertionPoint, AT.Height)
                TXT.Alignment = AT.Alignment
                TXT.TextAlignmentPoint = AT.TextAlignmentPoint
                TXT.Layer = AT.Layer
                TXT.Color = AT.Color
                TXT.Rotation = AT.Rotation
                TXT.Update
                AT.Delete
            Next

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

daron 发表于 2004-4-13 20:27:20

谢谢伙计们。
我添加了TextAlignmentPoint内容，现在它不会移动所有项目，但会跳过一些属性定义。当我有空的时候，我得靠近一点看一看。

hendie 发表于 2004-4-13 20:53:13

下次运行它时关闭错误检查，看看它是否是编码错误。

Keith™ 发表于 2004-4-14 21:56:23

有一次，我正在编写一个lisp，Stig帮我找到了一个解决方案。让我去看看能不能找到。

hendie 发表于 2004-4-14 22:01:55

这是怎么回事？

hendie 发表于 2004-4-15 02:15:48

谢谢Daron......但是我想在vba中做这件事。我真的不知道Visual lisp，我现在也不打算开始学习它。

daron 发表于 2004-4-15 07:59:36

这太糟糕了。这是一个快速的例程。别客气。

查看完整版本: 用文本替换属性定义。