Topic: vLISP vs VBA performance gap

[Chuck Gabriel]

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]

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]

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]

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]

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]

......................
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]

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]

Now that's a robust routine VVA. 

[Chuck Gabriel]

......................
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]

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]

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]

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]

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]

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]

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.