使用vba更新块属性

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

我在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等

本帖以下内容被隐藏保护；需要你回复后，才能看到！

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

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

我现在很忙，真的没有时间调查你的日常工作，但这可能会有所帮助。我用它来从文本框值设置块中的属性值。
如果您已经知道块名称，为什么不直接过滤您的选择呢？

copy

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更新块属性

发表回复

精选推荐