Author Topic: vLISP vs VBA performance gap (Read 9430 times)

Chuck Gabriel · « **on:** May 24, 2007, 09:51:24 PM »

I was just wondering if anybody could explain to me why the following lisp code takes somewhere between ten and twenty times as long to execute as the roughly equivalent VBA code below it.

Code: [Select]

;;Erase all text entities with null values

(defun c:EraseEmptyText	(/ count)

  (startUndo)  ;; defined externally
  (setq count 0)
  (vlax-for block (vla-get-blocks *ThisDrawing*)
    (vlax-for ent block
      (if (and
	    (vlax-property-available-p ent 'TextString)
	    (setq txtVal (vla-get-textstring ent))
	    (or
	      (= "" txtVal)
	      (= " " txtVal)
	      (= "  " txtVal)
	      (= "\\A1;" txtVal)
	    )
	  )
	(progn
	  (setq count (1+ count))
	  (vla-erase ent)
	)
      )
    )
  )
  (endUndo) ;; defined externally
  
  (princ (strcat (itoa count) " blank text entities erased."))
  (princ)
)

Code: [Select]

Option Explicit

Private Const ERR_METHOD_NOT_SUPPORTED As Long = 438

Sub EraseEmptyText()
  On Error GoTo ERROR_HANDLER
  
  Dim count As Long
  count = 0
  ThisDrawing.StartUndoMark
  Dim block As AcadBlock
  For Each block In ThisDrawing.Blocks
    Dim ent As AcadEntity
    For Each ent In block
      Dim txtVal As String
      txtVal = ent.TextString
      If txtVal = vbNullString Or _
      txtVal = "\\A1;" Or _
      txtVal = " " Or _
      txtVal = "  " Then
        count = count + 1
        ent.Erase
      End If
NOT_APPLICABLE:
    Next ent
    Set ent = Nothing
  Next block
  Set block = Nothing
  ThisDrawing.EndUndoMark
  ThisDrawing.Utility.Prompt CStr(count) & " blank text entities erased."

  Exit Sub

ERROR_HANDLER:

  Select Case Err
    Case ERR_METHOD_NOT_SUPPORTED
      Resume NOT_APPLICABLE
    Case Else
      Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
  End Select
End Sub

CAB · « **Reply #1 on:** May 24, 2007, 10:50:42 PM »

Don't know.
Is this any faster?

Code: [Select]

(defun c:EraseEmptyText (/ ss)
  (and
    (setq ss (ssget "_X"
                    '((0 . "*text")
                      (-4 . "<or")
                      (1 . ",")
                      (1 . "{}")
                      (1 . "{ }")
                      (1 . "{  }")
                      (-4 . "or>")
                     )
             )
    )
    (mapcar 'entdel (mapcar 'cadr (ssnamex ss)))
  )
  (princ)
)

LE · « **Reply #2 on:** May 24, 2007, 11:46:45 PM »

Chuck;

Might be, because that code is trying to erase empty text from blocks (not the model or paper) and it is not possible to access them, because that property is in the attributes.

Chuck Gabriel · « **Reply #3 on:** May 25, 2007, 12:02:56 AM »

Quote from: CAB on May 24, 2007, 10:50:42 PM

Don't know.
Is this any faster?
Code: [Select]
(defun c:EraseEmptyText (/ ss) (and (setq ss (ssget "_X" '((0 . "*text") (-4 . "<or") (1 . ",") (1 . "{}") (1 . "{ }") (1 . "{ }") (-4 . "or>") ) ) ) (mapcar 'entdel (mapcar 'cadr (ssnamex ss))) ) (princ) )

Sorry. I should have mentioned this before. I started out using selection sets, but switched to iterating the database to solve a problem that I now realize actually had nothing to do with how I was collecting the objects I wanted to work with.

Thanks for the nudge CAB.

Chuck Gabriel · « **Reply #4 on:** May 25, 2007, 12:08:16 AM »

Quote from: LE on May 24, 2007, 11:46:45 PM

Chuck;

Might be, because that code is trying to erase empty text from blocks (not the model or paper) and it is not possible to access them, because that property is in the attributes.

Yes, I actually gave that possibility some thought, but decided to ignore it until I have worked out some other issues.

The reason I'm even doing this is that I've recently been experiencing a renewed fascination with LISP, so I've attempting to make improvements to some old routines (like this one) that don't work exactly like I'd prefer.

Kerry · « **Reply #5 on:** May 25, 2007, 01:29:46 AM »

Quote from: Chuck Gabriel on May 25, 2007, 12:08:16 AM

......................
The reason I'm even doing this is that I've recently been experiencing a renewed fascination with LISP, so I've attempting to make improvements to some old routines .................

now, THAT is interesting. !

VVA · « **Reply #6 on:** May 25, 2007, 03:22:10 AM »

Quote

Might be, because that code is trying to erase empty text from blocks (not the model or paper) and it is not possible to access them, because that property is in the attributes.

First variant, Erase empty text from model, layouts, blocks and cleare atribute

Code: [Select]

;_Unformat Mtext
(defun mip_MTEXT_Unformat ( Mtext / text Str )(setq Text "")
   (while (/= Mtext "")(cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
	   (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or(= " " (substr Text (strlen Text)))
		   (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
	  ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))))
	  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))
	  )) Text)
(defun EraseEmptyText (Doc / tempObjType tempValue count)
  (vl-load-com)(setq count 0)
  (vlax-for Blk (vla-get-blocks Doc)
    (if (= (vla-get-isxref Blk) :vlax-false)
      (vlax-for Obj Blk
        (setq tempObjType (vla-get-objectname Obj))
        (cond
          ((vl-position tempObjType '("AcDbText" "AcDbMText"))
           (setq
             tempValue (mip_MTEXT_Unformat (vla-get-textstring Obj))
           ) ;_Remove formatting Mtext
           (setq tempValue (vl-string-trim " \t\n" tempValue)) ;_Remove space, tab
           (if (and
                 (vl-position tempValue '("" "," ".")) ;_Pattern for remove
                 (vlax-write-enabled-p Obj)
               ) ;_ end of and
             (progn
               (vla-delete obj)
               (setq count (1+ count))
             )
           ) ;_ end of if
          )
          ((= tempObjType "AcDbBlockReference")
           (foreach Att (append (vlax-invoke Obj 'GetAttributes)(vlax-invoke Obj 'GetConstantAttributes))
             (setq
               tempValue (mip_MTEXT_Unformat (vla-get-textstring Att))
             ) ;_Remove formatting Mtext
             (setq tempValue (vl-string-trim " \t\n" tempValue)) ;_Remove space, tab
             (if (and
                   (vl-position tempValue '("" "," ".")) ;_Pattern for remove
                   (vlax-write-enabled-p Att)
                 ) ;_ end of and
               (progn
               (vla-put-textstring Att "")
                (setq count (1+ count))
               )
             ) ;_ end of if
           ) ;_ end of foreach
          )
          (t nil)
        ) ;_cond
      ) ;_ end of vlax-for
    ) ;_ end of if
  ) ;_ end of vlax-for
  (princ (strcat "\nDeleted " (itoa count) " empty text in blocks, texts or atributes"))
) ;_ end of defun
(defun c:EraseEmptyText ( )
  (EraseEmptyText (vla-get-activedocument (vlax-get-acad-object)))
  (princ)
  )

CAB · « **Reply #7 on:** May 25, 2007, 07:35:50 AM »

Now that's a robust routine VVA.

Chuck Gabriel · « **Reply #8 on:** May 25, 2007, 07:39:19 AM »

Quote from: Kerry Brown on May 25, 2007, 01:29:46 AM

Quote from: Chuck Gabriel on May 25, 2007, 12:08:16 AM
......................
The reason I'm even doing this is that I've recently been experiencing a renewed fascination with LISP, so I've attempting to make improvements to some old routines .................

now, THAT is interesting. !

Have I given the impression that I am a LISP hater in the past? If I did, I was just teasing. In reality, I'm just a pragmatist. Once I had learned VBA (to make GUI programming easier), I tended to use it even for non-GUI work simply because the paradigms had become so familiar (path of least resistance you know). Lately though, I've begun to take an interest in LISP's unique qualities.

jbuzbee · « **Reply #9 on:** May 25, 2007, 08:06:28 AM »

If it's a robust GUI your looking for - that you can use with lisp - look no further:

http://sourceforge.net/projects/opendcl

jb

Chuck Gabriel · « **Reply #10 on:** May 25, 2007, 08:23:42 AM »

I think I have settled on this:

Code: [Select]

(defun c:EraseEmptyText	(/ selSet)
  (startUndo)
  (setq	selSet (ssget "X"
		      '((-4 . "<OR")
			(-4 . "<AND")
			(0 . "*TEXT")
			(-4 . "<OR")
			(1 . "")
			(1 . " ")
			(1 . "  ")
			(-4 . "OR>")
			(-4 . "AND>")
			(-4 . "<AND")
			(0 . "MTEXT")
			(1 . "\\A1;")
			(-4 . "AND>")
			(-4 . "OR>")
		       )
	       )
  )
  (princ
    (strcat
      "\n"
      (itoa
	(cond
	  (selSet
	   (mapcar 'entdel (mapcar 'cadr (ssnamex selSet)))
	   (sslength selSet)
	  )
	  (T 0)
	)
      )
      " blank text entities erased.\n"
    )
  )
  (endUndo)
  (princ)
)

The thing I don't like about it is, technically you could have a line of text that was nothing but 100 spaces, and this routine wouldn't pick it up. With the database iteration method, since you test each TextString value manually rather than filtering for specific ones, you can do a test like the following, but it's probably too expensive to justify.

Code: [Select]

(= 0
 (length
   (vl-remove-if
     '(lambda (x)
	(= x 32)
      )
     (vl-string->list txtVal)
   )
 )
)

ronjonp · « **Reply #11 on:** May 25, 2007, 08:32:32 AM »

This is what I use:

Code: [Select]

(defun c:delnul	(/ ss)
  (if (setq ss (ssget "x" '((0 . "text") (1 . ", ,%%u,%%U"))))
    (mapcar '(lambda (x)
	       (vla-delete
		 (vlax-ename->vla-object x)
	       )
	     )
	    (mapcar 'cadr (ssnamex ss))
    )
  )
  (princ)
)

I don't think this deletes everything (per thread somewhere else...and limited testing):

(mapcar 'entdel (mapcar 'cadr (ssnamex selSet)))

*edit* Found it:

http://www.theswamp.org/index.php?topic=12771.msg179567#msg179567

Ron

Chuck Gabriel · « **Reply #12 on:** May 25, 2007, 08:37:19 AM »

Quote from: ronjonp on May 25, 2007, 08:32:32 AM

I don't think this deletes everything (per thread somewhere else...and limited testing):

(mapcar 'entdel (mapcar 'cadr (ssnamex selSet)))

I have seen some inconsistent behavior with entdel (plus entmod and a few others), but I figured I could swap in something like the lambda function you used if I started seeing significant failures. Using equivalent VLISP functions in place of standard AutoLISP functions has remedied past issues like that for me.

BTW, thanks for the input and pointers everybody.

Chuck Gabriel · « **Reply #13 on:** May 25, 2007, 09:04:34 AM »

Quote from: LE on May 24, 2007, 11:46:45 PM

Chuck;

Might be, because that code is trying to erase empty text from blocks (not the model or paper) and it is not possible to access them, because that property is in the attributes.

I guess you could change this

Code: [Select]

(vlax-property-available-p ent 'TextString)

to this

Code: [Select]

(and
  (vlax-property-available-p ent 'TextString)
  (not (vlax-property-available-p ent 'PromptString))
)

to get around that problem.

Attribute references shouldn't be a problem, because you can't get at them just by iterating over the database. You have to call vla-GetAttributes on the block references they belong to.

Chuck Gabriel · « **Reply #14 on:** May 25, 2007, 09:52:14 AM »

I changed my mind again. Here is what I've ended up with. I seems like a good compromise between completeness and speed (which is only an issue on really big drawings with lots of text).

Code: [Select]

(defun c:EmptyText (/ count selSet index text txtVal)
  (startUndo)
  (setq	count  0
	selSet (ssget "x" '((0 . "*TEXT")))
	index  (if selSet
		 (sslength selSet)
		 0
	       )
  )
  (while (> index 0)
    (setq index	 (1- index)
	  text	 (vlax-ename->vla-object
		   (ssname selSet index)
		 )
	  txtVal (vla-get-textstring
		   text
		 )
    )
    (if
      (or
	(= 0 (strlen txtVal))
	(= "\\A1;" txtVal)
	(= " " txtVal)
	(= "  " txtVal)
	(= 0
	   (length
	     (vl-remove-if
	       '(lambda	(x)
		  (= x 32)
		)
	       (vl-string->list txtVal)
	     )
	   )
	)
      )
       (progn
	 (setq count (1+ count))
	 (vla-erase text)
       )
    )
  )
  ;|
  (mapcar '(lambda (entName)
	     (setq text	  (vlax-ename->vla-object entName)
		   txtVal (vla-get-textstring
			    text
			  )
	     )
	     (if
	       (or
		 (= 0 (strlen txtVal))
		 (= "\\A1;" txtVal)
		 (= " " txtVal)
		 (= "  " txtVal)
		 (= 0
		    (length
		      (vl-remove-if
			'(lambda (x)
			   (= x 32)
			 )
			(vl-string->list txtVal)
		      )
		    )
		 )
	       )
		(progn
		  (setq count (1+ count))
		  (vla-erase text)
		)
	     )
	   )
	  (mapcar 'cadr (ssnamex selSet))
  )
  |;
  (endUndo)
  (princ
    (strcat "\n" (itoa count) " blank text entities erased.")
  )
  (princ)
)

I left some commented code in there to show another approach I investigated using mapcar instead of a while loop. The performance of the two approaches seems to be about even, but the while loop is more easily understandable to my C and Basic hardwired mind. It's hard for me to think in LISP, but I guess I should try to get used to it if I ever want to be any good at it.

MP · « **Reply #15 on:** May 25, 2007, 10:35:30 AM »

<Quick2¢>Hi Chuck, some quick code to muse --

Code: [Select]

(defun c:DeleteEmptyText ( / ss count i )

    (StartUndo)
    
    (setq count 0)

    (if (setq ss (ssget "x" '((0 . "text,mtext")(1 . ", ,\\A1;"))))
        (repeat (setq i (sslength ss))
            ;;  trap unsuccessful deletion because 
            ;;  object is on a locked layer
            (if (entdel (ssname ss (setq i (1- i))))
                (setq count (1+ count))
            )                                    
        )
    )
    
    (princ
        (strcat 
            (itoa count) 
            " blank text entity(s) erased."
        )
    )
    
    (EndUndo)
    
    (princ)
    
)

Edit: Revised to reflect entdel on a layer locked entity doesn't chuck a wobbly, just doesn't result in successful deletion.

Cheers and hi all.</Quick2¢>

Chuck Gabriel · « **Reply #16 on:** May 25, 2007, 10:58:29 AM »

Thanks MP.

I never considered (and didn't pick up on it in ronjonp's post) that you could provide a comma-delimited list of string values for group code 1 in the filter. I routinely do that for group code 0, but for some reason it didn't click that I could apply the same technique in other ways. Also, I think I'll incorporate a vl-catch-all-apply to trap unexpected errors like you did above.

I decided to only filter for entity type, and then manually examine the textstring values, so that I could catch lines of text consisting of an arbitrary number of spaces.

Thanks again for all the support everybody.

Oh yeah. Also, thanks CAB for showing me that wildcards can be used in filter criteria. I don't believe I've ever seen that trick before.

T.Willey · « **Reply #17 on:** May 25, 2007, 11:06:03 AM »

If you wanted to go the ActiveX way with lisp, and only wanted items of text within the spaces (tabs) like you get with 'ssget', then I would have coded it differently. I would use this

Code: [Select]

(vlax-for Lo (vla-get-Layouts *ThisDrawing*)
 (vlax-for Obj (vla-get-Block Lo)
   .......
  )
)

I think this way is better because I have had problems (and has been pointed out by others) with trying to use 'entdel' on objects in other spaces than the one calling the routine.

Chuck Gabriel · « **Reply #18 on:** May 25, 2007, 11:22:06 AM »

Quote from: T.Willey on May 25, 2007, 11:06:03 AM

If you wanted to go the ActiveX way with lisp, and only wanted items of text within the spaces (tabs) like you get with 'ssget', then I would have coded it differently. I would use this
Code: [Select]
(vlax-for Lo (vla-get-Layouts *ThisDrawing*) (vlax-for Obj (vla-get-Block Lo) ....... ) )I think this way is better because I have had problems (and has been pointed out by others) with trying to use 'entdel' on objects in other spaces than the one calling the routine.

That would certainly cut down on the amount of iteration required.

MP · « **Reply #19 on:** May 25, 2007, 11:28:45 AM »

If you were going activex, a quick bash ...

Code: [Select]

(defun c:DeleteEmptyText ( / count )

    (StartUndo)
    
    (setq count 0)
    
    (vlax-for layout 
    
        (vlax-get 
            (vlax-get 
                (vlax-get-acad-object)
                'ActiveDocument
            ) 
           'Layouts
        )
    
        (vlax-for object (vlax-get layout 'Block)
        
            (if 
            
                (and
                    (wcmatch 
                        (vlax-get object 'ObjectName) 
                        "AcDbText,AcDbMText"
                    )
                    (wcmatch 
                        (vlax-get object 'TextString) 
                        ", ,\\A1;"
                    )
                )    
                
                ;;  here we do have to trap an error 
                ;;  unless we've unlocked all layers 
                ;;  prior to running the routine
                
                (vl-catch-all-apply
                   '(lambda ( )
                        (vlax-invoke object 'Delete)
                        (setq count (1+ count))
                    )
                )
            )
        )
    )    

    (princ 
        (strcat 
            (itoa count) 
            " empty text entities erased."
        )
    )
    
    (EndUndo)
    
    (princ)
    
)

Untested but should work. To answer the inevitable "Why vlax versus vla?" question in advance, I found when doing objectdbx stuff way back that on average vlax calls executed faster than equivalent vla calls. How much I don't recall, but it was enough to make me use the former in code that does a lot of iteration through collections et al.

Patrick_35 · « **Reply #20 on:** May 25, 2007, 11:32:17 AM »

By taking again the filter MP's selection

Code: [Select]

(defun c:DeleteEmptyText(/ sel)
  (if (ssget "x" '((0 . "text,mtext")(1 . ", ,\\A1;")))
    (progn
      (vla-erase (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))))
      (vla-delete sel)
    )
  )
)

@+

T.Willey · « **Reply #21 on:** May 25, 2007, 11:34:44 AM »

Quote from: MP on May 25, 2007, 11:28:45 AM

<snip>
Untested but should work. To answer the inevitable "Why vlax versus vla?" question in advance, I found when doing objectdbx stuff way back that on average vlax calls executed faster than equivalent vla calls. How much I don't recall, but it was enough to make me use the former in code that does a lot of iteration through collections et al.

Thanks for this little tidbit Michael. I never knew that one.

MP · « **Reply #22 on:** May 25, 2007, 11:38:24 AM »

Quote from: Patrick_35 on May 25, 2007, 11:32:17 AM

By taking again the filter MP's selection ...

For the record I think it was Mr. Tanzillo who first revealed the succinct filter string of ", " for nabbing null text.

I like the compact code Patrick but I'd guess it will crash if any null text entities reside on locked layers.

=)

MP · « **Reply #23 on:** May 25, 2007, 11:39:52 AM »

Quote from: T.Willey on May 25, 2007, 11:34:44 AM

Thanks for this little tidbit Michael. I never knew that one.

You're very welcome Tim. If I know you you're testing the claim right now.

JohnK · « **Reply #24 on:** May 25, 2007, 11:46:20 AM »

Very cool thread guys!!

Patrick_35 · « **Reply #25 on:** May 25, 2007, 11:48:04 AM »

Quote

I like the compact code Patrick but I'd guess it will crash if any null text entities reside on locked layers.

*
Yes, exactly
A corrected version

Code: [Select]

(defun c:DeleteEmptyText(/ sel)
  (if (ssget "x" '((0 . "text,mtext")(1 . ", ,\\A1;")))
    (progn
      (vlax-map-collection (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) '(lambda (x) (vl-catch-all-apply 'vla-delete (list x))))
      (vla-delete sel)
    )
  )
)

@+

T.Willey · « **Reply #26 on:** May 25, 2007, 12:09:02 PM »

Quote from: MP on May 25, 2007, 11:39:52 AM

Quote from: T.Willey on May 25, 2007, 11:34:44 AM
Thanks for this little tidbit Michael. I never knew that one.

You're very welcome Tim. If I know you you're testing the claim right now.

Nothing to see here, move along.

CAB · « **Reply #27 on:** May 25, 2007, 01:04:37 PM »

One more version:

Code: [Select]

(defun c:DeleteEmptyText (/ ss)
  (and
    (setq ss (ssget "x" '((0 . "text,mtext") (1 . ", ,\\A1;"))))
    (mapcar '(lambda (x) (vl-catch-all-apply 'vla-delete
                         (list (vlax-ename->vla-object x))))
          (mapcar 'cadr (ssnamex ss)))
  )
)

Chuck Gabriel · « **Reply #28 on:** May 25, 2007, 01:20:15 PM »

Wow! That is one thoroughly skinned cat!

I didn't realize the true power of ", " when I first saw it. I thought it would grab null strings and strings with a value of " ", but it will actually grab any string that is either null or made entirely of spaces. That is awesome!

This really has been a great thread. I've learned a lot. Thanks again everybody.

MP · « **Reply #29 on:** May 25, 2007, 01:28:38 PM »

re: ", " ... as noted previously, another great tip you can attribute to Tony.

re: Error trapping the attempt to delete on an entity by entity basis can yield a significant performance hit. An alternative is to delete only those (matching) entities that reside on unlocked layers (quick knock off):

Code: [Select]

(defun c:DeleteEmptyText ( / count doc selection )

    (setq count 0)

    (vlax-for layer
    
        (vlax-get
            (setq doc (vlax-get (vlax-get-acad-object) 'ActiveDocument))
           'Layers
        )
        
        (if
            (and
                (zerop (vlax-get layer 'Lock))
                (ssget "x"
                    (list
                       '(0 . "text,mtext") 
                       '(1 . ", ,\\A1;")
                        (cons 8 (vlax-get layer 'Name))
                    )
                )
            )
            (progn
                (setq count
                    (+ count
                        (vla-get-count
                            (setq selection
                                (vlax-get doc 'ActiveSelectionset)
                            )
                        )
                    )       
                )
                (vlax-invoke selection 'Erase)
                (vlax-invoke selection 'Delete)
            )    
        )
    )
    
    (princ
        (strcat
            (itoa count)
            " empty text entity(s) erased."
        )
    )
    
    (princ)

)

Subtitle: Smaller isn't always better.

News:

Author Topic: vLISP vs VBA performance gap (Read 9430 times)

Chuck Gabriel

LE

Chuck Gabriel

Chuck Gabriel

Chuck Gabriel

Chuck Gabriel

Chuck Gabriel

Chuck Gabriel

Chuck Gabriel

Chuck Gabriel

Chuck Gabriel

Patrick_35

Patrick_35

Chuck Gabriel