Topic: Speed up a lisp routine

[Chris]

I've got this posted at AUGI, but I was hoping someone here might be able to help out as well.  below is a program that I have that checks the scale of a selection set of blocks, if it isnt right, it changes it.  however, the program is very slow when it runs - it takes about 6 seconds to correct 3000 blocks.  i'd like to reduce this to almost instant, if it is even possible.  Does anyone have an suggestion on how to make this run faster?

Code: [Select]

(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


Thanks,

[cmwade77]

6 seconds for 3000 blocks isn't too bad, it would sure take longer to manually run it.

Given what the command does, I am not sure that you need the Regen at the end, but that won't speed it up too overly much.

[CAB]

Try this version:

Code: [Select]

(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
  .
   (strcat "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 -1 )
      (while (setq blockent (ssname blockset (setq count (1+ count))))
(setq blockvla (vlax-ename->vla-object blockent)
) ;_ end of setq
(if (vl-position (vla-get-name blockvla) '("MAJORTIC""MINORTIC"))
 (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 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

[DEVITG]

About regen

It could be a cause , as it do for the each  3000 blocks.

Other possible cause is at the ssget filter, if all blocks are at model space add

'(410 . "Model") so it will not loop at PAPER SPACES LAyouts.

What do it do?

Code: [Select]

(placeattrib blockset annoscale)
And for my personal taste , I like to loop on LIST's or better in VL's coll
using a VLObj coll  by

Code: [Select]

(setq blok-obj-coll  (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
just after the SSGET

then you loop by

Code: [Select]

(vlax-for  block-obj  blok-obj-coll

;__ do your task

)
No need the count


Neither  do  

Code: [Select]

(setq blockent (ssname blockset count)
     blockvla (vlax-ename->vla-object blockent) )

Also I would make 2 ssget , one for blocks named MAJORTIC,MINORTIC

and the other for the rest,  then  do the 2 progn's direct



So it will not need to use

Code: [Select]

(wcmatch (vla-get-name blockvla)
    "MAJORTIC,MINORTIC"
   )
neither the IF statement

[Lee Mac]

Give this a shot:

Code: [Select]

(defun c:setblock1 (/ BlkLst annoscale 1/anno obj ss)
  (vl-load-com)

  (setq *doc* (cond (*doc*) ((vla-get-ActiveDocument (vlax-get-acad-object)))))

  ;; Blocks to Operate on:

  (setq blkLst (strcat "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"))

  ;;---------------------------------------------------------------------------
 
  (setq annoscale (getvar "cannoscalevalue")
         1/anno    (/ 1. annoscale))
 

  (if (ssget "_X" (list '(-4 . "<AND")
                           (0 . "INSERT")
                           (cons 2 blkLst)
                          '(-4 . "<NOT")
                             (cons 41 annoscale)
                          '(-4 . "NOT>")))
    (progn
     
      (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc*))

(if (vl-position (vla-get-name obj) '("MAJORTIC""MINORTIC"))
  (progn
    (vla-put-xscalefactor obj 1.0)
    (vla-put-yscalefactor obj 1.0)
    (vla-put-zscalefactor obj 1.0))
  (progn
    (vla-put-xscalefactor obj 1/anno)
    (vla-put-yscalefactor obj 1/anno)
    (vla-put-zscalefactor obj 1/anno))))

      (vla-delete ss)
     
      ;(placeattrib blockset annoscale) ;; Could you post this function?
     
      (vla-regen *doc* acAllViewports)))

  (princ))


[JohnK]

I tried to run it and it doesnt work for me.

After a very quick look at the procedure:
The first couple of lines: I dont understand what your intension's are but have you tried this instead of getting the ``annoscale'' var?
(getvar 'CANNOSCALEVALUE)

Take the inverse of that call if you want something like the old fashioned (getvar 'DIMSCALE) process.

[JohnK]

Lee Mac,
yes, like that.

This is why:

Code: [Select]

Command:
Command: (  (lambda ( )
((_>        (princ
(((_>  (strcat
((((_>    "\nThe anno scale i see by using a \"(GETVAR \"CANNOSCALE\")\" is: \""
((((_>    (getvar "cannoscale")
((((_>    "\""))
((_>        (princ) ) )

The anno scale i see by using a "(GETVAR "CANNOSCALE")" is: "Guess what i typed
in custom scale option?"

Command:

[Chris]

Ok, I tried Lee's and it slows it way down, it is closer to 15-20sec now.  I'm thinking Maybe to go with a combo of Cab program and DevitG's suggestions.
Ok, after going back and looking at it, the program that I am running above may not be the problem, granted it did seem slow, but may now be much better.  I've got to do some more testing, I'll get back to you on Monday, it may be the other program, but it may not, I dont want to waste anyones time.  (although I did learn quite a bit about stream lining my current code)

Se7en, you didnt get mentioned because I'm still editing my message.

[JohnK]

Ok, I tried Lee's and it slows it way down, it is closer to 15-20sec now.  I'm thinking Maybe to go with a combo of Cab program and DevitG's suggestions.

How come i didnt get mentioned?

[JohnK]

...
Se7en, you didnt get mentioned because I'm still editing my message.

Oh good, i though i may have forgotten deodorant this morning or something.

[CAB]

Chris, was there no improvement using my version?

[Chris]

Chris, was there no improvement using my version?

I cant tell, I cant get it to run anymore, when I inspect the ssget function it is blank, no nil, no nothing, and the program keeps erroring out with a bad list value, my guess is it has something to do with the cons 41 annoscale line, but I dont know what the proper syntax is to make it run.

[DEVITG]

Could you upload the DWG, or send it offline.

[Chris]

it isnt as simple as just posting a drawing.  It is a pretty long story and I will try my best to explain it in summary. We use Eagle Point as our civil 3rd party software.  It doesnt work with annotative blocks.  I have wrote some programs that use annotative blocks, but eagle point doenst like them, so it tries to constantly scale them up (I dont know why)  so this is part of a program that is attempting to keep tabs on that and always keep them scaled to the proper size.  The part that may really be causing the slow down is when I try to get the attributes to behave the way I want and stay in the same location.  Eagle Point doesnt use conventional methods to insert points when a point file is reduced.  It places blocks in the drawing that contain attributes, you can see these in the properties palette and edit them, but if you double click the block, the attribute editor wont show up, programmatic methods dont recognize that these blocks have attributes.  So long story short, when Eagle point caused the blocks to scale up, it didnt cause the attributes to go with them, so everytime my program shrinks them back down, the attributes get smaller and smaller.  So I added an additional program to put my attributes back at the scale and location I want to see them.

Code: [Select]

(defun placeattrib (blockset     annoscale     /     bs
    bsl     ct     ct2     lp     lp2     ne
    nea     neav    neav2   neblk   nedxf   neent
    nela2x  nela2y  nela2z  nename  nevla   yoff
    xoff    theight nelart
   )
  (setq bs blockset
bsl (sslength bs)
ct (- bsl 1)
lp 1
yoff 2.0
xoff 5.0
theight 1.0
  ) ;_ end of setq
  (while lp
    (setq ne (ssname bs ct)
  nename ne
  neent (entget ne)
  nelA2X (cadr (assoc 10 neent))
  nela2y (caddr (assoc 10 neent))
  nela2z (cadddr (assoc 10 neent))
;nelart (cdr (assoc 50 neent))
  CT2 0
  LP2 1
    ) ;_ end of setq
    (while lp2
      (setq nedxf (entget nename))
      (if (equal (assoc 0 nedxf) '(0 . "ATTRIB"))
(progn
  (if (= (cadr (assoc 11 nedxf)) 0.0)
    (setq nea (assoc 10 nedxf)
  neav (cdr nea)
  neav2 1
    ) ;_ end of setq
    (setq nea (assoc 11 nedxf)
  neav (cdr nedxf)
  neav2 nil
    ) ;_ end of setq
  ) ;_ end of if
  (if (/= nea nil)
    (progn
      (setq nevla (vlax-ename->vla-object nename))
      (if (or (= (cdr (assoc 2 neent)) "TR")
      (= (cdr (assoc 2 neent)) "PN")
  ) ;_ end of or
(cond
  ((= (cdr (assoc 2 nedxf)) "PN")
   (vla-put-textalignmentpoint
     nevla
     (vlax-3d-point
       (list nela2x (+ nela2y yoff) nela2z)
     ) ;_ end of vlax-3d-point
   ) ;_ end of vla-put-textalignmentpoint
   (vla-put-height nevla theight)
;(vla-put-rotation nevla 0)
  )
  ((= (cdr (assoc 2 nedxf)) "PD")
   (vla-put-textalignmentpoint
     nevla
     (vlax-3d-point (list nela2x nela2y nela2z))
   ) ;_ end of vla-put-textalignmentpoint
   (vla-put-height nevla theight)
;(vla-put-rotation nevla 0)
  )
  ((= (cdr (assoc 2 nedxf)) "ZC")
   (vla-put-textalignmentpoint
     nevla
     (vlax-3d-point
       (list nela2x (- nela2y yoff) nela2z)
     ) ;_ end of vlax-3d-point
   ) ;_ end of vla-put-textalignmentpoint
   (vla-put-height nevla theight)
;(vla-put-rotation nevla 0)
  )
) ;_ end of cond
(if (= neav2 1)
  (progn
    (vla-put-insertionpoint
      nevla
      (vlax-3d-point
(list (+ nela2x xoff) (+ nela2y yoff) nela2z)
      ) ;_ end of vlax-3d-point
    ) ;_ end of vla-put-insertionpoint
    (vla-put-height nevla theight)
;(vla-put-rotation nevla 0)
  ) ;_ end of progn
  (cond
    ((= (cdr (assoc 2 nedxf)) "PD")
     (vla-put-textalignmentpoint
       nevla
       (vlax-3d-point
(list (+ nela2x xoff) nela2y nela2z)
       ) ;_ end of vlax-3d-point
     ) ;_ end of vla-put-textalignmentpoint
     (vla-put-height nevla theight)
;(vla-put-rotation nevla 0)
    )
    ((= (cdr (assoc 2 nedxf)) "ZC")
     (vla-put-textalignmentpoint
       nevla
       (vlax-3d-point
(list (+ nela2x xoff) (- nela2y yoff) nela2z)
       ) ;_ end of vlax-3d-point
     ) ;_ end of vla-put-textalignmentpoint
     (vla-put-height nevla theight)
;(vla-put-rotation nevla 0)
    )
  ) ;_ end of cond
) ;_ end of if
      ) ;_ end of if
    ) ;_ end of PROGN
  ) ;_ END PROGN/IF NEA
  (setq nename (entnext nename))
) ;_ end of PROGN
(setq nename (entnext nename))
      ) ;_ END PROGN/IF NEAET
      (if (/= nename nil)
(if (equal (assoc 0 (entget nename)) '(0 . "SEQEND"))
  (setq LP2 nil)
) ;_ end of IF
(setq LP2 nil)
      ) ;_ end of if
    ) ;_ END while LP2
    (setq ct (- ct 1))
    (if (< ct 0)
      (setq lp nil)
    ) ;_ end of IF
  ) ;_ END while LP
  (princ)
) ;_ end of defun
is everyone really confused yet?  I am, its 5 on Friday, I'm going home, talk to you on Monday.
Thanks for the help so far, maybe I'll spend some time on it this weekend and see if I can isolate what is going on.

[DEVITG]

Sad to say , it will be ALMOST impossible to help , with not such a DWG.
How do you guess we/I can test the LISP.?
And the placeattrib seem to be hard working defun.