Results 1 to 3 of 3

Thread: Help reading / understanding attached Attribute revision routine the attached routine

  1. #1
    Member
    Join Date
    2005-11
    Location
    Daly City, Ca.
    Posts
    41
    Login to Give a bone
    0

    Default Help reading / understanding attached Attribute revision routine the attached routine

    Hi guys,

    First of, i'd like to thank peter for this code. It works great. The code is suppose to bump my revision attributes to make room for a new one while keeping the history. I actually have no experience w/ lisps so i'm trying to understand the code that's attached so I can reverse the way it's moving the attributes as well as learn how to read this stuff and later on write my own.

    We have 2 main columns of revision w/ 10 rows, 5 each column, each w/ a rev #, description, by, date, appr. and date column. Currently we populate the attributes in this order:

    6 1
    7 2
    8 3
    9 4
    10 5

    The code bumps out the 10th line, moves all the data in the other fields down and empties out the 1st line. What i'd like it to do now is leave the first line "1" as is, bump up the revision (10 to 9, 9 to 8, etc...) and empty out the last row "10". We normally leave the first line "1" for a standard verbiage.

    Any help to read this would be appreciated.

    Code:
    (defun C:BumpAtts (/ intBase intItem intRecord lstOfSublists ssSelections)
     (if (setq ssSelections (ssget "x" (list (cons 0 "insert")(cons 2 "100G13BDRE")(cons 410 (getvar "ctab")))))
      (progn
       (vlax-for objItem (vla-get-activeselectionset  
    					  (vla-get-activedocument 
    					   (vlax-get-acad-object)))
    	(setq lstOfSublists (getattributesublists objItem)
    		  intBase	   18
    		  intRecord	 8
    	)
    	(repeat 10
    	 (setq intItem 11)
    	 (repeat 12
    	  (if (>= intRecord 0)
    	   (vla-put-textstring (nth 2 (nth (+ (* (1+ intRecord) 12) intBase intItem) lstOfSublists))
    						   (vla-get-textstring (nth 2 (nth (+ (* intRecord 12) intBase intItem)
    														   lstOfSublists
    													  )
    											   )
    						   )
    	   )
    	   (vla-put-textstring (nth 2 (nth (+ (* (1+ intRecord) 12) intBase intItem) lstOfSublists))
    						   ""
    	   )
    	  )
    	  (setq intItem (1- intItem))
    	 )
    	 (setq intRecord (1- intRecord))
    	)
       )
      )
     )
    )
    (defun GetAllAttributes (objSelection /)
     (if (= (type objSelection) 'ENAME)
      (setq objSelection (vlax-ename->vla-object objSelection))
     )
     (if (vlax-property-available-p objSelection "hasattributes")  
      (if (= (vla-get-hasattributes objSelection) :vlax-true)  
       (vlax-safearray->list 
    	(variant-value 
    	 (vla-getattributes objSelection)
    	)
       ) 
      )
     )
    )
    
    (defun GetAttributeSubLists (objSelection / lstAttributes)
     (if (setq lstAttributes (getAllAttributes objSelection))
      (progn
    ;   (princ lstAttributes)
       (mapcar '(lambda (objAttribute) (list (strcase (vla-get-tagstring  objAttribute))
    										 (vla-get-textstring  objAttribute)
    										 objAttribute
    								   )
    			)
    			lstAttributes
       )
      )
     )
    )
    (princ)
    Attached Files Attached Files

  2. #2
    Member
    Join Date
    2005-11
    Location
    Daly City, Ca.
    Posts
    41
    Login to Give a bone
    0

    Default Re: Help reading / understanding attached Attribute revision routine the attached routine

    found a solution to reversing the order. just changed a few + signs to - and adjusted some numbers and bam it started to work in reverse. Took about 6 hours to figure out but it's done.

    Now I need to just put a condition to it so that it will work w/ the current border that your working on. We have multiple border sizes and will need to incorporate that into this file so that we have only 1 routine to accomodate for the all the borders. If not then we'll have to create separate lisps for each border. If anyone has any suggestions, I would really appreciate it.

    Thanks,
    Christian

  3. #3
    Certifiable AUGI Addict ccowgill's Avatar
    Join Date
    2004-08
    Location
    Iron Station, NC
    Posts
    3,198
    Login to Give a bone
    0

    Default Re: Help reading / understanding attached Attribute revision routine the attached routine

    I use this routine for our revisions. It allows the engineers to enter the revision information into an excel file then places it in the title block based on attribute names. You will have to modify it for your use, as we only have 6 revisions in our title block. you might also have to revise how your title blocks are set up so they all have the same tags in the revisions.

    Code:
     
    (defun c:rxl2rt (/	 Col1ndx	Col2ndx   Col3ndx	Col4ndx
       strFileName		Sheetname  strSheetName
       rawlst	 itm		lst   itm2	  lstln
       counter	ss		Ent   Entdata	Att
       tmpList	nillist	date6
      )
      ;;=========================================================
      ;;   Read the Excel File & Create the Table
      ;;=========================================================
      ;;*****************************
      ;;***   Table data needed   ***
      ;;*****************************
      (setq Col1ndx	  1   ;Revision Number
     Col2ndx	  2   ;Revision Descrreviption
     Col3ndx	  3   ;Revision By
     Col4ndx	  4   ;Revision Date
     strFileName  (strcat (getvar "dwgprefix") "Revisions.xls")
     Sheetname	(getvar "ctab")
     strSheetName "Sheet1"
     nillist	  (list "" "" "" "")
      ) ;_ end of setq
      (if (/= (getvar "ctab") "Model")
    	(if (/= (findfile strFileName) nil)
    	  (progn
     ;;********************************************
     ;;***   Get the data fron the excel file   ***
     ;;********************************************
     (prompt "n >>>--->  Reading Excel, Please wait.n")
     (setq rawlst (GET_xl_sheet strFileName strSheetName))
     (and (null rawlst)
    	  (prompt "n***  Check Tab name in XL file  ***")
     ) ;_ end of and
     (if rawlst
       (progn
    	 (setq rawlst (cdr rawlst))
    	 (foreach itm rawlst
    	   (if (or (null (vl-position nil itm)) ; no nill is ok
    		(> (vl-position nil itm) 3)
    	)   ; no more than 1 of none of the 4 items is allowed to be nil
      (progn
    	(setq itm (reverse itm))
    	(if (and
       (or (wcmatch (car itm)
    		 (strcat "*" (getvar "ctab") "*")
    	   ) ;_ end of wcmatch
    	   (= "ALL" (car itm))
    	   (wcmatch (car itm) "*-X*")
       ) ;_ end of or
       (not (wcmatch (car itm)
    		  (strcat "*-" (getvar "ctab") "*")
    		) ;_ end of wcmatch
       ) ;_ end of not
    		) ;_ end of and
    	  (setq lst (cons (list (nth Col4ndx itm)
    	   (nth Col3ndx itm)
    	   (nth Col2ndx itm)
    	   (nth Col1ndx itm)
    		) ;end list
    		lst
    		 )  ;end cons
    	  )   ;end setq
    	)   ;end if
      )   ;end progn
    	   )	;end if
    	 )	;end foreach
    	 (setq lst (reverse lst))
    	 (setq lstln (length lst))
    	 (while (> lstln 6)
    	   (setq lst   (cdr lst)
    	  lstln (length lst)
    	   ) ;_ end of setq
    	 )	;end while
    	 (setq lst (reverse lst))
    	 (while (< lstln 6)
    	   (setq lst   (cons nillist lst)
    	  lstln (length lst)
    	   ) ;_ end of setq
    	 ) ;_ end of while
    	 (setq counter 1
    	ss   (ssget "_X"
    	 (list '(-4 . "<and")
    		   (cons 410 (getvar "ctab"))
    		   '(0 . "insert")
    		   '(2 . "TBL12,TBL13,TBL14,TBL15")
    		   (cons 10 '(0 0 0))
    		   '(-4 . "and>")
    	 ) ;end list
    	 ) ;_ end of ssget
    	 ) ;_ end of setq
    	 (if (/= ss nil)
    	   (progn
      (foreach itm2 (reverse lst)
    	(setq Ent (ssname ss 0)
       EntData (entget Ent)
    	) ;_ end of setq
    	(if
    	  (not
    		(foreach Att (vlax-invoke
    		 (vlax-ename->vla-object Ent)
    		 'GetAttributes
    	   ) ;_ end of vlax-invoke
       (if (= (vla-get-TagString Att) (itoa counter))
    	 (setq tmpList
    	 (cons Att (vla-get-TextString Att))
    	 ) ;_ end of setq
       ) ;_ end of if
    		)   ;end foreach
    	  )   ;END NOT
    	   (vla-put-TextString (car tmpList) (nth 0 itm2))
    	   (vla-Update (car tmpList))
    	)   ;end if
    	(if
    	  (not
    		(foreach Att (vlax-invoke
    		 (vlax-ename->vla-object Ent)
    		 'GetAttributes
    	   ) ;_ end of vlax-invoke
       (if (= (vla-get-TagString Att)
    		  (strcat "REVDESCRIPTION" (itoa counter))
    	   ) ;_ end of =
    	 (setq tmpList
    	 (cons Att (vla-get-TextString Att))
    	 ) ;_ end of setq
       ) ;_ end of if
    		)   ;end foreach
    	  )   ;END NOT
    	   (vla-put-TextString (car tmpList) (nth 1 itm2))
    	   (vla-Update (car tmpList))
    	)   ;end if
    	(if
    	  (not
    		(foreach Att (vlax-invoke
    		 (vlax-ename->vla-object Ent)
    		 'GetAttributes
    	   ) ;_ end of vlax-invoke
       (if
    	 (= (vla-get-TagString Att)
    		(strcat "BY" (itoa counter))
    	 ) ;_ end of =
    	  (setq tmpList
    	  (cons Att (vla-get-TextString Att))
    	  ) ;_ end of setq
       ) ;_ end of if
    		)   ;end foreach
    	  )   ;END NOT
    	   (vla-put-TextString (car tmpList) (nth 2 itm2))
    	   (vla-Update (car tmpList))
    	)   ;end if
    	(if
    	  (not
    		(foreach Att (vlax-invoke
    		 (vlax-ename->vla-object Ent)
    		 'GetAttributes
    	   ) ;_ end of vlax-invoke
       (if (= (vla-get-TagString Att)
    		  (strcat "DATE" (itoa counter))
    	   ) ;_ end of =
    	 (setq tmpList
    	 (cons Att (vla-get-TextString Att))
    	 ) ;_ end of setq
       ) ;_ end of if
    		)   ;end foreach
    	  )   ;END NOT
    	   (vla-put-TextString (car tmpList) (nth 3 itm2))
    	   (vla-Update (car tmpList))
    	)   ;end if
    	 ; )   ;end progn
    	 ; )	;end if
    	(setq date6 (nth 3 itm2))
    	(setq counter (1+ counter))
      )   ;end foreach
      (vla-put-TextString (car tmpList) date6)
    	   ) ;_ end of progn
    	 ) ;_ end of if
       )	;end progn
     )	;end if
    	  )	 ;end progn
    	  (prompt "nNo Revision Data")
    	)	 ;end if
    	(prompt "nCannot Be Run in Model Space")
      ) ;_ end of if
    )	 ;end defun
     
    ;;; --+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    ;;;  
    ;;; FUNCTION   GET_xl_sheet
    ;;; Retreaves Excel data from a specified file & sheet name
    ;;; 
    ;;; ARGUMENTS 
    ;;;  File name & path
    ;;;  Workbook sheet name
    ;;; 
    ;;; USAGE  (GET_xl_sheet FileSpec SheetName)
    ;;; 
    ;;; PLATFORMS  2000+ 
    ;;; 
    ;;; Author: Elpanov Evgeny elpanov@gmail.com
    ;;; Version:  1.0 Dec. 12, 2006
    ;;;
    ;;;  No error recovery
    ;;;  Can cause Excel to 'Not Finish' while ACAD is open if the
    ;;;  Workbook accessed is open in Excel
    ;;; --+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    (defun GET_xl_sheet (tbl sheet / ADOCONNECT ADORECORDSET C I i1)
      ;;	 by Elpanov Evgeny
      ;;	 elpanov@gmail.com
      ;;	 The version works with empty rows and columns
      (setq ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
     ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
      ) ;_  setq
      (if
    	(not
    	  (vl-catch-all-error-p
     (vl-catch-all-apply
       (function vlax-invoke-method)
       (list ADOConnect
      "Open"
      (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
       tbl
       ";Extended Properties=;Excel 8.0;HDR=No"
      ) ;_  strcat
      "admin"
      ""
      nil
       ) ;_  list
     ) ;_  vl-catch-all-apply
    	  ) ;_  vl-catch-all-error-p
    	) ;_  not
    	 (progn
    	   (if
      (member
    	(strcat sheet "$")
    	(mapcar
    	  (function (lambda (x)
    	(if (= (substr x 1 1) "'")
    	  (substr x 2 (- (strlen x) 2))
    	  x
    	) ;_  if
    		 ) ;_  lambda
    	  ) ;_  function
    	  (caddr
    		(mapcar
       (function (lambda (a)
    		(mapcar (function vlax-variant-value) a) ;_  mapcar
    	  ) ;_  lambda
       ) ;_  function
       (vlax-safearray->list
    	 (vlax-variant-value
    	   (vlax-invoke-method
    		 (vlax-invoke-method ADOConnect "OpenSchema" 4) ;_  vlax-invoke-method
    		 "GetRows"
    		 65535
    	   ) ;_  vlax-invoke-method
    	 ) ;_  vlax-variant-value
       ) ;_  vlax-safearray->list
    		) ;_  apply
    	  ) ;_ caddr
    	) ;_  mapcar
      ) ;_ member
       (progn
    	 (vlax-invoke-method
    	   ADORecordset
    	   "Open"
    	   (strcat "SELECT * FROM [" sheet "$]")
    	   ADOConnect
    	   1
    	   3
    	   nil
    	 ) ;_  vlax-invoke-method
    	 (if
    	   (> (progn (setq
    	 i (length
    		 (car (vlax-safearray->list
    		 (vlax-variant-value
    		   (vlax-invoke-method
    	  ADORecordset
    	  "GetRows"
    	  65536
    		   ) ;_  vlax-invoke-method
    		 ) ;_  vlax-variant-value
    	   ) ;_  vlax-safearray->list
    		 ) ;_  car
    	   ) ;_ length
       ) ;_  setq
       (vlax-invoke-method ADORecordset "Close")
       i
       ) ;_ progn
       0
    	   ) ;_ >
    		(progn
       (setq i1 1)
       (while (vl-catch-all-error-p
    	 (vl-catch-all-apply
    	   (function vlax-invoke-method)
    	   (list ADORecordset
    	  "Open"
    	  (strcat "SELECT * FROM ["
    	   sheet
    	   "$a"
    	   (itoa i1)
    	   ":IV"
    	   (itoa i1)
    	   "]"
    	  ) ;_ end of strcat
    	  ADOConnect
    	  1
    	  3
    	  nil
    	   ) ;_ list
    	 ) ;_ vl-catch-all-apply
       ) ;_ vl-catch-all-error-p
    	 (setq i1 (1+ i1))
       ) ;_ while
       (vlax-invoke-method ADORecordset "Close")
       (setq i (+ i i1))
       (while (>= i i1)
    	 (if
    	   (not (vl-catch-all-error-p
    	   (vl-catch-all-apply
    		 (function vlax-invoke-method)
    		 (list ADORecordset
    		"Open"
    		(strcat "SELECT * FROM ["
    		 sheet
    		 "$a"
    		 (itoa i)
    		 ":IV"
    		 (itoa i)
    		 "]"
    		) ;_ end of strcat
    		ADOConnect
    		1
    		3
    		nil
    		 ) ;_ list
    	   ) ;_ vl-catch-all-apply
    	 ) ;_ vl-catch-all-error-p
    	   ) ;_ not
    		(progn (setq c (cons
    		   (car
    	  (apply
    		(function mapcar)
    		(cons
    		  'list
    		  (mapcar
    			(function
    	   (lambda (a)
    		 (mapcar (function
    			(lambda (b)
    			  (vlax-variant-value b)
    			) ;_  lambda
    		  ) ;_  function
    		  a
    		 ) ;_  mapcar
    	   ) ;_  lambda
    			) ;_  function
    			(vlax-safearray->list
    	   (vlax-variant-value
    		 (vlax-invoke-method
    		   ADORecordset
    		   "GetRows"
    		   65535
    		 ) ;_  vlax-invoke-method
    	   ) ;_  vlax-variant-value
    			) ;_  vlax-safearray->list
    		  ) ;_  mapcar
    		) ;_  cons
    	  ) ;_  apply
    		   ) ;_  car
    		   c
    		 ) ;_  cons
    	   i (1- i)
    		) ;_  setq
    		(vlax-invoke-method ADORecordset "Close")
    		) ;_ progn
    		(setq i (1- i))
    	 ) ;_ if
       ) ;_  while
    ;;;			  (setq c (if (equal c '((nil) (nil)))
    ;;;						(list sheet)
    ;;;						(cons sheet c)
    ;;;					  ) ;_  if
    ;;;			  ) ;_ setq
    		) ;_ progn
    	 ) ;_ if
       ) ;_ progn
    	   ) ;_ if
    	   (vlax-invoke-method ADOConnect "Close")
    	   (vlax-release-object ADORecordset)
    	   (vlax-release-object ADOConnect)
    	   (setq ADORecordset nil
    	  ADOConnect   nil
    	   ) ;_  setq
    	   c
    	 ) ;_  progn
    	 (progn (vl-catch-all-apply
    	   'vlax-invoke-method
    	   (list ADOConnect "Close")
    	 ) ;_  vl-catch-all-apply
    	 (vlax-release-object ADORecordset)
    	 (vlax-release-object ADOConnect)
    	 (setq ADORecordset nil
    	ADOConnect   nil
    	 ) ;_  setq
    	 nil
    	 ) ;_  progn
      ) ;_  if
    ) ;_  defun
    
    ;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    ;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Similar Threads

  1. Replies: 7
    Last Post: 2016-06-17, 01:13 PM
  2. LISP routine for Revision indicator and cloud
    By dhavalpatel_us337373 in forum AutoLISP
    Replies: 36
    Last Post: 2011-05-24, 02:13 PM
  3. Need Help Understanding Attached Lisp
    By sumulong in forum AutoLISP
    Replies: 6
    Last Post: 2011-01-14, 03:25 AM
  4. Is it possible to draw attached image via a LISP routine?
    By BRENDA_GZZ_GOMEZ in forum AutoLISP
    Replies: 6
    Last Post: 2007-04-16, 09:00 PM
  5. Looking for a Revision tag routine
    By RED ROCKER in forum AutoLISP
    Replies: 10
    Last Post: 2007-04-09, 02:58 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
  •