speed up a lisp routine

[ccowgill]

Below is a program that I have written to work with one of our 3rd party softwares to allow us to use annotative blocks. It works great, but is slow. I'm sure my programming isnt the most efficient it could be. I understand that the program probably wont run, so any one that helps wont be able to test it, but maybe you can still assist me by helping me to see what I can do to make parts of the program run faster.


(defun c:setblock1
(/ annoscale blockent blockentdata blockset blockvla count)
(if (setq blockset
(ssget
"x"
'((0 . "INSERT")
(2
.
"ANT,DOT,BP,BUSH,CB,CI,CIRP,CO,CRB,DF,EMF,EMH,EMT,EO,ETR,FH,FNP,FOP,FP,GL,GM,GMF,GMP,GP,GUY,GV,HH,LP,MAJORTIC,MINORTIC,MB,MH,MW,OP,PH,PN,PP,RP,SAMH,SAT1,SB,SC,SCB,PLUS,SGN,SPG,SPH,ST,STMH,TMF,TMH,TP,TR,TRB,TSCB,VLT,WELL,WET,WLF,WM,WMH,WSO,WV,YDL,YP"
)
)
) ;_ end of ssget
) ;_ end of setq
(progn
(setq count 0
annoscale (vl-string-left-trim "1" (getvar "cannoscale"))
annoscale (atoi (vl-string-left-trim ":" annoscale))
) ;_ end of setq
(while (< count (sslength blockset))
(setq blockent (ssname blockset count)
blockentdata (entget blockent)
blockvla (vlax-ename->vla-object blockent)
) ;_ end of setq
(cond
((or (> (vla-get-xscalefactor blockvla) 1.0)
(> (vla-get-yscalefactor blockvla) 1.0)
(> (vla-get-zscalefactor blockvla) 1.0)
) ;_ end of or
(if
(wcmatch (cdr (assoc 2 blockentdata))
"MAJORTIC,MINORTIC"
) ;_ end of wcmatch
(progn
(vla-put-xscalefactor blockvla 1.0)
(vla-put-yscalefactor blockvla 1.0)
(vla-put-zscalefactor blockvla 1.0)
) ;_ end of progn
(progn
(vla-put-xscalefactor blockvla (/ 1.0 annoscale))
(vla-put-yscalefactor blockvla (/ 1.0 annoscale))
(vla-put-zscalefactor blockvla (/ 1.0 annoscale))
) ;_ end of progn
) ;_ end of if
) ;_ end of cond1
((or (< (vla-get-xscalefactor blockvla) 1.0)
(< (vla-get-yscalefactor blockvla) 1.0)
(< (vla-get-zscalefactor blockvla) 1.0)
) ;_ end of or
(vla-put-xscalefactor blockvla 1.0)
(vla-put-yscalefactor blockvla 1.0)
(vla-put-zscalefactor blockvla 1.0)
) ;_ end of cond2
) ;_ end of cond
(setq count (1+ count))
) ;_ end of while
(placeattrib blockset annoscale)
(vla-regen (vla-get-activedocument (vlax-get-acad-object))
acAllViewports
) ;_ end of vla-regen
) ;_ end of progn
) ;_ end of if
) ;_ end of defun

any help is appreciated.

[RobertB]

A few of things I've noticed:

Why not use selection set filters to filter not only the block name but also the scale factors? This would remove the majority of the tests in the loop.

Why are using using both DXF and ActiveX versions of the block reference? Select one or the other based on performance tests.

[ccowgill]

ok, I made the modifications you suggested, it makes a lot more sense. Originally I was using both dxf and activex because I didnt know the proper coding to use only one, so I looked it up and modified it. However, I think that the biggest slow down is from the loop itself. filter or not, most of the time hundreds, if not thousands of blocks are at the incorrect scale, and they must all be updated. Is there a way to make the loop faster?


(defun c:setblock1
(/ annoscale blockent blockentdata blockset blockvla count)
(setq annoscale (vl-string-left-trim "1" (getvar "cannoscale"))
annoscale (atoi (vl-string-left-trim ":" annoscale))
) ;_ end of setq
(if (setq blockset
(ssget
"x"
(list
'(-4 . "<AND")
'(0 . "INSERT")
'(2
.
"ANT,DOT,BP,BUSH,CB,CI,CIRP,CO,CRB,DF,EMF,EMH,EMT,EO,ETR,FH,FNP,FOP,FP,GL,GM,GMF,GMP,GP,GUY,GV,HH,LP,MAJORTIC,MINORTIC,MB,MH,MW,OP,PH,PN,PP,RP,SAMH,SAT1,SB,SC,SCB,PLUS,SGN,SPG,SPH,ST,STMH,TMF,TMH,TP,TR,TRB,TSCB,VLT,WELL,WET,WLF,WM,WMH,WSO,WV,YDL,YP"
)
'(-4 . "<NOT")
(cons '41 annoscale)
'(-4 . "NOT>")
'(-4 . "AND>")
) ;_ end of list
) ;_ end of ssget
) ;_ end of setq
(progn
(setq count 0
) ;_ end of setq
(while (< count (sslength blockset))
(setq blockent (ssname blockset count)
blockvla (vlax-ename->vla-object blockent)
) ;_ end of setq
(if (wcmatch (vla-get-name blockvla)
"MAJORTIC,MINORTIC"
) ;_ end of wcmatch
(progn
(vla-put-xscalefactor blockvla 1.0)
(vla-put-yscalefactor blockvla 1.0)
(vla-put-zscalefactor blockvla 1.0)
) ;_ end of progn
(progn
(vla-put-xscalefactor blockvla (/ 1.0 annoscale))
(vla-put-yscalefactor blockvla (/ 1.0 annoscale))
(vla-put-zscalefactor blockvla (/ 1.0 annoscale))
) ;_ end of progn
) ;_ end of if
(setq count (1+ count))
) ;_ end of while
(placeattrib blockset annoscale)
(vla-regen (vla-get-activedocument (vlax-get-acad-object))
acAllViewports
) ;_ end of vla-regen
) ;_ end of progn
) ;_ end of if
) ;_ end of defun



because these blocks are annotative, and annotative blocks can only be uniformly scaled, is it necessary to put the scale to the y and z values as well as the x scales?

[irneb]

I can only improve ever so slightly on this. The trick is to only check the sslength once, then count down instead of up:
(setq count (sslength blockset))
(while (> (setq count (1- count)) -1)
(setq blockent (ssname blockset count)
blockvla (vlax-ename->vla-object blockent)
) ;_ end of setq
(if (wcmatch (vla-get-name blockvla)
"MAJORTIC,MINORTIC"
) ;_ end of wcmatch
(progn
(vla-put-xscalefactor blockvla 1.0)
(vla-put-yscalefactor blockvla 1.0)
(vla-put-zscalefactor blockvla 1.0)
) ;_ end of progn
(progn
(vla-put-xscalefactor blockvla (/ 1.0 annoscale))
(vla-put-yscalefactor blockvla (/ 1.0 annoscale))
(vla-put-zscalefactor blockvla (/ 1.0 annoscale))
) ;_ end of progn
) ;_ end of if
) ;_ end of whileIt's actually a trick I learnt from someone here.

I think the portion which makes for the most time taken is the vlax-ename->vla-object. Only thing I can think of is to not do this through Lisp, but rather .NET - so you don't even convert between 2 different libraries.

Entget would probably be even slower as it obtains all the data from each entity instead of only a reference.

Other than that, it's probably the scaling itself. Maybe if you could stop screen updates it could run faster. Can't remember how to do that in lisp.

[l3ch]

Following the idea, what I use to do:



(setq index 0) ;;; or 1, I haven't read the code. This is a previous step ;;;;(setq count (sslength blockset))
(repeat (sslength blockset);;;;; (while (> (setq count (1- count)) -1)
(setq blockent (ssname blockset count)
blockvla (vlax-ename->vla-object blockent)
) ;_ end of setq
(if (wcmatch (vla-get-name blockvla)
"MAJORTIC,MINORTIC"
) ;_ end of wcmatch
(progn
(vla-put-xscalefactor blockvla 1.0)
(vla-put-yscalefactor blockvla 1.0)
(vla-put-zscalefactor blockvla 1.0)
) ;_ end of progn
(progn
(vla-put-xscalefactor blockvla (/ 1.0 annoscale))
(vla-put-yscalefactor blockvla (/ 1.0 annoscale))
(vla-put-zscalefactor blockvla (/ 1.0 annoscale))
) ;_ end of progn
) ;_ end of if
(setq index (1+ index))
) ;_end of repeat ;;;;;;;_ end of while