發佈日期:
分類:
如何在AutoCAD中‧使用VBA找出圖檔中Attribute Block中的內容
幾萬張圖檔(Drawing)中,款式真的是應有盡有,所指的款式,不是指內容的款式,而是各有各的畫法,各有各的表達方式,要把它們的基本資料找出來,就像要使出百多種的方法,怪不知要請我來做啦!
Public Sub getAttributeReference() Dim objReturn As AcadObject Dim revObj As AcadObject Dim varBasePoint, revBasePoint As Variant Dim strBlockName As String Dim revString As String Dim avarAttributes As Variant Dim intIndex As Integer Dim objBlockReference As AcadBlockReference Dim revObjReference As AcadText Dim objAcadAttributeReference As AcadAttributeReference Dim strShowMessage As String Call ThisDrawing.Utility.GetEntity(objReturn, varBasePoint, "Select attribute block: ") If objReturn.ObjectName = "AcDbBlockReference" Then Set objBlockReference = objReturn strBlockName = objBlockReference.Name strShowMessage = "Attribute block name: " + strBlockName + vbCr If objBlockReference.HasAttributes Then avarAttributes = objBlockReference.GetAttributes For intIndex = LBound(avarAttributes) To UBound(avarAttributes) Set objAcadAttributeReference = avarAttributes(intIndex) If objAcadAttributeReference.ObjectName = "AcDbAttribute" Then Select Case objAcadAttributeReference.TagString ''Modify the selection case for your drawing. Case "REV" rev = objAcadAttributeReference.TextString Case "TITLE1" t1 = objAcadAttributeReference.TextString Case "TITLE2" t2 = objAcadAttributeReference.TextString Case "TITLE3" t3 = objAcadAttributeReference.TextString Case "TITLE4" t4 = objAcadAttributeReference.TextString Case "TITLE5" t5 = objAcadAttributeReference.TextString Case "DRAWN" drawnBy = objAcadAttributeReference.TextString Case "CHECK" checkedBy = objAcadAttributeReference.TextString Case "APPROVE" approvedBy = objAcadAttributeReference.TextString Case "DWGNO" dwgNo = objAcadAttributeReference.TextString Case "PROJ1" p1 = objAcadAttributeReference.TextString Case "PROJ2" p2 = objAcadAttributeReference.TextString Case "PROJ3" p3 = objAcadAttributeReference.TextString Case "PROJ4" p4 = objAcadAttributeReference.TextString End Select End If Next intIndex End If titleName = t1 + " " + t2 + " " + t3 + " " + t4 projectName = p1 + " " + p2 + " " + p3 + " " + p4 End If ''Compose all information of drawing into sentense. txtTotal = DwgNo + ";" + rev + ";" + titleName + ";;;" + drawnBy + ";;" + checkedBy + ";;" + approvedBy + ";;;" + projectName dwgPre = ThisDrawing.GetVariable("dwgprefix") dwgNam = ThisDrawing.GetVariable("dwgname") dwgInfo = dwgPre + dwgNam dwgAll = dwgInfo + ";" + txtTotal ''Add all drawing information into a file. Open "writeToFile.txt" For Append As #1 Write #1, dwgAll Close #1 End Sub
發佈留言