社区 › Auto Lisp › 编辑属性宽度因子

hendersondayton 发表于 2022-7-6 17:15:37

编辑属性宽度因子

我使用VBA成功地使用以下代码编辑了属性的值：
 
出错时继续下一步
使用此图纸
对于每个oLayout In。布局
对于k=0到oLayout。块计数-1
Set entry=oLayout。块项目（k）
Objname=条目。对象名称
如果Objname=“AcDbBlockReference”，则
如果输入。然后命名为“Title Info*”
atts=入口。获取属性
对于I=LBound（atts）到UBound（atts）
如果附件（I）。TagString=“PG”然后
附件（一）。TextString=oLayout。名称
如果结束
 
 
我现在正试图编辑这个特定的属性宽度因子，我很难做到这一点。
任何建议都很好

fixo 发表于 2022-7-6 17:58:06

欢迎加入！
试试看
 
Private Sub Ch_Att_Width(bName As String, atag As String, dblWid As Double)

    Dim oSset As AcadSelectionSet, _
      blkRef As AcadBlockReference, _
      attObj As AcadAttributeReference, _
      attData() As AcadObject, _
      fType(2) As Integer, _
      fData(2) As Variant, _
      dxfType, _
      dxfData, _
      k As Integer


    fType(0) = 0: fType(1) = 2: fType(2) = 66
    fData(0) = "INSERT": fData(1) = bName: fData(2) = 1
    dxfType = fType: dxfData = fData
   
    For Each oSset In ThisDrawing.SelectionSets
         If oSset.Name = "$Blocks$" Then
            oSset.Delete
            Exit For
         End If
    Next oSset

    Set oSset = ThisDrawing.SelectionSets.Add("$Blocks$")
   
    MsgBox "Select blocks on screen"

    oSset.SelectOnScreen dxfType, dxfData

    For Each blkRef In oSset
         attData = blkRef.GetAttributes

         For k = 0 To UBound(attData)
            Set attObj = attData(k)

            If StrComp(attObj.TagString, atag) = 0 Then
                   attObj.ScaleFactor = dblWid
                   attObj.Update
                   blkRef.Update
                   Exit For
            End If

         Next k

    Next blkRef

    oSset.Delete

    Set oSset = Nothing
   
    MsgBox "Done"

End Sub


Sub demo()
Ch_Block_Att_Width "MLR", "PRESET", 0.45
' where: "MLR" is block name,
' "PRESET" is desired tag,
' 0.45 is width factor
End Sub
 
~'J'~

russell84 发表于 2022-7-6 18:22:56

另一条路
 

SUB rename&changewidth()
Dimj, k As Integer
Dim ELEMENT, ArrayAttributes


On Error Resume Next
For j = 0 To ThisDrawing.Layouts.Count - 1               
If ThisDrawing.Layouts(j).Name = "Model" Then GoTo 10ThisDrawing.SendCommand "layout s " & ThisDrawing.Layouts(j).Name & vbCr
               For Each ELEMENT In ThisDrawing.PaperSpace
                   If ELEMENT.EntityType = 7 Then
                     If Err Then GoTo 5
                     If ELEMENT.HasAttributes = True Then
                           ArrayAttributes = ELEMENT.GetAttributes
                           For k = LBound(ArrayAttributes) To UBound(ArrayAttributes)
                               If ArrayAttributes(k).TagString = "TYPEATTRIBUTETAGLABELHERE" Then ArrayAttributes(k).TextString = "TYPE TEXT TO CHANGE ATTRIBUTE TO HERE"
                               If ArrayAttributes(k).TagString = "TYPEATTRIBUTETAGLABELHERE" Then ArrayAttributes(k).ScaleFactor = 12 ' this is the width of your attribute

                           Next k
                     End If
5
                   End If
               Next
10
         Next j

End SUB

查看完整版本: 编辑属性宽度因子