See the top rated post in this thread. Click here

Results 1 to 10 of 10

Thread: Lisp to fill in title block of each sheet

  1. #1
    Member
    Join Date
    2016-01
    Posts
    34
    Login to Give a bone
    0

    Default Lisp to fill in title block of each sheet

    Before anyone suggests sheet sets, I have to be compatible with files created all the way back to 2002 and also a CNC department that needs file formats no later than 2004 & whose CAM software chokes on sheet sets.

    Way-back-when someone wrote a lisp routine that would extract information from the folder & file name to populate the title block of each sheet. The problems are: 1) it depends on the folder to be on the 1st level of the drive, 2) the design number to be 5 characters & 3) it does not use attribute tags but assumes the attributes are in a specific order [using nested entnext]. This prevents us from modifying the title block for other uses such a version to send to customers or a manufacturing specific title block. The tag names needed to be populated are:
    PROPERTY
    JOBNUMBER
    DESIGNNUMBER
    DATE
    SHT#
    #OF
    SCALE
    I have written several complex VBA routines for Excel but I am not familiar with the syntax or functions in Autolisp. I do have a routine written that extracts the Property, Job Number & Design Number from the file name & path and princ them to the command line. I also can princ the DATE & #OF and could extract SHT# as I loop through each sheet. I just cannot figure out how to write the values into the title block. I’ll tackle SCALE, which puts the scale of the viewport into the attribute, on another question after I peruse through the 207 line of code in that current sub-function.

    Thank you in advance for any help anyone can provide.

  2. #2
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,658
    Login to Give a bone
    0

    Default Re: Lisp to fill in title block of each sheet

    You can use Custom Drawing Properties for this so it would only need to be entered once per drawing. The Express Tools PROPULATE command helps with this and there are a few useful lisp routines out there as well.
    Last edited by Tom Beauford; 2016-01-22 at 12:57 PM. Reason: Missed the SSM part

  3. #3
    Member
    Join Date
    2016-01
    Posts
    34
    Login to Give a bone
    0

    Default Re: Lisp to fill in title block of each sheet

    Not what I am after. See screen shot. Currently we type 'shtfill' & it fills in the attributes listed in the question on every tab/sheet of the drawing as well as a purge all & zoom all of the paper space [anywhere from 2 to 38+ tabs]. The other attributes in the title block are either gatte or edited on each sheet as needed.

    block_shot.gif

  4. #4
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,658
    Login to Give a bone
    0

    Default Re: Lisp to fill in title block of each sheet

    Quote Originally Posted by lynx_20 View Post
    Not what I am after. See screen shot. Currently we type 'shtfill' & it fills in the attributes listed in the question on every tab/sheet of the drawing as well as a purge all & zoom all of the paper space [anywhere from 2 to 38+ tabs]. The other attributes in the title block are either gatte or edited on each sheet as needed.
    You can use fields in the attributes to reference the Custom Drawing Properties. That way the attributes in every title block in a drawing will reference the values set in Custom Drawing Properties. Best to set them up in your templates, then update the values for each drawing.

  5. #5
    Member
    Join Date
    2012-09
    Posts
    4
    Login to Give a bone
    0

    Default Re: Lisp to fill in title block of each sheet

    you can take the help of Lee mac "UpdateTitleblockV1-8.lsp" Lisp.
    http://lee-mac.com/updatetitleblock.html
    Thank you very much for your lisp Lee mac.

  6. #6
    Member
    Join Date
    2016-01
    Posts
    34
    Login to Give a bone
    0

    Default Re: Lisp to fill in title block of each sheet

    What I would like to do is expand on what I have created below. The current format for folders/files is: …\[<drawing #><space><property>]\[<design#>]\design#.dwg - where [xx] is the folder name.

    What I have not figured out is how to write jobNum, jobProperty, cadName, cDate & tabCount into the title block of each tab/sheet.

    Remember I need to be able to just type shtfill [temporarily p-values] on the command line of any drawing on our server & it will update the title block to the current folder/file path.


    Code:
    (defun c:p-values (/ tabCount loName)
      (if (= (getvar 'dwgtitled) 1)
        (progn (getValues)			; continue if file has been saved
    	   (if (= (substr jobNum 1 1) "0")
    	     (progn (alert "jobNum not passed") ; do something for no job number
    	     )
    	     (progn			;continue on
    	       (print jobNum)
    	       (print jobProperty)
    	       (print cadName)
    	       (princ)
    	       (setq cDate (menucmd (strcat "m=$(edtime, $(getvar,date),MO/DD/YY)")))
    	       (print cDate)
    	       (setq tabCount (length (layoutlist)))
    	       (print tabCount)
    	       (princ)
    	     )
    	   )
        )
        (alert "File must be saved first")
      )
    )
    
    (defun getValues (/ dwgname dwgprefix path jobDir i jobLen len lenDir) ;get values from path
      (progn (vl-filename-base (getvar 'dwgname))
    	 (setq path   (vl-string-right-trim "\\" (getvar 'dwgprefix))
    	       path   (substr path 1 (vl-string-position (ascii "\\") path 0 T))
    	       jobDir (substr path
    			      (+ 2 (vl-string-position (ascii "\\") path 0 T))
    		      )
    	       len    (strlen jobDir)
    	       i      1
    	 )
    	 (while	(<= i len)
    	   (if (= (substr jobDir i 1) " ")
    	     (progn (setq i (1+ len)))
    	     (progn (setq jobLen i) (setq i (1+ i)))
    	   )
    	 )
    	 (setq jobNum	   (substr jobDir 1 jobLen)
    	       lenDir	   (strlen jobDir)
    	       jobProperty (substr jobDir (+ 2 jobLen) lenDir)
    	       cadName	   (vl-filename-base (getvar 'DWGNAME))
    	 )
      )
    )

  7. #7
    All AUGI, all the time
    Join Date
    2003-07
    Posts
    555
    Login to Give a bone
    1

    Default Re: Lisp to fill in title block of each sheet

    here is a simple example of reading layout name but dwg path etc similar method

    Code:
    ; update the title blocks in a dwg
    ; by Alan H
    ;;-------------------=={ Parse Numbers }==--------------------;;
    ;;                                                            ;;
    ;;  Parses a list of numerical values from a supplied string. ;;
    ;;------------------------------------------------------------;;
    ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
    ;;------------------------------------------------------------;;
    ;;  Arguments:                                                ;;
    ;;  s - String to process                                     ;;
    ;;------------------------------------------------------------;;
    ;;  Returns:  List of numerical values found in string.       ;;
    ;;------------------------------------------------------------;;
    
    (defun LM:ParseNumbers ( s )
      (
        (lambda ( l )
          (read
            (strcat "("
              (vl-list->string
                (mapcar
                  (function
                    (lambda ( a b c )
                      (if
                        (or
                          (< 47 b 58)
                          (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                          (and (= 46 b) (< 47 a 58) (< 47 c 58))
                        )
                        b 32
                      )
                    )
                  )
                  (cons nil l) l (append (cdr l) (list nil))
                )
              )
              ")"
            )
          )
        )
        (vl-string->list s)
      )
    )
    
    (defun ah:sheetupdate1 ( / ss1 len lay plotabs tabname dwgname oldtag1 oldtag2 oldtag3 oldtag4 oldtag5)
    
    (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    
    (vlax-for lay (vla-get-Layouts doc)
      (setq plotabs (cons (vla-get-name lay) plotabs))
    )
    
    (IF (NOT AH:getval)(LOAD "GETVAL"))
    (setq title "Please enter dwg number")
    (setq width "   edit_width = 12;")
    (setq limit "     edit_limit = 9;")
    (AH:getval title width limit)
    (setq dwgname item)
    
    (setq title "Please enter version for all sheets <Cr> no change")
    (setq width "   edit_width = 8;")
    (setq limit "     edit_limit = 5;")
    (ah:getval title width limit)  
    
    (setq newstr4 item)
    
    
    (princ "0")
    (setq len (length plotabs))
    (setq x 0)
    (setq bname "DA1DRTXT")
    (repeat len
      (setq tabname (nth x plotabs))
      (if (/= tabname "Model")
        (progn
          (setvar "ctab" tabname)
          (command "pspace")
          (setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname)(cons 410 tabname))))
          (setq dwgnum (Lm:parsenumbers tabname))
          (setq sheetnum (car dwgnum))
          (setq oldtag1 "SHT_NO") ;attribute tag name
          (setq newstr1 (rtos sheetnum 2 0))
    
          (setq oldtag2 "DRG_NO") ;attribute tag name
    
          (setq oldtag3 "PROJ_NO") ;attribute tag name
          (setq newstr3 dwgname)
    
          (setq oldtag4 "REV_NO") ;attribute tag name
    
          (setq oldtag5 "SHEETS") ;attribute tag name
    
    ; if less than 10
    (if (< (car dwgnum) 10.0) 
          (setq newstr2 (strcat dwgname "-D0"  (rtos sheetnum 2 0)))
          (setq newstr2 (strcat dwgname "-D"  (rtos sheetnum 2 0)))
    )
          (foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
            (if (= oldtag1 (strcase (vla-get-tagstring att)))
            (vla-put-textstring att newstr1) 
            ) ; end if
    
            (if (= oldtag2 (strcase (vla-get-tagstring att)))
            (vla-put-textstring att newstr2) 
            ) ; end if
    
            (if (= oldtag3 (strcase (vla-get-tagstring att)))
            (vla-put-textstring att newstr3) 
            ) ; end if
    
            (if (and (/= newstr4 nil) (= oldtag4 (strcase (vla-get-tagstring att))) )
            (vla-put-textstring att newstr4) 
            ) ; end if 
            (if (= oldtag5 (strcase (vla-get-tagstring att)))
            (vla-put-textstring att (rtos (- len 1) 2 0)) 
            ) ; end if
    
           ) ; end foreach
        ) ; end progn
     ) ; end if
    (setq x (+ x 1))
    ) ; end repeat
    (setq ss1 nil)  
    ) ; end defun ah
    
    
    (if (not (AH:getval) (load "Getval")))
    
    (ah:sheetupdate1)
    
    (princ)

  8. #8
    Member
    Join Date
    2016-01
    Posts
    34
    Login to Give a bone
    0

    Default Re: Lisp to fill in title block of each sheet

    Thanks BIG-AL! Your example set me on the right track [see below]. Everything works great except calculating the viewport scale. [see attached screen shot]
    scale_shot.jpg

    Our template used to default to the fraction of 1'-0" but now, as an example, this sheet uses the 1:16 with version 2013 & above as checked in the screen shot instead of the 3/4" = 1'-0" [both 6.25%]. With any of the ratio scales my code selects the default 'AS NOTED' [which is what we use for either multiple viewport sheets or not-our-standard scales]. If I were to select the 3/4" scale of this viewport & rerun the shtfill the title block would put the fraction into the block.

    Any help as to why? A problem with my code? See getVPscale sub.

    Code:
    (defun c:tst-shtfill (/)
      (if (= (getvar 'dwgtitled) 1)
        (progn (getValues)			; continue if file has been saved
    	   (if (= (substr jobNum 1 1) "0")
    	     (progn (alert "jobNum not passed") ; do something for no job number
    	     )
    	     (progn			;continue on
    	       (setq layt_lst nil
    		     tabNum 0
    	       )
    	       (vl-load-com)
    	       (vlax-for layt (vla-get-layouts
    				(vla-get-ActiveDocument (vlax-get-acad-object))
    			      )
    		 (if (> (vla-get-TabOrder layt) 0)
    		   (setq layt_lst (cons	(cons (vla-get-TabOrder layt) (vla-get-Name layt))
    					layt_lst
    				  )
    		   )
    		 )
    	       )
    	       (setAttnames)
    	       (setvar "CMDECHO" 0)
    	       (setq layt_lst (vl-sort layt_lst '(lambda (x y) (< (car x) (car y)))))
    	       (foreach layt layt_lst (sfWrite))
    	       (setvar "CMDECHO" 1)
    	     )
    	   )
        )
        (alert "File must be saved first")
      )
      (princ)
    )
    
    (defun sfWrite (/)
      (setq	layoutname (cdr layt)
    	tabNum	   (1+ tabNum)
    	tabCount   (length (layoutlist))
    	cDate	   (menucmd (strcat "m=$(edtime, $(getvar,date),MO/DD/YY)"))
      )
      (setvar "ctab" layoutname)
      (command "pspace")
      (command "zoom" "E")
      (getVPscale)
      (setq	ss1 (ssget "x"
    		   (list (cons 0 "INSERT")
    			 (cons 2 "Land 11x17")
    			 (cons 410 layoutname)
    		   )
    	    )
      )
      (foreach att (vlax-invoke
    		 (vlax-ename->vla-object (ssname SS1 0))
    		 'getattributes
    	       )
        (if	(= tag1 (strcase (vla-get-tagstring att)))
          (vla-put-textstring att jobProperty)
        )
        (if	(= tag2 (strcase (vla-get-tagstring att)))
          (vla-put-textstring att jobNum)
        )
        (if	(= tag3 (strcase (vla-get-tagstring att)))
          (vla-put-textstring att cadName)
        )
        (if	(= tag5 (strcase (vla-get-tagstring att)))
          (vla-put-textstring att cDate)
        )
        (if	(= tag9 (strcase (vla-get-tagstring att)))
          (vla-put-textstring att tabNum)
        )
        (if	(= tag10 (strcase (vla-get-tagstring att)))
          (vla-put-textstring att tabCount)
        )
        (if	(= tag12 (strcase (vla-get-tagstring att)))
          (vla-put-textstring att vpScale)
        )
      )
    )
    
    (defun setAttnames (/)
      (setq	tag1  "PROPERTY"
    	tag2  "JOBNUMBER"
    	tag3  "DESIGNNUMBER"
    	tag5  "DATE"
    	tag9  "SHT#"
    	tag10 "#OF"
    	tag12 "SCALE"
      )
    )
    
    (defun getValues (/)			;get values from path
      (progn (vl-filename-base (getvar 'dwgname))
    	 (setq path   (vl-string-right-trim "\\" (getvar 'dwgprefix))
    	       path   (substr path 1 (vl-string-position (ascii "\\") path 0 T))
    	       jobDir (substr path
    			      (+ 2 (vl-string-position (ascii "\\") path 0 T))
    		      )
    	       len    (strlen jobDir)
    	       i      1
    	 )
    	 (while	(<= i len)
    	   (if (= (substr jobDir i 1) " ")
    	     (progn (setq i (1+ len)))
    	     (progn (setq jobLen i) (setq i (1+ i)))
    	   )
    	 )
    	 (setq jobNum	   (substr jobDir 1 jobLen)
    	       lenDir	   (strlen jobDir)
    	       jobProperty (substr jobDir (+ 2 jobLen) lenDir)
    	       cadName	   (vl-filename-base (getvar 'DWGNAME))
    	 )
      )
    )
    
    (defun getVPscale (/)			;get the scale of the viewport
      (setq ents (ssget "c" '(0 0) '(16.3762 10.25) '((0 . "VIEWPORT"))))
      (if ents
        (progn (setq numVP 1)
    	   (setq numVP (sslength ents))
    	   (cond ((> numVP 1) ;More than 1 VP this sheet
    		  (setq vpScale "AS NOTED")
    		 )
    		 ((= numVP 1)
    		  (setq	ent    (ssname ents 0)
    			data   (entget ent '("ACAD"))
    			cvhgt  (cdr (assoc 41 DATA))
    			cvsize (cdr (nth 6 (cdadr (assoc -3 data))))
    			vpMult (/ cvsize cvhgt)
    		  )
    		  (fix vpMult)
    		  (cond	((= vpMult 1) (setq vpScale "FULL SIZE"))
    			((= vpMult 2) (setq vpScale "HALF SIZE"))
    			((= vpMult 4) (setq vpScale "3\"=1'-0\""))
    			((= vpMult 8) (setq vpScale "1-1/2\"=1'-0\""))
    			((= vpMult 12) (setq vpScale "1\"=1'-0\""))
    			((= vpMult 16) (setq vpScale "3/4\"=1'-0\""))
    			((= vpMult 24) (setq vpScale "1/2\"=1'-0\""))
    			((= vpMult 32) (setq vpScale "3/8\"=1'-0\""))
    			((= vpMult 48) (setq vpScale "1/4\"=1'-0\""))
    			((= vpMult 64) (setq vpScale "3/16\"=1'-0\""))
    			((= vpMult 96) (setq vpScale "1/8\"=1'-0\""))
    			(T (setq vpScale "AS NOTED"))
    		  )
    		 )
    	   )
        )
      )
    )
    
    (defun getValues (/ dwgname dwgprefix path jobDir i jobLen len lenDir) ;get values from path
      (progn (vl-filename-base (getvar 'dwgname))
    	 (setq path   (vl-string-right-trim "\\" (getvar 'dwgprefix))
    	       path   (substr path 1 (vl-string-position (ascii "\\") path 0 T))
    	       jobDir (substr path
    			      (+ 2 (vl-string-position (ascii "\\") path 0 T))
    		      )
    	       len    (strlen jobDir)
    	       i      1
    	 )
    	 (while	(<= i len)
    	   (if (= (substr jobDir i 1) " ")
    	     (progn (setq i (1+ len)))
    	     (progn (setq jobLen i) (setq i (1+ i)))
    	   )
    	 )
    	 (setq jobNum	   (substr jobDir 1 jobLen)
    	       lenDir	   (strlen jobDir)
    	       jobProperty (substr jobDir (+ 2 jobLen) lenDir)
    	       cadName	   (vl-filename-base (getvar 'DWGNAME))
    	 )
      )
    )

  9. #9
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    9,096
    Login to Give a bone
    1

    Default Re: Lisp to fill in title block of each sheet

    Your code is not actually parsing out to 16 like you think. You have not assigned vpMult to a an integer. You're conditional is checking the real number value of vpmult. You will need to assign the (fix vpMult) to the vpMult variable using a setq statement.
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

  10. #10
    Member
    Join Date
    2016-01
    Posts
    34
    Login to Give a bone
    0

    Default Re: Lisp to fill in title block of each sheet

    Thanks! That did it. I missed that I had to reassign the value into the variable. Too many languages & syntax in my head to catch the simple mistakes.

Similar Threads

  1. 2013: date parameter in title block (sheet)
    By jledgewood in forum Revit - Platform
    Replies: 1
    Last Post: 2014-03-18, 03:14 PM
  2. Getting Title Block info using LISP
    By robert_smeallie in forum AutoLISP
    Replies: 1
    Last Post: 2009-08-14, 01:19 AM
  3. Replies: 3
    Last Post: 2007-04-06, 12:05 PM
  4. Replies: 3
    Last Post: 2006-06-27, 06:40 PM
  5. How to fill in a Title Block w/ Lisp
    By GreyHippo in forum AutoLISP
    Replies: 24
    Last Post: 2006-01-26, 05:59 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •