[编程交流] Get Attributes, Selection Sets

(setq ss (ssget "X"               (list (cons 0 "INSERT")                     (cons 2 "A1Partners")                     (if (getvar "CTAB")                       (cons 410 (getvar "CTAB"))                       (cons 67 (- 1 (getvar "TILEMODE")))))))

Option ExplicitDim objXL As Excel.ApplicationPrivate Sub CreateNewIssue()Dim intCode(1) As IntegerDim varData(1) As VariantDim layBlock As AcadBlockDim elem As AcadEntityDim cLay As AcadLayoutDim Array1 As VariantDim RowNum As LongDim aCount As LongDim Workbook As Excel.WorkbookDim getAcObj As AcadObjectDim anExcelActiveWorkBook As Excel.WorkbookDim anExcelActiveSheet As Excel.WorksheetDim Cust() As StringDim col As LongDim row As LongDim DrgNo As Long  ' To Create Drawing Register / Doc Issue Sheet  'SummaryInfo  RowNum = 1  DrgNo = 1  'Checks Excel Is Running (Using Function IsExcel Running)  If Not IsExcelRunning() Then     MsgBox "Problem starting Excel!"     Exit Sub  End If      'Turns Screen Updating Off While Doc Issue Populates  objXL.Application.ScreenUpdating = True   'To Be Changed To False Upon Completion  intCode(0) = 0: varData(0) = "Insert"  intCode(1) = 2: varData(1) = "*Partners"  If AllSS(intCode, varData) > 0 Then     For Each elem In ThisDrawing.SelectionSets.Item("TempSSet")     Set layBlock = ThisDrawing.ObjectIdToObject(elem.OwnerID)     Set cLay = layBlock.Layout        If elem.HasAttributes Then           Array1 = elem.GetAttributes           objXL.Visible = True           objXL.WindowState = 3           Set anExcelActiveWorkBook = objXL.Workbooks.Add           anExcelActiveWorkBook.Activate           Set anExcelActiveSheet = anExcelActiveWorkBook.ActiveSheet           'Puts Titles On Sheet 1 (i.e Project1, Project 2, etc)           For aCount = LBound(Array1) To UBound(Array1)              anExcelActiveSheet.Cells(RowNum, aCount + 1) = Array1(aCount).TagString           Next aCount           RowNum = 2        End If        'Puts Information Under Titles (i.e 100 Street, Town)        For aCount = LBound(Array1) To UBound(Array1)           anExcelActiveSheet.Cells(RowNum, aCount + 1) = Array1(aCount).TextString           anExcelActiveSheet.Columns(aCount + 1).EntireColumn.AutoFit           objXL.Cells(RowNum, 16) = CStr(cLay.Name)           objXL.Cells(RowNum, 17) = DrgNo        Next aCount        RowNum = RowNum + 1        DrgNo = DrgNo + 1     Next elem     ' Taking custom properties            Cust = GetCurrentCustoms()      For row = 0 To UBound(Cust, 1)          objXL.Cells(row + 2, 21) = Cust(row, 0)          objXL.Cells(row + 2, 22) = Cust(row, 1)      Next  'Job Number          objXL.Range("P2:P21").NumberFormat = "00"          objXL.Sheets("Sheet1").Name = "Job Data"  'Drawing Titles (Max 60 i.e Max 3 Sheets)          objXL.Columns("R:R").ColumnWidth = 100          objXL.Range("R2").Formula = "=IF(ISBLANK(D2),"" "",IF(ISBLANK(H2),D2,CONCATENATE(D2,"" "",E2,"" "",F2)))"          objXL.Range("R3").Formula = "=IF(ISBLANK(D3),"" "",IF(ISBLANK(H3),D3,CONCATENATE(D3,"" "",E3,"" "",F3)))"          objXL.Range("R4").Formula = "=IF(ISBLANK(D4),"" "",IF(ISBLANK(H4),D4,CONCATENATE(D4,"" "",E4,"" "",F4)))"          objXL.Range("R5").Formula = "=IF(ISBLANK(D5),"" "",IF(ISBLANK(H5),D5,CONCATENATE(D5,"" "",E5,"" "",F5)))"          objXL.Range("R6").Formula = "=IF(ISBLANK(D6),"" "",IF(ISBLANK(H6),D6,CONCATENATE(D6,"" "",E6,"" "",F6)))"          objXL.Range("R7").Formula = "=IF(ISBLANK(D7),"" "",IF(ISBLANK(H7),D7,CONCATENATE(D7,"" "",E7,"" "",F7)))"          objXL.Range("R8").Formula = "=IF(ISBLANK(D8),"" "",IF(ISBLANK(H8),D8,CONCATENATE(D8,"" "",E8,"" "",F8)))"          objXL.Range("R9").Formula = "=IF(ISBLANK(D9),"" "",IF(ISBLANK(H9),D9,CONCATENATE(D9,"" "",E9,"" "",F9)))"          objXL.Range("R10").Formula = "=IF(ISBLANK(D10),"" "",IF(ISBLANK(H10),D10,CONCATENATE(D10,"" "",E10,"" "",F10)))"          objXL.Range("R11").Formula = "=IF(ISBLANK(D11),"" "",IF(ISBLANK(H11),D11,CONCATENATE(D11,"" "",E11,"" "",F11)))"          objXL.Range("R12").Formula = "=IF(ISBLANK(D12),"" "",IF(ISBLANK(H12),D12,CONCATENATE(D12,"" "",E12,"" "",F12)))"          objXL.Range("R13").Formula = "=IF(ISBLANK(D13),"" "",IF(ISBLANK(H13),D13,CONCATENATE(D13,"" "",E13,"" "",F13)))"          objXL.Range("R14").Formula = "=IF(ISBLANK(D14),"" "",IF(ISBLANK(H14),D14,CONCATENATE(D14,"" "",E14,"" "",F14)))"          objXL.Range("R15").Formula = "=IF(ISBLANK(D15),"" "",IF(ISBLANK(H15),D15,CONCATENATE(D15,"" "",E15,"" "",F15)))"          objXL.Range("R16").Formula = "=IF(ISBLANK(D16),"" "",IF(ISBLANK(H16),D16,CONCATENATE(D16,"" "",E16,"" "",F16)))"          objXL.Range("R17").Formula = "=IF(ISBLANK(D17),"" "",IF(ISBLANK(H17),D17,CONCATENATE(D17,"" "",E17,"" "",F17)))"          objXL.Range("R18").Formula = "=IF(ISBLANK(D18),"" "",IF(ISBLANK(H18),D18,CONCATENATE(D18,"" "",E18,"" "",F18)))"          objXL.Range("R19").Formula = "=IF(ISBLANK(D19),"" "",IF(ISBLANK(H19),D19,CONCATENATE(D19,"" "",E19,"" "",F19)))"          objXL.Range("R20").Formula = "=IF(ISBLANK(D20),"" "",IF(ISBLANK(H20),D20,CONCATENATE(D20,"" "",E20,"" "",F20)))"          objXL.Range("R21").Formula = "=IF(ISBLANK(D21),"" "",IF(ISBLANK(H21),D21,CONCATENATE(D21,"" "",E21,"" "",F21)))"          objXL.Range("R22").Formula = "=IF(ISBLANK(D22),"" "",IF(ISBLANK(H22),D22,CONCATENATE(D22,"" "",E22,"" "",F22)))"          objXL.Range("R23").Formula = "=IF(ISBLANK(D23),"" "",IF(ISBLANK(H23),D23,CONCATENATE(D23,"" "",E23,"" "",F23)))"          objXL.Range("R24").Formula = "=IF(ISBLANK(D24),"" "",IF(ISBLANK(H24),D24,CONCATENATE(D24,"" "",E24,"" "",F24)))"          objXL.Range("R25").Formula = "=IF(ISBLANK(D25),"" "",IF(ISBLANK(H25),D25,CONCATENATE(D25,"" "",E25,"" "",F25)))"          objXL.Range("R26").Formula = "=IF(ISBLANK(D26),"" "",IF(ISBLANK(H26),D26,CONCATENATE(D26,"" "",E26,"" "",F26)))"          objXL.Range("R27").Formula = "=IF(ISBLANK(D27),"" "",IF(ISBLANK(H27),D27,CONCATENATE(D27,"" "",E27,"" "",F27)))"          objXL.Range("R28").Formula = "=IF(ISBLANK(D28),"" "",IF(ISBLANK(H28),D28,CONCATENATE(D28,"" "",E28,"" "",F28)))"          objXL.Range("R29").Formula = "=IF(ISBLANK(D29),"" "",IF(ISBLANK(H29),D29,CONCATENATE(D29,"" "",E29,"" "",F29)))"          objXL.Range("R30").Formula = "=IF(ISBLANK(D30),"" "",IF(ISBLANK(H30),D30,CONCATENATE(D30,"" "",E30,"" "",F30)))"          objXL.Range("R31").Formula = "=IF(ISBLANK(D31),"" "",IF(ISBLANK(H31),D31,CONCATENATE(D31,"" "",E31,"" "",F31)))"          objXL.Range("R32").Formula = "=IF(ISBLANK(D32),"" "",IF(ISBLANK(H32),D32,CONCATENATE(D32,"" "",E32,"" "",F32)))"          objXL.Range("R33").Formula = "=IF(ISBLANK(D33),"" "",IF(ISBLANK(H33),D33,CONCATENATE(D33,"" "",E33,"" "",F33)))"          objXL.Range("R34").Formula = "=IF(ISBLANK(D34),"" "",IF(ISBLANK(H34),D34,CONCATENATE(D34,"" "",E34,"" "",F34)))"          objXL.Range("R35").Formula = "=IF(ISBLANK(D35),"" "",IF(ISBLANK(H35),D35,CONCATENATE(D35,"" "",E35,"" "",F35)))"          objXL.Range("R36").Formula = "=IF(ISBLANK(D36),"" "",IF(ISBLANK(H36),D36,CONCATENATE(D36,"" "",E36,"" "",F36)))"          objXL.Range("R37").Formula = "=IF(ISBLANK(D37),"" "",IF(ISBLANK(H37),D37,CONCATENATE(D37,"" "",E37,"" "",F37)))"          objXL.Range("R38").Formula = "=IF(ISBLANK(D38),"" "",IF(ISBLANK(H38),D38,CONCATENATE(D38,"" "",E38,"" "",F38)))"          objXL.Range("R39").Formula = "=IF(ISBLANK(D39),"" "",IF(ISBLANK(H39),D39,CONCATENATE(D39,"" "",E39,"" "",F39)))"          objXL.Range("R40").Formula = "=IF(ISBLANK(D40),"" "",IF(ISBLANK(H40),D40,CONCATENATE(D40,"" "",E40,"" "",F40)))"          objXL.Range("R41").Formula = "=IF(ISBLANK(D41),"" "",IF(ISBLANK(H41),D41,CONCATENATE(D41,"" "",E41,"" "",F41)))"          objXL.Range("R42").Formula = "=IF(ISBLANK(D42),"" "",IF(ISBLANK(H42),D42,CONCATENATE(D42,"" "",E42,"" "",F42)))"          objXL.Range("R43").Formula = "=IF(ISBLANK(D43),"" "",IF(ISBLANK(H43),D43,CONCATENATE(D43,"" "",E43,"" "",F43)))"          objXL.Range("R44").Formula = "=IF(ISBLANK(D44),"" "",IF(ISBLANK(H44),D44,CONCATENATE(D44,"" "",E44,"" "",F44)))"          objXL.Range("R45").Formula = "=IF(ISBLANK(D45),"" "",IF(ISBLANK(H45),D45,CONCATENATE(D45,"" "",E45,"" "",F45)))"          objXL.Range("R46").Formula = "=IF(ISBLANK(D46),"" "",IF(ISBLANK(H46),D46,CONCATENATE(D46,"" "",E46,"" "",F46)))"          objXL.Range("R47").Formula = "=IF(ISBLANK(D47),"" "",IF(ISBLANK(H47),D47,CONCATENATE(D47,"" "",E47,"" "",F47)))"          objXL.Range("R48").Formula = "=IF(ISBLANK(D48),"" "",IF(ISBLANK(H48),D48,CONCATENATE(D48,"" "",E48,"" "",F48)))"          objXL.Range("R49").Formula = "=IF(ISBLANK(D49),"" "",IF(ISBLANK(H49),D49,CONCATENATE(D49,"" "",E49,"" "",F49)))"          objXL.Range("R50").Formula = "=IF(ISBLANK(D50),"" "",IF(ISBLANK(H50),D50,CONCATENATE(D50,"" "",E50,"" "",F50)))"          objXL.Range("R51").Formula = "=IF(ISBLANK(D51),"" "",IF(ISBLANK(H51),D51,CONCATENATE(D51,"" "",E51,"" "",F51)))"          objXL.Range("R52").Formula = "=IF(ISBLANK(D52),"" "",IF(ISBLANK(H52),D52,CONCATENATE(D52,"" "",E52,"" "",F52)))"          objXL.Range("R53").Formula = "=IF(ISBLANK(D53),"" "",IF(ISBLANK(H53),D53,CONCATENATE(D53,"" "",E53,"" "",F53)))"          objXL.Range("R54").Formula = "=IF(ISBLANK(D54),"" "",IF(ISBLANK(H54),D54,CONCATENATE(D54,"" "",E54,"" "",F54)))"          objXL.Range("R55").Formula = "=IF(ISBLANK(D55),"" "",IF(ISBLANK(H55),D55,CONCATENATE(D55,"" "",E55,"" "",F55)))"          objXL.Range("R56").Formula = "=IF(ISBLANK(D56),"" "",IF(ISBLANK(H56),D56,CONCATENATE(D56,"" "",E56,"" "",F56)))"          objXL.Range("R57").Formula = "=IF(ISBLANK(D57),"" "",IF(ISBLANK(H57),D57,CONCATENATE(D57,"" "",E57,"" "",F57)))"          objXL.Range("R58").Formula = "=IF(ISBLANK(D58),"" "",IF(ISBLANK(H58),D58,CONCATENATE(D58,"" "",E58,"" "",F58)))"          objXL.Range("R59").Formula = "=IF(ISBLANK(D59),"" "",IF(ISBLANK(H59),D59,CONCATENATE(D59,"" "",E59,"" "",F59)))"          objXL.Range("R60").Formula = "=IF(ISBLANK(D60),"" "",IF(ISBLANK(H60),D60,CONCATENATE(D60,"" "",E60,"" "",F60)))"          objXL.Range("R61").Formula = "=IF(ISBLANK(D61),"" "",IF(ISBLANK(H61),D61,CONCATENATE(D61,"" "",E61,"" "",F61)))"           objXL.UserControl = True                    objXL.Application.ScreenUpdating = True 'Needs to Be Last Entry  End IfEnd SubFunction IsExcelRunning() As BooleanOn Error Resume Next  Set objXL = GetObject(, "Excel.Application")  If Err  0 Then     Err.Clear     Set objXL = CreateObject("Excel.Application")     If Err  0 Then        Err.Clear        IsExcelRunning = False        Exit Function     End If  End If  IsExcelRunning = TrueEnd FunctionFunction GetCurrentCustoms() As Variant   Dim Num As Long   Dim Index As Long   Dim CustomKey As String   Dim CustomValue As String   Dim Sum As AcadSummaryInfo   Set Sum = ThisDrawing.SummaryInfo   Dim Cnt As Long   Num = Sum.NumCustomInfo   ReDim Cust(0 To Num - 1, 0 To 1) As String   For Index = 0 To Num - 1       Sum.GetCustomByIndex Index, CustomKey, CustomValue       Cust(Cnt, 0) = CustomKey       Cust(Cnt, 1) = CustomValue       Cnt = Cnt + 1   Next Index   Set Sum = Nothing   GetCurrentCustoms = Cust   End Function      Sub SSClear()Dim SSS As AcadSelectionSets  On Error Resume Next  Set SSS = ThisDrawing.SelectionSets     If SSS.Count > 0 Then        SSS.Item("TempSSet").Delete     End IfEnd SubFunction AllSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer  Dim TempObjSS As AcadSelectionSet  SSClear  Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet")        'pick selection set  If IsMissing(grpCode) Then     TempObjSS.Select acSelectionSetAll  Else     TempObjSS.Select acSelectionSetAll, , , grpCode, dataVal  End If  AllSS = TempObjSS.CountEnd Function