Gathering attributes from a block insertion

In an earlier post I showed a routine for gathering attributes from a block insertion object.  I have since found a better way to get the attribute objects.

For years I have been using vla-get-attributes, which returns a variant, which must then be converted to a safearray and then a list.  The “New and Improved” method is to use vlax-invoke.

Below are a couple of test procedures I used to benchmark these two methods.

First, I selected the block insertion and converted the entity name to a vla object.

(setq obj (vlax-ename->vla-object(car (entsel))))

Here are the two functions.  AttTest1 using vla-getattributes, and AttTest2 using vlax-invoke.  Note that the functions are defined using Defun-q rather than Defun.  This is because the benchmarking routine I used (by Vladimir Nesterovsky – Profiler) requires defun-q.  I typically change the defun to defun-q to run the profiler, then change it back.

(defun-q attTest1
     ()
     (vlax-safearray->list
       (vlax-variant-value
         (vla-getattributes obj)
       )
     )
     (princ)
)

(defun-q attTest2
     ()
     (vlax-invoke obj 'getattributes)
     (princ)
)

Now for the fun part. Profile-Func is a routine in Vladimir’s profiler that registers the function and starts the timer.

(profile-func 'attTest1)
(profile-func 'attTest2)

Below are the timer results after running both routines 10 times.

Routine	Number of runs timed	Total seconds for all runs	Average seconds per run
AttTest1	10	0.4	0.041
AttTest2	10	0.07	0.007

To put this in perspective, the test block I created for this has 10,000 attributes.  That’s 0.00007 milliseconds per attribute!  Not too shabby!  Needless to say, I am going to be using vlax-invoke to get block attributes on all my routines in the future.  In addition I am going to be looking much more closely at the vlax functions.  I am particularly interested in using vlax-invoke with the GetDynamicBlockProperties method.

A Free copy of AutoCAD? From Autodesk???

Jimmy Bergmark, over at JTBWorld posted an article pointing out the Autodesk Assistance Program. This program makes a copy of AutoCAD 2010 available to qualified applicants. If you are a recently un-employed AutoCAD user, check this out!

AssocOn other than the car

Have you ever wanted to use Assoc to select an item out of a list, but the search term you wanted to use wasn't the car of the elements of the list? Enter AssocOn. This will let you do an "assoc-like" search on any element of the sub-lists. Take a look at the examples below.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  Routine:    AssocON                                
;;;  Purpose:    Similar to Assoc, but uses a user specified function to select    
;;;          the item in the list on which to search instead of        
;;;          searching on the car of the list.                
;;;  Arguments:    SearchTerm, the item for which we are searching.        
;;;        Lst, the list of lists through which we are searching.        
;;;        func, the function we are using to specify the item in the    
;;;          sub-list.                            
;;;  Returns: the sub-list with the first match.                ;;;
;;;=============================================================================
;;;  Examples                                    
;;;  Given:  (setq mylist '((1 2 3 4 5) (7 6 5 4 3 2 1) (12 13 14 15)))        
;;;        (assocon 2 mylist 'cadr)                        
;;;    will return                                
;;;       (1 2 3 4 5)                                
;;;                                        
;;;    and                                    
;;;                                        
;;;       (assocon "2" mylist                            
;;;        (function (lambda(x)(itoa (cadr x))))                
;;;       )                                    
;;;    will return                                
;;;       (1 2 3 4 5)                                
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun AssocOn (SearchTerm Lst func /)
  (car
    (vl-member-if
      (function
    (lambda (pair) (equal SearchTerm (apply func (list pair))))
      )
      lst
    )
  )
)

Get block insertions with objectdbx

Routine:	GetBlockInserts
Purpose:		Get a list of all insertions of specified blocks.
Arguments:	doc	vla-document object (or objectdbx document). If nil, then the active document is used.
	bnames	a list of strings, the block names for the subject blocks.
	ReturnEnames	boolean, non-nil returns entity names, nil returns vla-objects.
Returns:		A list of all the insertions of the subject blocks. -1 if the block is not defined. Nil if the block is defined but has no insertions.

Calling GetBlockInserts thus:

(getblockinserts2 nil '("test1" "test2" "test3") nil)

Might return something that looks like this:

(("test1"
   #<VLA-OBJECT IAcadBlockReference 0b4b55c4>       ;These may be enames or vla-objects depending on ReturnEnames
   #<VLA-OBJECT IAcadBlockReference 0b4b52f4>
   #<VLA-OBJECT IAcadBlockReference 0b4b56b4>
   #<VLA-OBJECT IAcadBlockReference 0b4b563c>
   #<VLA-OBJECT IAcadBlockReference 0b4b518c>
   #<VLA-OBJECT IAcadBlockReference 0b4b554c>
   #<VLA-OBJECT IAcadBlockReference 0b4b54d4>
  )
  ("test2"
   #<VLA-OBJECT IAcadBlockReference 0b4b57a4>
   #<VLA-OBJECT IAcadBlockReference 0b4b53e4>
   #<VLA-OBJECT IAcadBlockReference 0b4b536c>
   #<VLA-OBJECT IAcadBlockReference 0b4b545c>
  )
  ("test3"
    #<VLA-OBJECT IAcadBlockReference 0b4b527c>
    #<VLA-OBJECT IAcadBlockReference 0b4b5204>
    #<VLA-OBJECT IAcadBlockReference 0b4b4dcc>
    #<VLA-OBJECT IAcadBlockReference 0b4b4fac>
    #<VLA-OBJECT IAcadBlockReference 0b4b509c>
   )
("test4")                                           ;There are no insertions of this block
("test5" . –1)                                      ;This block is not defined
)

Note that (cdr(assoc “test4” results)) will return nil.

 

(defun GetBlockInserts2    (doc bnames ReturnEnames / objBlockDef InsList Blocks)
  (setq    doc    (if doc
         doc
         (vla-get-activedocument (vlax-get-acad-object))
           )
    blocks (vla-get-blocks doc)
  )
  (mapcar (function (lambda (bname)
              (setq inslist nil)
              (cons bname
                (if    (vl-catch-all-error-p
                  (setq    objBlockDef
                     (vl-catch-all-apply 'vla-item (list blocks bname))
                  )
                )
                  -1    ; Block doesn't exist
                  (setq InsList (vl-remove-if-not
                      (function
                        (lambda (x) (and (= 331 (car x)) (entget (cdr x))))
                          )
                          (member '(102 . "{BLKREFS")
                              (entget (vlax-vla-object->ename objBlockDef))
                          )
                        )
                    inslist (if    ReturnEnames
                          (mapcar (function (lambda (x) (cdr x))) inslist)
                          (mapcar
                        (function (lambda (x) (vlax-ename->vla-object (cdr x)))
                        )
                        inslist
                          )
                        )
                  )
                )
              )
            )
      )
      bnames
 

)
)

Modified 4/24/2009

Close with save - all drawings except current

This will close all currently open drawings, saving those that have been modified since their last save.

(vlax-for doc (vla-get-documents(vlax-get-acad-object))
  (if (= doc (vla-get-activedocument(vlax-get-acad-object)))
    nil
    (progn
      (if (or
        (= 0 (getvar "dbmod"))
        (= :vlax-false (vla-get-readonly doc))
        )
    (vl-catch-all-apply 'vla-close (list doc :vlax-false))
    (vl-catch-all-apply 'vla-close (list doc :vlax-true))
    )
      )
    )
  )

Rename xrefs to match their filename

(vl-load-com)
(setq
  doc (vla-get-activedocument(vlax-get-acad-object))
  blocks (vla-get-blocks doc)
)
(vlax-for blk blocks
  (if (not
    (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-get-path (list blk))
    )
      )
    (vla-put-name blk (vl-filename-base (vla-get-path blk)))
  )
)

GatherAtts.lsp

Function:	gatheratts
Purpose	Gathers all the attributes and their values into a list for all insertions of specified blocks.
Arguments	bnames  list of block names to find
Returns	list of lists Organized by block name as follows: ((bname1  the name of the first block   (bref1 atts) the bref object followed by a list of attrib objects   (bref2 atts) the bref object followed by a list of attrib objects ) (bname2  the name of the second block   (bref3 atts) the bref object followed by a list of attrib objects   (bref4 atts) the bref object followed by a list of attrib objects )

(defun gatheratts (bnames / ;end of formal argument list
               rtlist          gatheratts     ;the list to return
               inslist              ;list of block insertions
               attlist atts indx objins ss1 ssl ssp)
                                    ;end of local variable list
(setq
ssp    (ssgetfirst)
bnames (mapcar '(lambda (s) (strcase s)) bnames)
)
(foreach bname bnames
(cond
  ;;Let's see if this block has any insertions
  ((null (setq ss1 (ssget "X" '((0 . "INSERT")))))
   nil                              ;no selection set created, return nil
  )
  ;;How many insertions?
  ((= 0 (setq ssl (sslength ss1)))
   nil                              ;no insertions, return nil
  )
  ;;  We found insertions, lets build a list of their attributes
  (T
   (setq
     indx -1                        ;initialize our index
     inslist nil
   )                                ;end setq
   ;;get all the insertions for this block
   (while (> ssl (setq indx (1+ indx)))


     (cond
       ;;stop this object here if it has not attributes
       ((= :vlax-false
           (vla-get-hasattributes
             (setq objIns
                    (vlax-ename->vla-object (ssname ss1 indx))
             )
           )
        )
        nil
       )
       ((not (or
               ;;it's an un-modified dynamic block or non-dynamic block
               (= bname (strcase (vla-get-name objins)))
               ;;it's a dynamic block
               (= bname (strcase (vla-get-effectivename objins)))
             )                      ;end or
        )                           ;end not
        nil                         ;it isn't one of our blocks, ignore it
       )


       (T                           ;do this to every object that gets by our test
        (setq
          atts    (vla-getattributes objIns)
          attlist (vlax-safearray->list (vlax-variant-value atts))
                                    ;the attributes in a list
          attlist (mapcar
                    '(lambda (a) (cons (vla-get-tagstring a) a))
                    attlist
                  )
          inslist (append inslist (list (cons objins attlist)))
        )                           ;end setq
       )                            ;end T
     )                              ;end cond



   )                                ;end while insertions still found for this block name
   ;;add the lists for the insertions of this block to the return list
   (setq rtlist (append rtlist (list (cons bname inslist))))
  )                                 ;end T
)                                   ;end cond
)                                     ;end foreach
(sssetfirst (car ssp) (cadr ssp))
rtlist                                ;return the list of lists of lists of lists of lists...
)                                       ;end of gatheratts

(Edited 4/18/2009 to improve formatting)

CAD runs slower on Vista?

UpFrontEZine reports that "Vista Runs CAD (up to) 50x Slower". See Ralph Grabowski's upFront.eZine for details.

After attending the Vista launch event, I was hoping performance would improve. I guess not. At least, not for a while:-(

Hide blank lines in excel

When I need to hide blank lines in excel I use the following. First I select a range then run the following macro. This will hide all lines in the selected range which have no numerical values. This is pretty simplistic and has virtually no error checking, but it does what I need and I thought it might be helpful for others.

Public Sub HideBlankLines()
Dim rngLine As Range
Dim rngCell As Range
Dim bolNonBlankFound As Boolean

Application.ScreenUpdating = False

For Each rngLine In Application.Selection.Rows
bolNonBlankFound = False
For Each rngCell In rngLine.Columns
If Len(rngCell.Text) > 0 Then bolNonBlankFound = True: Exit For
Next rngCell
If Not bolNonBlankFound Then rngLine.EntireRow.Hidden = True
Next rngLine

Application.ScreenUpdating = True


End Sub

More HPFeet - Plate Weight

This is a small routine to calculate the weight of steel plates using my HPFeet input method. Example:
0.25 enter (the plate thickness in inches)
12 enter (the plate width in inches)
12.0108 (the plate length in HPFeet - in this case 12'-1 1/2")
PLWT (the procedure call)
123.7760 (the result - 123.7760 lbs)

The code:
FTD 12. * * * 12 / 12 / 12 / 490 *

Feet and inches with HP calculators

In the early 1980's I was introduced to the HP 41C programable calculator and was introduced to a series of small programs that perform basic math functions on imperial measurements without having to convert to decimal. To do this, distances are represented by what I will refer to as HPFeet, thus: FF.IISS where FF = whole feet, II = whole inches, and SS = sixteenths of an inch. In this format, 12'-1 1/2" is represented as 12.0108. The basic math functions, as I now use in an HP 48GII follow.

FTD: Feet to Decimal - Converts FF.IISS to decimal feet. For example, 12.0108 (which represents 12'-1 1/2") becomes 12.125
DUP IP SWAP FP 100 * DUP IP 12 / ROT + SWAP FP 100 * 16 / 12 / +

DTF: Decimal to feet - Converts decimal feet and inches in my HPFeet.
DUP IP SWAP FP 12 * DUP IP SWAP FP 16 * 100 / + 100 / +

FADD: With HPFeet numbers in both the first and second stack positions, the following will add them together leaving the result in the first stack position as HPFeet.
FTD SWAP FTD + DTF

FMIN: With HPFeet numbers in both the first and second stack positions, the following will subtract the first from the second, leaving the result in the first stack position as HPFeet.
FTD NEG SWAP FTD + DTF

FMULT: With an HPFeet number in both the second stack position and a decimal number in the first stack position, the following will multiply them, leaving the result in the first stack position as HPFeet.
SWAP FTD * DTF

FDIV: With an HPFeet number in both the second stack position and a decimal number in the first stack position, the following will divide the second by the first, leaving the result in the first stack position as HPFeet.
INV SWAP FTD * DTF

Later, I will include a couple more functions along with key assignments that simplify the use of the above routines.

Coming online!

This being my first post, I will try to give you an idea what to expect.

I have been using computers since about 1988 and programmable calculators (HP 41 and Ti-74) since about 1983. In that time I have worked as a steel detailer (one who creates steel fabrication drawings), a structural designer, an architectural drafter and designer. I have used AutoCAD since release 10 along with Excel and Lotus 123 since 1988. I am fascinated by the ability to make computers work for us. Because of this I have been programming since introduced to the HP 41C calculator in the early 80s. I expect to post my experiences as I continue to program Excel and AutoCAD using VBA, Lisp, and maybe even some dotNet.