';;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Sub ManyAssyPartList_DrawingManySheet()

Application.ScreenUpdating = False
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("MANYASSYPARTLIST")
WS.Visible = True

'Clear Old Data
WS.Range("A2:L1000").ClearContents

'Thisdrawing
Dim Thisdrawing As AcadDocument
Set Thisdrawing = KhoidongAutoCad()


'Select Obj by SelectOnScreen
Dim objSelectOnScreen As AcadSelectionSet
Set objSelectOnScreen = Thisdrawing.SelectionSets.ADD("objSelectOnScreen" & Now)
Dim FT(0) As Integer
Dim FD(0) As Variant
FT(0) = 0: FD(0) = "INSERT"

Do
objSelectOnScreen.Clear
objSelectOnScreen.SelectOnScreen FT, FD
Call ManyAssyPartList_DrawingManySheet_Fun01(WS, objSelectOnScreen)
Loop While objSelectOnScreen.Count > 0

objSelectOnScreen.Delete


'Sheets("MENU").Select
'WS.Visible = False
Application.ScreenUpdating = True
MsgBox "Finish"

End Sub
Function ManyAssyPartList_DrawingManySheet_Fun01(WS As Worksheet, objSelectOnScreen As AcadSelectionSet)

'Khai bao Blockname va tagname de lay S_No va Qty
Dim SizeBlockName As String
SizeBlockName = ThisWorkbook.Sheets("SETUP").Range("B14").Value
Dim BlockNameSNo As String: BlockNameSNo = "DRAWING_TITLE3"
Dim TagNameSNo As String: TagNameSNo = "S_NO"
Dim BlockNameQty As String: BlockNameQty = "DRAWING_TITLE5"
Dim TagNameQty As String: TagNameQty = "QUAN"
Dim TagNameMat As String: TagNameMat = "MATERIAL"
Dim SNoValue As String
Dim QtyValue As String
Dim StrMaterial As String

If objSelectOnScreen.Count = 0 Then
MsgBox "No Selected Block"
Exit Function
End If

Dim EachBlockRef As AcadBlockReference
Dim EachBlockname As String
Dim PartListBlockRefArr() As Variant
Dim i As Integer

'Creat PartListArr
For Each EachBlockRef In objSelectOnScreen
EachBlockname = EachBlockRef.Name
Select Case EachBlockname
Case BlockNameSNo
SNoValue = Func03GetAttValue(EachBlockRef, TagNameSNo)
SNoValue = "-" & Left(SNoValue, 4)
Case BlockNameQty
QtyValue = Func03GetAttValue(EachBlockRef, TagNameQty)
Case SizeBlockName
StrMaterial = Func03GetAttValue(EachBlockRef, TagNameMat)
If Left(StrMaterial, 1) = "-" Then
ReDim Preserve PartListBlockRefArr(0 To i)
Set PartListBlockRefArr(i) = EachBlockRef
i = i + 1
End If
End Select
Next

'Creat WriteData
Dim WriteData() As String
Dim varAttributes As Variant
ReDim WriteData(0 To UBound(PartListBlockRefArr), 0 To 11)
For i = LBound(WriteData) To UBound(WriteData)
Set EachBlockRef = PartListBlockRefArr(i)
varAttributes = EachBlockRef.GetAttributes
WriteData(i, 0) = SNoValue
WriteData(i, 1) = QtyValue
For k = LBound(varAttributes) To UBound(varAttributes)
WriteData(i, k + 2) = varAttributes(k).TextString
Next
Next

'Write Data to Excel
Dim EndRow As Integer
EndRow = WS.Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim RowNo As Integer
Dim ColumnNo As Integer
For i = LBound(WriteData) To UBound(WriteData)
RowNo = EndRow + i
For k = 0 To 11
ColumnNo = k + 1
WS.Cells(RowNo, ColumnNo).Value = WriteData(i, k)
Next
Next

End Function