Get Attributes, Selection Sets
HiAm wondering if someone can give me some advice in creating a selection set to automatically select title blocks (Only One per layout)
Namely
A1Title
A2Title
A3Title, etc.
My code iretates between layouts but at the moment has got a user input to select the block and I would like the code to automatically select the block and then scroll through layouts.
Have attached file for a better understanding.
Hope someone can help.
Project6.zip Judging by your attachment, I'm guessing you're after VBA?
but in LISP:
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "A1Partners") (if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE"))))))) Thanks for reply
I am after VBA, have no knowledge of lisp unfortunately.
Regards
Streng
I thought that may be the case I'll take a peek at this later today. Would very much appreciate it Here are some modifications that allow Layout processing without the need to manually iterate through them.
I may have inadvertently changed the output format – you’d be the best person to access that – but this should give you some additional options to play with.
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'SummaryInfoRowNum = 1DrgNo = 1'Checks Excel Is Running (Using Function IsExcel Running)If Not IsExcelRunning() Then MsgBox "Problem starting Excel!" Exit SubEnd If 'Turns Screen Updating Off While Doc Issue PopulatesobjXL.Application.ScreenUpdating = True 'To Be Changed To False Upon CompletionintCode(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 EntryEnd IfEnd SubFunction IsExcelRunning() As BooleanOn Error Resume NextSet objXL = GetObject(, "Excel.Application")If Err0 Then Err.Clear Set objXL = CreateObject("Excel.Application") If Err0 Then Err.Clear IsExcelRunning = False Exit Function End IfEnd IfIsExcelRunning = 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 AcadSelectionSetsOn Error Resume NextSet 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 IntegerDim TempObjSS As AcadSelectionSetSSClearSet TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet") 'pick selection setIf IsMissing(grpCode) Then TempObjSS.Select acSelectionSetAllElse TempObjSS.Select acSelectionSetAll, , , grpCode, dataValEnd IfAllSS = TempObjSS.CountEnd Function You're a star.
Have altered the output to list as before.
Unfortunately I have one more problem.
Although most blocks are called "*Partners"
How do I add another to include "A4Sketch"
Regards
Streng I'm not in a position to test it but believe:
intCode(1) = 2: varData(1) = "*Partners,A4Sketch"
should do. Sorted,
Cheers
页:
[1]