cass文件中图元经常有扩展属性,查询扩展属性代码及方法如下:
打开dwg文件 —> alt+F11打开ide窗口,粘贴如下代码,并运行:
Sub 查看扩展属性()'提取块的扩展属性'只针对带有属性的图元'On Error Resume NextDim sst As AcadSelectionSetSet sst = ThisDrawing.SelectionSets.Add("sst113")MsgBox "请回cad界面选择图元:"sst.SelectOnScreenDim xdataout As Variant, xtypeout As VariantDim ent As AcadEntityDim strFor Each ent In sstent.GetXData "", xtypeout, xdataoutOn Error GoTo line1For i = LBound(xtypeout) To UBound(xtypeout)str = str & xtypeout(i) & "--" & xdataout(i) & Chr(10)NextNextThisDrawing.Utility.Prompt str
line1:If Err <> 0 ThenMsgBox "没有扩展属性", vbOKOnly, "查看扩展属性"ElseMsgBox str, vbOKOnly, "查看扩展属性"End Ifsst.Delete
End Sub
以下为手工为图元录入xdata扩展属性并查询的 代码:
Sub 手工录入并查看扩展属性()'提取块的扩展属性'只针对带有属性的图元'On Error Resume NextDim sst As AcadSelectionSetSet sst = ThisDrawing.SelectionSets.Add("sst116")MsgBox "请回cad界面选择图元:"sst.SelectOnScreenDim xdataout As Variant, xtypeout As VariantDim ent As AcadEntityDim strDim xt(0 To 4) As Integer, xd(0 To 4) As Variantxt(0) = 1001: xd(0) = "south"xt(1) = 1000: xd(1) = "djh"xt(2) = 1000: xd(2) = "110103"xt(3) = 1000: xd(3) = "qlr"xt(4) = 1000: xd(4) = "西游记社区"For Each ent In sstent.SetXData xt, xdent.GetXData "", xtypeout, xdataoutOn Error GoTo line1For i = LBound(xtypeout) To UBound(xtypeout)str = str & xtypeout(i) & "--" & xdataout(i) & Chr(10)NextNextThisDrawing.Utility.Prompt str
line1:If Err <> 0 ThenMsgBox "没有扩展属性", vbOKOnly, "查看扩展属性"ElseMsgBox str, vbOKOnly, "查看扩展属性"End Ifsst.Delete
End Sub