用于更改Autocad块属性值的VBA

rickjamieh13 · 发表于 2018-5-11 11:53:46

您好，
；有人能帮我用这个宏启动一个细节模板吗
；对于这个宏，一切都很好，文本根据输入信息更新，比例也会改变，但我无法更改块名的字符串：“No No No modHFGen.dll；详图标签
；我还需要标签：“我需要一个标签。”；详细名称；值：“0”；详细名称“
；和标签：“；“完整”；和价值：；“完整”；也要更新
；见下文
&039；该程序旨在自动创建详细信息
&039；此程序调用了一个模板文件。它被称为
&039&引用；dwgName“；其价值为；C： \Users\holguinr\Documents\DG\u Office\CAD\DG/u CAD\Custom\Detail Library\DGFS\u DET\u TEMPLATE.dwg；。确保；此文件的路径是否正确
Dim StrScale As Variant
Dim intSDI As Integer
Dim entity As Object
Dim sset As AcadSelectionSet
Dim msSpace As ObjectDim acadDoc As Object
Dim acadApp As Object>Dim strFileName As String
Dim StrScale2 As variance
Set acadApp=GetObject（，&quot；Autocad.Autocad.应用程序“
&nbsp
&nbsp；如果出现错误，则&nbsp；MsgBox错误。说明&nbsp；退出Sub&nbsp；如果结束&nbsp
设置acadDoc=acadApp。ActiveDocument；打开详图温度图&nbsp；Dim dwgName作为字符串&nbsp；dwgName=&quot；C： \Users\holguinr\Documents\DG\u Office\CAD\DG/u CAD\Custom\Detail Library\DGFS\u DET\u模板。图纸
&nbsp；If Dir（dwgName）&lt&燃气轮机&引用&引用；然后&nbsp&nbsp&nbsp；如果intSDI=0，则&nbsp&nbsp&nbsp&nbsp；本图纸.应用.文件。打开dwgName&nbsp&nbsp&nbsp；其他&nbsp&nbsp&nbsp&nbsp；此图纸。打开dwgName&nbsp&nbsp&nbsp；如果结束&nbsp；其他&nbsp&nbsp&nbsp；MsgBox“；“文件”&amp；dwgName&amp&引用；不存在&引用
&nbsp&nbsp&nbsp；卸载Me&nbsp；如果结束&nbsp
将strPath设置为字符串
strPath=ThisDrawing.Application。路径&nbsp
调试。打印strPath；设置图形名称和路径；S： \ACA 2011 Support\Template\CA\u Detail\u Template.dwt“
本图纸。SendCommand（“Filedia 0”）
&039；如果希望能够保存详细信息，请取消注释这些行；检查文件是否已存在；Dim Fsys作为新的文件系统对象；Dim Msg、Style、Title、Help、Ctxt、Response、MyString；Msg=&quot；文件Aready已存在，&quot&amp；Chr（13）&amp&引用；你想跳过吗&引用&nbsp&nbsp' 定义消息
&039；Style=vbYesNo+vbCritical+vbDefaultButton2&#039；定义按钮
&039；Title=&quot；文件区域“存在”&nbsp' 定义标题
&039；strFileName=&quot；R： “ACAD\DETAIL\TEMP”&amp；txtName。价值（&A）&QUOTE；。图纸
&039；如果是Fsys。文件存在（strFileName），然后&nbsp' 显示消息
&nbsp'响应=MsgBox（消息、样式、标题）&nbsp&nbsp&nbsp'如果响应=vbYes，则&nbsp' 用户选择是
&nbsp&nbsp&nbsp&nbsp&nbsp' 此图纸。SendCommand（&u saveas 2000&strFileName&Chr（13））&nbsp&nbsp&nbsp&nbsp&nbsp'此图纸。SendCommand（“y”）
&nbsp&nbsp&nbsp&nbsp&nbsp'此图纸。SendCommand（“Filedia 1”）
&nbsp&nbsp&nbsp'其他&nbsp' 用户选择编号&nbsp&nbsp&nbsp&nbsp&nbsp'结束&nbsp&nbsp&nbsp&nbsp&nbsp'卸载Me&nbsp&nbsp&nbsp'如果结束&nbsp'其他&nbsp'此图纸。SendCommand（“saveas 2000”strFileName&Chr（13））
&039；结束If&039；设置图形的比例；这也可以通过控制阵列来实现，如果Opt1.value=True，则&nbsp；StrScale=&quot；Aec\u Full\u CA“
&nbsp；StrSc=”；“完整”
&nbsp；StrScale2=“”；1“
如果Opt2.value=True，则结束&nbsp；StrScale=&quot；Aec\u Half\u Full\u CA“
&nbsp；StrSc=”；“一半”
如果Opt3.value=True，则结束&nbsp；StrScale=&quot；Aec_3_CA“
&nbsp；StrSc=”；3“&amp；Chr（34）&amp&引用=1“&amp；Chr（39）&amp&引用-0“&amp；Chr（34）&nbsp；StrScale2=“”；4“
如果Opt4.value=True，则结束&nbsp；StrScale=&quot；Aec_1_1-2_CA“
&nbsp；StrSc=”；1 1/2“&amp；Chr（34）&amp&引用=1“&amp；Chr（39）&amp&引用-0“&amp；Chr（34）&nbsp；StrScale2=“”；8“
如果Opt5.value=True，则结束&nbsp；StrScale=&quot；Aec_1_CA“
&nbsp；StrSc=”；1“&amp；Chr（34）&amp&引用=1“&amp；Chr（39）&amp&引用-0“&amp；Chr（34）&nbsp；StrScale2=“”；12“
如果结束如果Opt6.value=True，则&nbsp；StrScale=&quot；Aec_3-4_CA“
&nbsp；StrSc=”；3/4“&amp；Chr（34）&amp&引用=1“&amp；Chr（39）&amp&引用-0“&amp；Chr（34）&nbsp；StrScale2=“”；16“
如果Opt7.value=True，则结束&nbsp；StrScale=&quot；Aec_1-2_CA“
&nbsp；StrSc=”；1/2“&amp；Chr（34）&amp&引用=1“&amp；Chr（39）&amp&引用-0“&amp；Chr（34）&nbsp；StrScale2=“”；24“
如果Opt8.value=True，则结束&nbsp；StrScale=&quot；Aec_3-8_CA“
&nbsp；StrSc=”；3/8“&amp；Chr（34）&amp&引用=1“&amp；Chr（39）&amp&引用-0“&amp；Chr（34）&nbsp；StrScale2=“”；32“
如果Opt9.value=True，则结束&nbsp；StrScale=&quot；Aec_1-4_CA“
&nbsp；StrSc=”；1/4“&amp；Chr（34）&amp&引用=1“&amp；Chr（39）&amp&引用-0“&amp；Chr（34）&nbsp；StrScale2=“”；48“
如果Opt10.value=True，则结束&nbsp；StrScale=&quot；Aec_1-8_CA“
&nbsp；StrSc=”；1/8“&amp；Chr（34）&amp&引用=1“&amp；Chr（39）&amp&引用-0“&amp；Chr（34）&nbsp；StrScale2=“”；96“
如果调试，则结束。将StrScale Dim strCommand打印为String
Dim SC作为Variant
Dim strheight作为Double
Dim limy作为doubly
调试。打印strLimits；设置文本高度（strheight=CDbl（StrScale2）
height=0.09375*strheight &039；设置此图形的尺寸比例。SendCommand（“-dimstyle”R“Chr（13）”和；StrScale&amp；Chr（13）&amp&引用&quot；）
&039；设置该图形的线型比例。SendCommand（“Ltscale”StrScale2）
&039；重新生成图形
此图形。SendCommand（“regen”）
&039；设置绘图限制。SendCommand（“限制”Chr（13）&；Chr（13）&amp；strLimits&amp；Chr（13））
&039；在此绘图中将filedia变量设置为1。SendCommand（“Filedia 1”）
&039；设置图形的文本样式。SendCommand（“TEXTSTYLE”Chr（13）和&引用；Notes_CA“&amp；Chr（13））
&039；设置图形的文字高度。SendCommand（“TEXTSIZE”（高度）和&引用&quot；）
调试。打印StrSc；作为对象的Dim elem；Dim被发现为布尔值；Dim txtStr作为字符串；Dim txtTemp作为字符串
；txtStr=&quot；“一半”
&nbsp
' 在模型空间中循环实体' 并更改文本&nbsp
&nbsp；对于本图纸中的每个元素。模型空间&nbsp&nbsp&nbsp；使用elem&nbsp&nbsp&nbsp&nbsp&nbsp；如果（.EntityName=“AcDbText”）或（.EntityName=“AcDbMText”）然后&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp' 更改文本实体的高度&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp'.TextString=&quot；测试“
&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp'.更新&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp'发现=真&nbsp&nbsp&nbsp&nbsp&nbsp'如果结束&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；txtTemp=.TextString&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果txtTemp=&quot；“完整”；然后&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp。TextString=StrSc&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果结束&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果txtTemp=&quot；详细名称“；然后&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp。TextString=txtName&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果结束&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp。更新&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；发现=真&nbsp&nbsp&nbsp&nbsp&nbsp；如果结束&nbsp&nbsp&nbsp；以结尾&nbsp&nbsp&nbsp；设置元素=无&nbsp&nbsp&nbsp
&nbsp；下一个要素&nbsp；Dim attributeObj作为AcadAttribute作为字符串Dim Tag1作为字符串；详细名称
value1=；详细名称“
作为字符串的Dim Tag2；“完整”
value2=；“完整”
&nbsp；对于本图纸中的每个元素。模型空间&nbsp；&nbsp&nbsp；使用elem&nbsp&nbsp&nbsp&nbsp&nbsp；如果（.EntityName=AcadAttribute），则&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp' 更改文本实体的高度&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp'.TextString=&quot；测试“
&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp'.更新&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp'发现=真&nbsp&nbsp&nbsp&nbsp&nbsp'如果结束&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；txtTemp=.TextString&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果值2=“”；“完整”；然后&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp。TextString=StrSc&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果结束&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果值1=&quot；详细名称“；然后&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp。TextString=txtName&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果结束&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp。更新&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；发现=真&nbsp&nbsp&nbsp&nbsp&nbsp；如果结束&nbsp&nbsp&nbsp；以结尾&nbsp&nbsp&nbsp；设置元素=无&nbsp&nbsp&nbsp
&nbsp；下一个元素是ThisDrawing.Application.ZoomeExtents。Regen acAllViewports卸载Me
End-Sub
Private-Sub Opt6\u Click（）
endsub（ByVal键代码为MSForms.ReturnInteger，ByVal移位为Integer）&nbsp&nbsp；如果键代码=13，则CmdOk。SetFocus End Sub CMDNCANCEL\u Click（）
卸载Me

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

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

BIGAL · 发表于 2018-5-11 13:19:22

你赢了&#039；在模型空间中找不到许多attributereference，但您会找到拥有属性的块引用。抓取块，然后对集合中的每个属性施展魔法

BIGAL · 发表于 2018-5-11 22:26:51

VBA中的一个优点是，检索到的块属性可以通过其顺序att（1）等而不是标记名来引用

copy

For Cntr = 0 To SS.Count - 1
If SS.Item(Cntr).Name = BLOCK_NAME Then
     attribs = SS.Item(Cntr).GetAttributes
        
     If attribs(0).TextString = pitname Then
       pt1 = ThisDrawing.Utility.GetPoint(, " pick first point")
       txtx1 = CStr(FormatNumber(pt1(0), 3))
       TXTY1 = CStr(FormatNumber(pt1(1), 3))
        
        attribs(1).TextString = txtx1
        attribs(2).TextString = TXTY1
        
        attribs(1).Update
        attribs(2).Update
        Cntr = SS.Count
     
     Else: End If
      
 Else: End If
Next Cntr

BIGAL · 发表于 2018-5-18 04:07:27

如果我怀疑（.EntityName=AcadAttribute）返回了您PM给我的错误，则需要首先获取块，然后才能获取属性。

用于更改Autocad块属性值的VBA

发表回复

精选推荐