Monday, March 23, 2015

Layer Filter Properties Dialog Box (Layer Properties Manager) | AutoCAD | Autodesk Knowledge Network

Layer Filter Properties Dialog Box (Layer Properties Manager) | AutoCAD | Autodesk Knowledge Network:



'via Blog this'









About Filtering and Sorting the List of Layers







You can control which layer names are listed in the Layer Properties Manager, and sort them by name or by a property setting.



Sort the Layer List



Once you have created layers, you can sort them by name or other properties. In the Layer Properties Manager, click the column heading to sort layers by the property in that column. Layer names can be sorted in ascending or descending alphanumeric order.

List Layers Using Wild-Card Characters



You can use wild-card characters in the Search box of the Layer Properties Manager to list layers by name. For example, if you enter 02* in the Search box, all layers that begin with the characters 02 are listed.

The following wildcards are available:

Character

Definition

# (pound)

Matches any numeric digit

@ (at)

Matches any alphabetic character

. (period)

Matches any non-alphanumeric character

* (asterisk)

Matches any string and can be used anywhere in the search string

? (question mark)

Matches any single character; for example, ?BC matches ABC, 3BC, and so on

~ (tilde)

Matches anything but the pattern; for example; ~*AB*matches all strings that don't contain AB

[ ]

Matches any one of the characters enclosed; for example, [AB]C matches AC and BC

[~]

Matches any character not enclosed; for example, [~AB]C matches XC but not AC

[-]

Specifies a range for a single character; for example, [A-G]C matches AC, BC, and so on to GC, but not HC

` (reverse quote)

Reads the next character literally; for example, `~AB matches ~AB

Note To find a layer name that contains a wild-card character, precede the character with a reverse quote (`) so that it is not interpreted as a wild-card character.

Filter the Layer List



A layer filter limits the display of layer names in the Layer Properties Manager, and in the Layer control on ribbon and the Layers toolbar. In a large drawing, you can use layer filters to display only the layers that you need.

There are two kinds of layer filters:

Layer property filter. Lists the layers that have portions of their names or properties in common. For example, you can define a property filter that lists all layers that include the letters mech and are set to the color red. Layer property filters can include nested layer property filters.

Layer group filter. Lists the layers that you assign to the group, regardless of their names or properties. You can add layers to a layer group filter by dragging them from the layer list onto the group filter. Layer group filters can include both nested layer property filters and layer group filters.

There are five predefined filters:

All. Lists all the layers in the current drawing.

All Used. Lists all the layers on which objects in the current drawing are drawn.

Xref. If xrefs are attached to the drawing, lists all the layers being referenced from other drawings.

Viewport Overrides. If there are layers with overrides for the current viewport, lists all the layers containing property overrides.

Unreconciled New Layers. If new layers were added since the drawing was last opened, saved, reloaded, or plotted, lists all new unreconciled layers. See About Reconciling New Layers for more information.

---

Layer Filter Properties Dialog Box (Layer Properties Manager)

Jul 8, 2014  |  In-Product View


Filters the list of layers based on the criteria that you specify.
When a layer filter is selected in the Filters panel of the Layer Properties Manager, only the layers that match the properties specified in the filter are displayed in the layer list. Filtering layers reduces a long list of layers to only those that are currently relevant.

List of Options

The following options are displayed.

Filter Name

Displays the name of the layer properties filter.

Filter Definition

Displays the properties of layers that determine which layers are listed. You can click to specify one or more properties to define the filter. All the properties specified on a single line in the filter definition must be true to display a layer name (a logical AND). Subsequent lines in the filter definition each specify alternative criteria (a logical OR).
Here is an example:
This filter has been named Mechanical, and the filter definition includes the following criteria:
  • The layer name must contain the letters "mech", and be turned on, and be thawed, or . . .
  • The layer must be locked and its color must be red.
Status
Click one of the these icons:
 — The layer status does not matter.
 — The layer is in use.
 — The layer is not in use.
 — The layer is in use, and a property override is turned on in a layout viewport.
 — The layer is not in use, and a property override is turned on in a layout viewport.
Name
Enter a layer name, or a partial layer name with standard wild-card characters. For example, enter *mech* to include all layers with the letters mech in the name.
On
Click a cell in the On column and then Click the On, Off, or blank icon. The blank icon specifies that the setting does not matter.
In each of the other columns, first click a cell in the column to display several icons or the [...] button, then click the setting to specify a filter.

Filter Preview

Displays the results of the filter as you define it. The filter preview shows which layers will be displayed in the layer list in the Layer Properties Manager when the currently selected filter is active.

Wednesday, February 25, 2015

Improved Deltek "Keyed data" (eport report to CSV) to create folder structure

 Option Explicit  
 Const version = "v2015-02-25-01.0"  
 ''Script takes a csv text based output report from Deltek and uses it to create folder structure on P.  
 Const strFPt = "P:\"    ''Target File PathDim FP  
 Const vbqt = """"        ''define VBQt for quotation mark  
 ''Lots of globals on this one:  
 Public strDataArr        ''Readline of data from file  
 Public strDiscID        ''discipline ID  
 Const RemapE = True     ''Remap E will create the S/SZ folders if E is in the disciplines .  
 Const ForReading = 1, ForWriting = 2, ForAppending = 8 ''  
 ''FILE MANIPULATION OBJECTS AND REFERENCES''''''''''''''''''  
 Dim fso             ''As New FileSystemObject for creating folders  
 Dim objWSH           ''As New WshShell for creating shortcuts  
 Dim strKeyID()          ''for holding string of keys for comare  
 Dim KeySet           ''Bool check if key was set  
 Dim strKeyUB          ''Max ubound of key  
 Dim strDataUB          ''ub of data array  
 Dim StrMsg           ''for building up message  
 Dim intFolderCt         ''Count of folders added  
 Dim intFolderRef        ''Folders referenced  
 Dim MyFile           ''MyFile for opening target file, Textline for holding one line at a time  
 Dim Textline          ''MyFile for opening target file, Textline for holding one line at a time  
 Dim DirLevels          ''Limiting dir levels if 0 ir unspecified limits to 2, if -1 create all subfolders for disciplines  
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  
 ''END VARIABLES'''''''''''''''''''''''''''''''''''''''''''''  
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  
 Main                ''Execute MAIN routine  
 'Dim wscript As New objWSCRIPT_Emulator  ''FOR DEBUGGING IN EXCEL WITH WSCRIPT CLASSES  
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  
 ''MAIN ROUTINE''''''''''''''''''''''''''''''''''''''''''''''  
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  
 Sub Main()  
   Dim FileName, I, temp      ''input file name  
   DirLevels = -99         ''init as -99  
   Call Initilize(True)      ''INITIALIZE VARIABLES (IN ANTICIPATION OF CONVERSAION OF THIS PARAMETER TO A CLASS)  
   ''Sort WSCRIPT ARGS''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  
   For I = 0 To wscript.Arguments.count - 1  
     If FileName = "" Then  
       FileName = ReturnMatch(wscript.Arguments(I), "([a-z]:\\(?:[-\w\s\.\d]+\\)*(?:[-\w\s\.\d]+)?)")  
     End If  
     If DirLevels = -99 Then  
       temp = ReturnMatch(wscript.Arguments(I), "\/limit:([-+]{0,1}\d+)")  ''look for string from submatch  
       If temp > "" Then  
       DirLevels = CInt(temp)  
      End If  
     End If  
   Next 'i  
   If DirLevels = -99 And FileName > "" Then  
    temp = CInt(InputBox("Number of sub folders under client?" & vbCr & vbCr & _  
              "(P:\0.client\1.Region\(2.Product)\3.Disciplines\)" & vbCr & vbCr & _  
            "(-1 to create ALL 19+ Disciplines)", "Specify allowable depth of sub-folders", 2))  
    If temp < -1 Or temp > 3 Then  
      DirLevels = 3  
    Else  
      DirLevels = temp  
    End If  
   End If  
   If DirLevels = -99 Then DirLevels = 2  
   If FileName = "" Then  
     StrMsg = "Please create a 'project audit report' in deltek with Project#, client name, project name" & vbCr & _  
          "Save it as a CSV/TXT," & vbCr & _  
          "then drag and drop the report onto the script." & vbCr & _  
          "Or link the script to your SendTo folder " & vbCr & _  
          "and use sendto to send the report." & vbCr & vbCr & _  
          "-----SYNTAX-----------------------------------------------------------------" & vbCr & _  
          wscript.ScriptName & " [filepath] [/limit:nn]" & vbCr & _  
          "-----SWITCHES---------------------------------------------------------------" & vbCr & _  
          "Specify /LIMIT:[folder limit] for allowed subdirs below client(Default 2)" & vbCr & _  
          "  -1 = create all disciplines" & vbCr & _  
          "  0 = Create client\ only " & vbCr & _  
          "  1 = Create client\region only " & vbCr & _  
          "  2 = Create client\region\product only " & vbCr & _  
          "[n...] = Limit to N number of sub-folders deep:" & vbCr & _  
          "    P:\0.client\1.Region\2.Product\3.Disciplines (specified by report)"  
     Terminate (vbOKOnly & vbCritical)  
     Exit Sub  
   ElseIf Not fso.FileExists(FileName) Then  
     StrMsg = "ERROR, Cannot find file " & FileName  
     Terminate (vbOKOnly & vbCritical)  
   End If  
   On Error GoTo 0  
   ' Open the file for input.  
   Set MyFile = fso.OpenTextFile(FileName, ForReading)  
   ' Read from the file and display the results.  
   Do While MyFile.AtEndOfStream <> True      '''while not eof  
     Textline = MyFile.ReadLine         ''Get next line of data  
     Textline = Reformat(Textline)        ''reformats csv to tab delimited and gets rid of quotes  
     If Textline > "" Then            '' if not null  
       If ReturnMatch(Textline, "detail_*") > "" Then  ''if matches detail  
         SetKeyInit (Textline)  
       Else  
         If KeySet Then  
           SetData (Textline)       ''Set data array  
           CreateFolders strDataArr, fso  
         End If  
       End If  
     End If  
   Loop  
   Terminate (vbOKOnly)  
 End Sub  
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  
 '''Initialize variables and file manipulation objects'''''''  
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  
 Sub Initilize(noargs)  
   Set fso = CreateObject("Scripting.FileSystemObject")      ''File System Object for creating folders  
   Set objWSH = CreateObject("WScript.Shell")           ''Wscript shell for creating shortcuts  
   Dim q  
   q = Array( _  
       Array("00-00-C-", "00-00-C-Non-trades Client folder", "Non-trades Client folder(If not one of the other categories listed below)"), _  
       Array("01-00-G-", "01-00-G-General-Index", "G General All or any portion of subjects included in Level 2"), _  
       Array("05-00-C-", "05-00-C-Civil", "C Civil All or any portion of subjects included in Level 2"), _  
       Array("06-00-L-", "06-00-L-Landscape", "L Landscape All or any portion of subjects included in Level 2"), _  
       Array("07-00-S-", "07-00-S--Structural", "S Structural All or any portion of subjects included in Level 2"), _  
       Array("07-00-SZ", "07-00-SZ-Structural PM folder", "SZ Structural PROJECT MANAGERS FOLDER"), _  
       Array("08-00-A-", "08-00-A-Architectural", "A Architectural All or any portion of subjects included in Level 2"), _  
       Array("08-00-AZ", "08-00-AZ-Architectural PM FOLDER", "AZ Architectural PROJECT MANAGER FOLDER"), _  
       Array("09-00-I-", "09-00-I-Interiors", "I Interiors All or any portion of subjects included in Level 2"), _  
       Array("09-00-IZ", "09-00-IZ-Interiors PM FOLDER", "IZ Interiors PROJECT MANAGER FOLDER"), _  
       Array("10-00-Q-", "10-00-Q-Equipment", "Q Equipment All or any portion of subjects included in Level 2"), _  
       Array("11-00-F-", "11-00-F-Fire Protection", "F Fire Protection All or any portion of subjects included in Level 2"), _  
       Array("12-00-P-", "12-00-P-Plumbing", "P Plumbing All or any portion of subjects included in Level 2"), _  
       Array("14-00-M-", "14-00-M-Mechanical", "M Mechanical All or any portion of subjects included in Level 2"), _  
       Array("15-00-E-", "15-00-E-Electrical", "E Electrical All or any portion of subjects included in Level 2"), _  
       Array("16-00-T-", "16-00-T-Telecommunications", "T Telecommunications All or any portion of subjects included in Level 2"), _  
       Array("17-00-R-", "17-00-R-Resource Data", "R Resource Data furnished without warrant as to accuracy (e.g. typical or previous drawings used for reference)"), _  
       Array("18-00-X-", "18-00-X-Other Disciplines", "X Other Disciplines All or any portion of subjects included in Level 2"), _  
       Array("19-00-Z-", "19-00-Z-Contractor-Shop Drawings", "Z Contractor /Shop Drawings All or any portion of subjects included in Level 2"), _  
       Array("90-00---", "90-00---Inter-discipline meetings", "This category only used for inter-discipline meetings, i.e. team kickoff.") _  
       )  
   Dim ct  
   ct = UBound(q, 1)  
   ReDim strDiscID(ct + 1, 3)  
   Dim I  
   For I = 0 To ct - 1  
     strDiscID(I + 1, 1) = q(I + 1)(0)  
     strDiscID(I + 1, 2) = q(I + 1)(1)  
     strDiscID(I + 1, 3) = q(I + 1)(2)  
   Next ''I  
   ''these are the variables to look for in exports in the reports  
   ''data will be located in the same slot on one of the following lines  
   ''These are keys to look for- if present they will be > -1 for the 'position of the ID'  
   q = Array( _  
      "detail_BillClientName", _  
      "detail_ClientName", _  
      "detail_WBS3", _  
      "detail_OwnerNumber", _  
      "detail_ClientNumber", _  
      "detail_CLAddress", _  
      "detail_WBS1", _  
      "detail_WBS2", _  
      "detail_WBS3" _  
       )  
   ct = UBound(q, 1)  
   ''strkeyid (#,0) is the id  
   ''strkeyif (#,1) is the 'position of the ID'  
   ''strkeyid (#,2) is the data stored in teh current line for that id  
   ReDim strKeyID(ct, 1)  
   I = 0  
   For I = 0 To ct  
     strKeyID(I, 0) = q(I)  ''key name  
     strKeyID(I, 1) = -1   ''key position  
     ''strKeyID(I, 2) = ""   ''temporary key data  
   Next ''I  
 End Sub  
 Function Reformat(Textline)  
   ''if a line has quites, then there is a comma interfering with the string.. i.e. "lastname, firstname"  
   ''looks for commas inside quotes and substitutes "_"  
   Dim I  
   Dim QTon ''quote on boolean  
   QTon = False  
   Dim aa  
   Reformat = ""  
   For I = 1 To Len(Textline)  
     aa = Mid(Textline, I, 1)  
     If aa = vbTab Then aa = "-"       ''strip out native tabs  
     If aa = vbqt Then            ''IF Quote character then  
       QTon = Not (QTon)            ''flip QTON and drop the character  
     Else                  ''else NOT a quote character  
       If QTon Then              ''Quote on = true then add the character  
         Reformat = Reformat + aa  
       Else                  ''quote on = false- we are outside quotes-  
         If aa = "," Then aa = vbTab     ''substitute TAB for comma  
         Reformat = Reformat + aa      ''Add subbed character  
       End If  
     End If  
   Next ''I  
 End Function  
 Sub Terminate(buttons)  
   If buttons = 0 Then buttons = vbOKOnly  
   On Error Resume Next  
   MyFile.Close  
   MsgBox "Script: " & wscript.ScriptFullName & vbCr & vbCr & _  
       StrMsg & vbCr & vbCr & _  
       "--Results---------------------------------" & vbCr & _  
       Right("0000" & DirLevels, 2) & "  /LEVEL:(Dirlevels) Deep" & vbCr & _  
       Right("0000" & intFolderCt, 2) & "  Folders Created" & vbCr & _  
       Right("0000" & intFolderRef, 2) & "  Folders reviewed" & vbCr, buttons, "Convert Deltek To Folders Version:" & version  
   wscript.quit  
 End Sub  
 Function KGet(KeyID)  
   Dim I, xpos ''counter and x position in tab-delimited data  
   For I = 0 To UBound(strKeyID)  
    If KeyID = strKeyID(I, 0) Then  
      xpos = strKeyID(I, 1)  
      If xpos > 0 Then  
       KGet = strDataArr(xpos)  ''get the position and return corresponding data from the split line array  
       Exit Function  
      Else  
       Exit For ''aware of key but <0 means undefined  
      End If  
    End If  
   Next I  
   KGet = Empty  
 End Function  
 Sub CreateFolders(strDataArr, ObjFso) '' As FileSystemObject)  
   If UBound(strDataArr) < strDataUB Then  
    StrMsg = StrMsg & vbCr & "Null Array Error in Create folder at folder count: " & intFolderRef & vbCr & "Str DATA LINE:" & vbCr & Textline & vbCr  
    Terminate (True)  
   End If  
   Dim ClientBill:   ClientBill = KGet("detail_BillClientName")  
   Dim ClientName:   ClientName = KGet("detail_ClientName") ''  
   Dim Projname:    Projname = KGet("detail_WBS3") ''  
   Dim Owner:     Owner = KGet("detail_OwnerName")  
   Dim OwnerNumb:   OwnerNumb = KGet("detail_OwnerNumber")  
   ''Project Number  
   Dim Prod:      Prod = KGet("detail_WBS2")  
   Dim Disc:      Disc = KGet("detail_WBS3")  
   Dim PCliNo:     PCliNo = KGet("detail_OwnerNumber")  
   Dim Pnum:      Pnum = KGet("detail_WBS1")  
    If Not IsEmpty(Pnum) Then  
    On Error Resume Next  
    Dim PYear, PCliRe, PCProd, count  
      ''---regexp to break up ids in pnumber  
      Dim r, m  
      Set r = New RegExp  
      r.Pattern = "(\d{2})(\d{3})(\d{2})\.(\d{3})"  
      r.IgnoreCase = True  
      Set m = r.Execute(Pnum)  
      count = -1  
      count = m.count  
      If count > 0 Then  
       If m(0).SubMatches.count = 4 Then  
         PYear = m(0).SubMatches(0)  
         PCliNo = m(0).SubMatches(1)  
         PCliRe = m(0).SubMatches(2)  
         PCProd = m(0).SubMatches(3)  
       End If  
      Else  
       r.Pattern = "([a-z,A-Z]+)(\d{2})\.(\d{3})"  
       Set m = r.Execute(Pnum)  
       count = -1  
       count = m.count  
       If count > 0 Then  
         PCliNo = m(0).SubMatches(0)  
         PCliRe = m(0).SubMatches(1)  
         PCProd = m(0).SubMatches(2)  
       Else  
         r.Pattern = "([a-z,A-Z]+)\.(\d{3})"  
         r.IgnoreCase = True  
         Set m = r.Execute(Pnum)  
         count = -1  
         count = m.count  
         If count > 0 Then  
         PCliNo = m(0).SubMatches(0)  
         PCProd = m(0).SubMatches(1)  
         End If  
       End If  
      End If  
    End If  
   Dim FP: FP = strFPt  
   Dim objFolder              ''As Folder  
   Dim Folder               '' As Folder  
   Dim I                  ''counter  
   '''client  
   ''base folder  
   FP = FP & PCliNo  
   If PCliNo = "" Then CreateFoldersCrash ("Project number")  
   If ClientName = "" Then ClientName = Projname  
   Set Folder = FolderCheck(FP, ObjFso, StrClean(ClientName & "(" & PCliNo & ")"))  
   If DirLevels = 0 Then Exit Sub ''limit folder creation at level 0 client  
   '''region folder  
   If PCliRe = "" Then Exit Sub ''CreateFoldersCrash ("Region missing")  
   FP = FP & "\" & PCliRe  
   Set Folder = FolderCheck(FP, ObjFso, StrClean(ClientName))  
   If DirLevels = 1 Then Exit Sub ''limit folder creation at level 1 region  
   '''Product  
   FP = FP & "\" & "-" & PCProd  
   Set Folder = FolderCheck(FP, ObjFso, StrClean("-" & Trim(PCProd) & Trim("-" & Prod)))  
   If DirLevels = 2 Then Exit Sub ''limit folder creation at level 2 Product  
   ''Consultants -- using -1 for dir levels creates all consutlants  
   If DirLevels = -1 Then  
     For I = 1 To UBound(strDiscID, 1)  
       Set Folder = FolderCheck(FP & "\" & strDiscID(I, 1), ObjFso, StrClean(strDiscID(I, 2)))  
     Next 'I  
   Else  ''Pass the value to CheckDiscipline  
     Call CheckDiscipline(FP, ObjFso, Disc)  
   End If  
 End Sub  
 Sub CreateFoldersCrash(Name)  
    MsgBox Name & " missing from report, exiting", vbCritical, "Missing info in report"  
    Terminate vbCritical  
    Exit Sub  
 End Sub  
 Function CheckDiscipline(FP, ObjFso, Disc)  
   Dim Folder  
   Dim I  
   Disc = Trim(Disc)  
   If RemapE And Disc = "E" Then Disc = "S" ''''<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Exception to map "E" to "S" for now  
   If Disc > "" Then  
     For I = 1 To UBound(strDiscID)  
       If ReturnMatch(strDiscID(I, 1), ".*?" & Trim(Disc) & ".*?") > "" Then  
         Set Folder = FolderCheck(FP & "\" & strDiscID(I, 1), ObjFso, StrClean(strDiscID(I, 2)))  
       End If  
     Next ''I  
   Else  
   '''optional create all anyway  
   End If  
 End Function  
 Function StrClean(StrToClean)  
   StrToClean = UCase(StrToClean)  
   Dim I, a  
   For I = 1 To Len(StrToClean)  
     a = Mid(StrToClean, I, 1)  
       If a >= "A" And a <= "Z" Or a >= "0" And a <= "9" Or a = "(" Or a = ")" Then  
       StrClean = StrClean & a  
       ElseIf a = " " And Right(StrClean, 1) <> " " Then  
         StrClean = StrClean & a  
       ElseIf Right(StrClean, 1) <> "-" Then  
         StrClean = Trim(StrClean & "-")  
       End If  
   Next ''I  
   Do While Right(StrClean, 1) = "-" Or Right(StrClean, 1) = " "  
     StrClean = Left(StrClean, Len(StrClean) - 1)  
   Loop  
 End Function  
 Function FolderCheck(FP, ObjFso, xcutName)  
   On Error Resume Next  
   Set FolderCheck = ObjFso.GetFolder(FP)  
   intFolderRef = intFolderRef + 1  
   If FolderCheck Is Nothing Then  
     Set FolderCheck = ObjFso.CreateFolder(FP)  
     intFolderCt = intFolderCt + 1  
   End If  
   XCut FolderCheck, xcutName           ''create xcut- if it exists it will be deleted and recreated.  
 End Function  
 Sub XCut(Folder, strXcutName)  
   Dim objScut  
   Dim FN  
   Do While (Right(strXcutName, 1) = " " Or Right(strXcutName, 1) = "-") And Len(strXcutName) > 2  
     strXcutName = Left(strXcutName, Len(strXcutName) - 1)  
   Loop  
   FN = Folder.ParentFolder.path + "\" + strXcutName + ".lnk"  
   If fso.FileExists(FN) Then fso.DeleteFile (FN)  
   Set objScut = objWSH.CreateShortcut(FN)  
   objScut.WindowStyle = 4 ''7=Minimized 0=Maximized 4=Normal  
   objScut.TargetPath = Folder.path  
   objScut.Save  
 End Sub  
 Function ReturnMatch(strStr, strMatch)  
   ''VBA include Microsoft VBSCript Regular Expressions 5_5  
   Dim r 'As New RegExp    ''Regexp engine  
   Dim m 'As MatchCollection ''Return value  
   Dim I, x()  
   'Dim StrMatch ''as pattern match  
   If InStr(1, strMatch, "(") + InStr(1, strMatch, ")") = 0 Then   ''add () for subexpression to return something...  
     If Left(strMatch, 1) <> "(" Then strMatch = "(" & strMatch  
     If Right(strMatch, 1) <> ")" Then strMatch = strMatch & ")"  
   End If  
   Set r = New RegExp  
   r.Pattern = strMatch  
   r.IgnoreCase = True  
   Set m = r.Execute(strStr)  
   ''Regexp os base-o arrays so info rturned starts at (0) not (1)  
   On Error Resume Next  
   If m.count = 0 Then  
     ReturnMatch = ""  ''return null  
     Exit Function    ''nomatch  
   Else  
     ReturnMatch = m(0).SubMatches(0) ''return 1st submatch  
   End If  
 End Function  
 Public Sub SetData(StrRdLn)  
   strDataArr = Split(StrRdLn, vbTab)  
   strDataUB = UBound(strDataArr)  
 End Sub  
 Sub SetKeyInit(StrRdLn)  
   Dim x  
   x = Split(StrRdLn, vbTab)  
   KeySet = True  
   Dim I, j  
   For I = 0 To UBound(x)  ''assocaite positions in the array with data  
    For j = 0 To UBound(strKeyID, 1)  
      If strKeyID(j, 0) = x(I) Then  
       strKeyID(j, 1) = I ''store position of data  
       Exit For  
      End If  
    Next 'j  
   Next 'I  
   strKeyUB = UBound(x)  
 End Sub  

Friday, February 13, 2015

Revit nested family not hosting to "Pick primary host" option in "Stacked wall" condition

Revit nested family not hosting to "Pick primary host" option in "Stacked wall" condition- nested family floats out beyond wall to stacked wall width.

The issue was resolved by hosting the nested family to a reference plan then aligning & locking the reference plane to the wall face's finish.

reloading correctly shrunk up the gap between the nested family and the "Primary host"

Monday, February 9, 2015

Thursday, February 5, 2015

On the Road to VDC Integration~ Geeking out over Revit and MS Access data connections...

On the Road to VDC Integration~ Geeking out over Revit and MS Access data connections...
Personal breakthrough- I finally got an great connection from Revit 2015 to MS Access through a plugin called DBConnect. 
I had to install the ODBCx64 drivers downloaded from Microsoft as even whn I installed the x64 version of office to go with my x64bit everythign else it insisted on rverting to teh x32 ODBC drivers:
http://www.microsoft.com/en-us/download/details.aspx?id=23734 i got from this very useful dude!~
Found this helpful9
Answer
Scottgem replied on 

You can download the drivers here:

http://www.microsoft.com/downloads/details.aspx?familyid=7554F536-8C28-4598-9B72-EF94E038C891&displaylang=e

This file will add Access to the list of file types in the ODBC administrator.

Not sure if its 32 or 64 bit. But it worked on a machine running 64bit Win 7


Hope this helps, Scott<> P.S. Please post a response to let us know whether our answer helped or not. Microsoft Access MVP 2009 Author: Microsoft Office Access 2007 VBA Technical Editor for: Special Edition Using Microsoft Access 2007 and Access 2007 Forms, Reports and Queries
Hope this helps,
Scott<>
Blog: http://scottgem.wordpress.com
Microsoft Access MVP since 2007

Once installed I could use the ODBC connection to create a new export from the current Project.

This exported the nearly 300 database tables of information from Revit. I was then able to create reports from these tables to summarize information from the Revit model.

EXCEL- Holy... Much to my surprise...
I decided to link the information into Excel office 365 as data links. I created a Pivot table of walls and then added areas from another walls table tabulations for wall areas instantly appeared! I about passed out (Probably should not have skipped lunch  8-p

If we use the database to gather and consolidate the information that information and adjustments in it can possibly round-trip back into Revit as well... Don't need Bimlink or any of those others : )

Amazing linking and data available for extraction for any number of possible applications... and it is all finally working on x64bit Revit & MSOffice.

Friday, January 23, 2015

Create definition for glossary (Tabe Of Contents #8)

Sub GLOSSARY()
'
' GLOSSARY Macro
'
'
Dim strMark As String
Dim strDEf As String
''Dim newdoc As New Document
'Dim myrange As Range
Dim I As Integer

Dim Curdoc

Set Curdoc = ActiveDocument

''trim up selection
Do While Selection.Characters(Selection.Characters.Count) = " " And Selection.Characters.Count > 1
   Selection.MoveEnd Unit:=wdCharacter, Count:=-1
Loop

strMark = Selection.Text
 
If strMark = "" Then
   MsgBox "Select some text to mark first", vbCritical, "Error"
   Exit Sub
End If

   Selection.Font.Bold = True
   Selection.Font.Italic = True
 
   strDEf = InputBox("Definition for " & strMark, "Define Term", vbOK) ''get definition
 
   strDEf = strMark & "-" & strDEf
Dim x As Field
Set x = Curdoc.TablesOfAuthorities.MarkCitation(Range:=Selection.Range, _
      ShortCitation:=strDEf, LongCitation:= _
      strDEf, LongCitationAutoText:= _
      "MarkCitation3", Category:=8)
   
   ActiveWindow.ActivePane.View.ShowAll = True
 
   x.Select
 
   ''Format definition with find/replace
   Dim strField
   strField = "\l " & VBQT & strMark
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find.Replacement.Font
      .Bold = True
      .Italic = True
   End With
   With Selection.Find
      .Text = strField
      .Replacement.Text = strField ''"\l ""current view only"
      .Forward = True
      .Wrap = wdFindContinue
      .Format = True
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
 
   Set Curdoc = Nothing
    ActiveWindow.ActivePane.View.ShowAll = False
End Sub

Tuesday, January 20, 2015

View FULL headers of selected message(s) in Outlook

Dim objIe ''As InternetExplorer                                                         ''ie subroutine operands
Dim wscript As New objWSCRIPT_emulator

Sub ViewInternetHeader()
    Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem
    Dim strheader As String

   InitIE "Starting View Header", objIe

    For Each olItem In Application.ActiveExplorer.Selection
        strheader = GetInetHeaders(olItem)
         MsgIE strheader, objIe
        'Set olMsg = Application.CreateItem(olMailItem)
        'With olMsg
        '    .BodyFormat = olFormatPlain
        '    .Body = strheader
        '    .Display
        'End With
       
    Next
    Set olMsg = Nothing
End Sub


Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
    ' Purpose: Returns the internet headers of a message.'
    ' Written: 4/28/2009'
    ' Author:  BlueDevilFan'
    ' http://techniclee.wordpress.com/
    ' Outlook: 2007'
    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
    Dim olkPA As Outlook.PropertyAccessor
    Set olkPA = olkMsg.PropertyAccessor
    GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
    Set olkPA = Nothing
End Function
''----------------------
Sub InitIE(ByVal strMsg, ByRef objIe)
' Subroutine to initialize the IE display box.
Dim intWidth, intHeight, intWidthW, intHeightW
Dim objShell

   Set objShell = CreateObject("WScript.Shell") ''wsh
   Set objIe = CreateObject("InternetExplorer.Application")  '''<<<<<<<<<<<<<>>>>>>>>>
   objIe.Visible = True
    
   blnFlag = True
   strIETitle = "Backlog" & String(40, "-")
  
    objIe.Toolbar = False
    objIe.StatusBar = False
    objIe.Resizable = False
    objIe.Navigate ("about:blank")
       objIe.Visible = True
    Do Until objIe.readyState = 4
      wscript.Sleep 100
    Loop
    intWidth = 800 ''objie.document.parentwindow.screen.availwidth
    intHeight = objIe.Document.parentwindow.screen.availheight
    intWidthW = objIe.Document.parentwindow.screen.availwidth * 0.6
    intHeightW = objIe.Document.parentwindow.screen.availheight * 0.6
    objIe.Document.parentwindow.resizeto intWidth, intHeight
    objIe.Document.parentwindow.MoveTo (intWidth - intWidthW) / 2, (intHeight - intHeightW) / 2
    objIe.Document.Write " " & strMsg & " "
    objIe.Document.parentwindow.Document.Body.Style.backgroundcolor = "#eeeeFF" ''"lightblue"
    objIe.Document.parentwindow.Document.Body.Scroll = "yes"
    objIe.Document.parentwindow.Document.Body.Style.Font = "10pt 'courier new'"
    objIe.Document.parentwindow.Document.Body.Style.BorderStyle = "outset"
    objIe.Document.parentwindow.Document.Body.Style.borderwidth = "4px"

   
    objIe.Document.Title = strIETitle

    wscript.Sleep 100
    objShell.AppActivate strIETitle
End Sub

Sub MsgIE(ByVal strMsg, ByRef objIe)  ''As InternetExplorer)
    ' Subroutine to display message in IE box and detect when the
    ' box is closed by the program or the user.
    Dim objIEDoc
   
    On Error Resume Next
   
    If (strMsg = "IE_Quit") Then
        blnFlag = False
        objIe.quit
    Else
        'If InStr(1, LCase(strMsg), LCase("")) = 0 Then  ''unforamtted HTML
            objIe.Document.Body.InnerText = strMsg & objIe.Document.Body.InnerText
         'Else
            'objIe.document = strMsg
         'End If
        
        If (Err.Number <> 0) Then
            Err.Clear
            blnFlag = False
            Exit Sub
        End If
        ''objShell.AppActivate strIETitle
    End If
End Sub