社区 › VB › 使用vba更新块属性

gunnahdo 发表于 2004-6-17 19:38:50

使用vba更新块属性

我在vba更新单个块属性时遇到麻烦，
你在绘图中选择存量数据的ansewr我正在测试acadblock块名称，然后是正确的块属性，因此然后更新（我在块中有11个属性）
我看不出我哪里出错了，一些行被剪掉以使电子邮件更短，一组新的眼睛可能会看到明显的，我让它工作，但在测试dwg之外发现了问题，所以我知道代码是99%
Public Sub ModifyPitschdule4（）
'将2 Pts x和y
Dim SS作为AcadSelectionSet
'Dim ObENT As AcadEntity
Dim Count As整数
Dim val， Pitname As String
Dim PitNameSelect As AcadObject
Dim basepnt， pt1， pt2， pt3 As Variant
Dim attribs As Variant
On Error Resume Next
Set SS=ThisDrawing.SelectionSets.Add（"MYSS2"）
SS.SelectacSelectionSetAll
val="SCHEDTEXT"'this is block name
ThisDrawing.Utility.GetEntityPitNameSelect， basepnt，"选择坑名："
如果PitNameSelect.ObjectName="AcDbText"那么
MsgBox"选择的坑名是"&Pitname
结束如果
如果PitNameSelect.ObjectName="AcDbBlockAud"那么
Pitblname=PitNameSelect.Name'RETRURNS BLOCK NAME
attribs=PitNameSelect.GetAttributes
Pitname=attribs（0）。TextString
MsgBox"皮特名删除论坛的行
pt1=ThisDrawing.Utility.GetPoint（，"选择第一点"）
pt2=ThisDrawing.Utility.GetPoint（，"选择第二点L"）
pt3=ThisDrawing.Utility.GetPoint（，"选择第三点W"）
长度坑=CStr（FormatNumber（lz，0））
widthpit=CStr（FormatNumber（lz，0））
代码再次开始这里
对于i=1到SS.Count
设置对象=SS（i）
如果objENT.EntityName="AcDbBlockResources"然后
attribs=objENT.GetAttributes
MsgBox"1 ATTRIB name IS"&objENT.EntityName&"......"&objENT.Name&"......"&attribs（0）。TextString
'不在这里返回块名称
如果objENT.Name=val那么'这不起作用
'attribs=objENT.GetAttributes
MsgBox"2块名称IS"&objENT.Name&"......"&i&"......"&attribs（0）。TextString
'这会找到块
如果attribs（0）。TextString=Pitname然后
'在这里更新属性值。
attribs（1）。TextString=txtx1
attribs（2）。TextString=txtx2
attribs（3）。TextString=txtx2
attribs（4）。TextString=txty2
attribs（5）。TextString=长度坑
attribs（6）。#结束所有的ifs等
**** Hidden Message *****

hendie 发表于 2004-6-18 04:00:03

我现在很忙，真的没有时间调查你的日常工作，但这可能会有所帮助。我用它来从文本框值设置块中的属性值。
如果您已经知道块名称，为什么不直接过滤您的选择呢？
Private Sub UpdateBlock_Click()
    Dim BlkNm As AcadBlockReference
    Dim BlkAtts As Variant
    Dim FW As String
    FW = TextFW.Value
   
      Set SSetCol = ThisDrawing.SelectionSets
             For Each SSet1 In SSetCol
               If SSet1.Name = "SS1" Then
               ThisDrawing.SelectionSets.Item("SS1").Delete
             Exit For
             End If
      Next
         
            Mode = acSelectionSetAll
      Set SSet1 = ThisDrawing.SelectionSets.Add("SS1")
                Dim FilterType(0 To 1) As Integer
                Dim FilterData(0 To 1) As Variant
                  FilterType(0) = 0: FilterData(0) = "INSERT"
                  FilterType(1) = 2: FilterData(1) = "FW*"
            SSet1.Select Mode, , , FilterType, FilterData
            
    For Each BlkNm In SSet1
               BlkAtts = BlkNm.GetAttributes
               BlkAtts(0).TextString = Format(FW, "#0") & " %%P2"
    Next

    ThisDrawing.Regen acActiveViewport
            Unload Me
            
End Sub

查看完整版本: 使用vba更新块属性