Optimization

[zph]

Good day all!

I've been using this code below for a while now and it works:

(defun c:SHNO ( / allLayoutsList allLayoutsListLength NewSheetNo titlePage nextPages)
(setvar "cmdecho" 0)

;***************** Define block name variables *****************;
(setq titlePage "_SP_TITLE_PAGE_08SEP15")   ; title page block name
(setq nextPages "_SP-Border2-F28X40_08SEP2015")   ; subsequent pages block name
;***************************************************************;

(setq allLayoutsList (LAYOUTLIST))    ; gets list of all layout names
(setq allLayoutsListLength (vl-list-length allLayoutsList)) ; gets number of layouts
(setq NewSheetNo "")

;;;;;;;;;;----[un]comment to switch sheet and number formats----;
        ;
;(letterSingleX)      ;
;(letterAllXofX)      ;
;(fullAllXofX)       ;
(fullSingleX)       ;
        ;
;;;;;;;;;;------------------------------------------------------;

(command "LAYOUT" "set" (strcat "Layout 1"))   ; sets "Layout 1" current
(setvar "cmdecho" 1)
(princ)
) ;SHNO

(defun fullSingleX ( / counter NewSheetNo ssTTLpageBLKsht ssTTLBLKsht)
(setq counter 1)

(while (<= counter allLayoutsListLength)
(command "LAYOUT" "set" (strcat "Layout " (itoa counter))) ; sets next paper space sheet current

 (cond
  ((= counter 1)
   (progn
   (setq NewSheetNo (strcat "" (itoa counter) " OF " (itoa allLayoutsListLength) ""))
   (setq ssTTLpageBLKsht
    (ssget "_X" (list '(0 . "INSERT")
           (cons 2 titlePage)
           '(66 . 1))))    
   (setq i1 (sslength ssTTLpageBLKsht))
   (setq obj (vlax-ename->vla-object (ssname ssTTLpageBLKsht (setq i1 (1- i1)))) attlst (vlax-invoke obj 'GetAttributes))
   (foreach att attlst (if (= (vla-get-TagString att) "SHEET")(vla-put-TextString att NewSheetNo))))) ;progn ;=1
  ((and (> counter 1)(< counter allLayoutsListLength))
   (progn     ;- Pages in between first and last sheet numbers
   (setq NewSheetNo (strcat "" (itoa counter) ""))
   (setq ssTTLBLKsht
    (ssget "_X" (list (cons 0 "INSERT")
         (cons 2 nextPages)
         (cons 66 1)
         (cons 410 (getvar "ctab")))))
   (setq i2 (sslength ssTTLBLKsht))
   (setq obj (vlax-ename->vla-object (ssname ssTTLBLKsht (setq i2 (1- i2)))) attlst (vlax-invoke obj 'GetAttributes))
   (foreach att attlst (if (= (vla-get-TagString att) "SHEET")(vla-put-TextString att NewSheetNo))))) ;progn ;1< <MAX
  ((= counter allLayoutsListLength)
   (progn     ;- Last page sheet numbers
   (setq NewSheetNo (strcat "" (itoa counter) " OF " (itoa allLayoutsListLength) ""))
   (setq ssTTLBLKsht
    (ssget "_X" (list (cons 0 "INSERT")
         (cons 2 nextPages)
         (cons 66 1)
         (cons 410 (getvar "ctab")))))
   (setq i3 (sslength ssTTLBLKsht))
   (setq obj (vlax-ename->vla-object (ssname ssTTLBLKsht (setq i3 (1- i3)))) attlst (vlax-invoke obj 'GetAttributes))
   (foreach att attlst (if (= (vla-get-TagString att) "SHEET")(vla-put-TextString att NewSheetNo))))) ;progn ;=MAX
 ) ;cond

(setq counter (+ counter 1))
) ;while

(princ)
) ;fullSingleX

---

This routine works as intended.  However, if there are any more than 40 or so sheets in my drawing file, the routine moves like a slug.  I just ran this on a drawing that has 60+ sheets and it took longer than 2 minutes.

Do you guys have any ideas how I could restructure/optimize the code so it runs faster?

Thanks!

~Z

[hmsilva]

Hi zph,

without set each layout current...

Untested...

(vl-load-com)
(defun c:demo (/ a adoc blks layt layts tot)
   (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
   (setq layts (vla-get-layouts adoc)
         tot   (itoa (1- (vla-get-count layts)))
   )
   (vlax-for layt layts
      (if (not (= (vla-get-name layt) "Model"))
         (progn
            (setq blks (vla-get-block layt))
            (vlax-for blk blks
               (if (and (= (vla-get-objectname blk) "AcDbBlockReference")
                        (wcmatch (vla-get-effectivename blk) "_SP_TITLE_PAGE_08SEP15,_SP-Border2-F28X40_08SEP2015")
                        (vlax-write-enabled-p blk)
                   )
                  (mapcar '(lambda (a)
                              (if (= (vla-get-TagString a) "SHEET")
                                 (vla-put-TextString a (strcat (itoa (vla-get-taborder layt)) " OF " tot))
                              )
                           )
                          (vlax-invoke blk "GetAttributes")
                  )
               )
            )
         )
      )
   )
   (princ)
)

Hope this helps,
Henrique

[marko_ribar]

Yes without setting LAYOUT to active...

Modify your subfunction as follows :

Try to remove this line :
(command "LAYOUT" "set" (strcat "Layout " (itoa counter))) ; sets next paper space sheet current
IMHO I think this is unneccessary and maybe exactly the thing that's eating time

Try to change every accurance of (ssget "_X" ... ) to (ssget "_A" ... )

Replace this line :
(foreach att attlst
  (if (= (vla-get-TagString att) "SHEET")
    (vla-put-TextString att NewSheetNo)
  )
)
With this line :
(vl-some '(lambda ( x )
  (if (= (vla-get-tagstring x) "SHEET")
    (vla-put-textstring x NewSheetNo)
    (setq x nil)
  )) attlst
);;; watch ab parenthesis you have closing progn here in your subfunction

[marko_ribar]

Sorry, my mistake...

This is correct :

(vl-some '(lambda ( x )
  (if (= (vla-get-tagstring x) "SHEET")

    (progn
      (vla-put-textstring x NewSheetNo)
      (setq x nil)

    )

    x
  )) attlst
);;; watch ab parenthesis you have closing progn here in your subfunction

[devitg]

Hi Marko Ribar . 

It is the first time I see 

Try to change every accurance of (ssget "_X" ... ) to (ssget "_A" ... )

As I test it, it do a ALL for the SSGET , what is the difference with "_X" ?? 

The vlide help  do not show that option 

Thank in advance 

[hmsilva]

---

@devitg wrote:

Hi Marko Ribar . 

It is the first time I see 

Try to change every accurance of (ssget "_X" ... ) to (ssget "_A" ... )

As I test it, it do a ALL for the SSGET , what is the difference with "_X" ?? 

The vlide help  do not show that option 

Thank in advance 

---

Hi Gabriel,

the A mode is undocumented, is similat to X mode, and we use it to reject objects on frozen layers...

Lee Mac's ssget

Henrique

[zph]

Thanks for the response, Marko.

The routine doesn't work with this though. Here is the ACAD response:

; error: bad argument type: lselsetp nil

-------------------  Here is the code modified:

(defun fullSingleX ( / counter NewSheetNo ssTTLpageBLKsht ssTTLBLKsht)
(setq counter 1)

(while (<= counter allLayoutsListLength)
;(command "LAYOUT" "set" (strcat "Layout " (itoa counter))) ; sets next paper space sheet current

 (cond
  ((= counter 1)
   (progn
   (setq NewSheetNo (strcat "" (itoa counter) " OF " (itoa allLayoutsListLength) ""))
   (setq ssTTLpageBLKsht
    (ssget "_A" (list '(0 . "INSERT")
           (cons 2 titlePage)
           '(66 . 1))))    
   (setq i1 (sslength ssTTLpageBLKsht))
   (setq obj (vlax-ename->vla-object (ssname ssTTLpageBLKsht (setq i1 (1- i1)))) attlst (vlax-invoke obj 'GetAttributes))
    (foreach att attlst
     (vl-some '(lambda ( x )
         (if (= (vla-get-tagstring x) "SHEET")
        (progn
        (vla-put-textstring x NewSheetNo)
        (setq x nil)
        ) ;progn
       x
       ) ;if
      ) ;lambda
     attlst
     ) ;vl-some
    ) ;foreach
   ) ;progn
  )  ;counter=1

  ((and (> counter 1)(< counter allLayoutsListLength))
   (progn     ;- Pages in between first and last sheet numbers
   (setq NewSheetNo (strcat "" (itoa counter) ""))
   (setq ssTTLBLKsht
    (ssget "_A" (list (cons 0 "INSERT")
         (cons 2 nextPages)
         (cons 66 1)
         (cons 410 (getvar "ctab")))))
   (setq i2 (sslength ssTTLBLKsht))
   (setq obj (vlax-ename->vla-object (ssname ssTTLBLKsht (setq i2 (1- i2)))) attlst (vlax-invoke obj 'GetAttributes))
    (foreach att attlst
     (vl-some '(lambda ( x )
         (if (= (vla-get-tagstring x) "SHEET")
        (progn
        (vla-put-textstring x NewSheetNo)
        (setq x nil)
        ) ;progn
       x
       ) ;if
      ) ;lambda
     attlst
     ) ;vl-some
    ) ;foreach
   ) ;progn
  ) ;1<counter<MAX

  ((= counter allLayoutsListLength)
   (progn     ;- Last page sheet numbers
   (setq NewSheetNo (strcat "" (itoa counter) " OF " (itoa allLayoutsListLength) ""))
   (setq ssTTLBLKsht
    (ssget "_A" (list (cons 0 "INSERT")
         (cons 2 nextPages)
         (cons 66 1)
         (cons 410 (getvar "ctab")))))
   (setq i3 (sslength ssTTLBLKsht))
   (setq obj (vlax-ename->vla-object (ssname ssTTLBLKsht (setq i3 (1- i3)))) attlst (vlax-invoke obj 'GetAttributes))
    (foreach att attlst
     (vl-some '(lambda ( x )
         (if (= (vla-get-tagstring x) "SHEET")
        (progn
        (vla-put-textstring x NewSheetNo)
        (setq x nil)
        ) ;progn
       x
       ) ;if
      ) ;lambda
     attlst
     ) ;vl-some
    ) ;foreach
   ) ;progn
  ) ;counter=MAX
 ) ;cond

(setq counter (+ counter 1))
) ;while

(princ)
) ;fullSingleX

[zph]

Thank you for your response, Henrique.

However, the routine doesn't 'seem' to do anything after I ran it.

The routine finishes, but none of my sheet numbers change.

[hmsilva]

---

@zph wrote:
Thank you for your response, Henrique.

However, the routine doesn't 'seem' to do anything after I ran it.

The routine finishes, but none of my sheet numbers change.

---

You're welcome, zph!
????

Could you please attach a sample dwg?

Henrique

[devitg]

Thanks HMSILVA 

[zph]

Sure, here you go.

[hmsilva]

It should work as expected...

Try the attached one...

Hope this helps,
Henrique

[zph]

Well, it worked this time.

Would it be possible for you to make one alteration?

The 1st sheet and last sheet need to be X OF X and the sheets in the middle just X.

[hmsilva]

---

@zph wrote:
Well, it worked this time.

Would it be possible for you to make one alteration?

The 1st sheet and last sheet need to be X OF X and the sheets in the middle just X.

---

Attached revised code...

Hope this helps,
Henrique

[zph]

That is awesome and works lighting fast!

One more thing if you will, I'd like the portion below modified to be structured so the block names can be changed at the top of the routine.

(wcmatch (vla-get-effectivename blk) "_SP_TITLE_PAGE_08SEP15,_SP-Border2-F28X40_08SEP2015")

-changed to something like this-

(setq titlePage "_SP_TITLE_PAGE_08SEP15")
(setq nextPages "_SP-Border2-F28X40_08SEP2015")

(wcmatch (vla-get-effectivename blk) titlePage,nextPages)

[marko_ribar]

---

@zph wrote:

That is awesome and works lighting fast!

One more thing if you will, I'd like the portion below modified to be structured so the block names can be changed at the top of the routine.

(wcmatch (vla-get-effectivename blk) "_SP_TITLE_PAGE_08SEP15,_SP-Border2-F28X40_08SEP2015")

-changed to something like this-

(setq titlePage "_SP_TITLE_PAGE_08SEP15")
(setq nextPages "_SP-Border2-F28X40_08SEP2015")

(wcmatch (vla-get-effectivename blk) titlePage,nextPages)

---

Use setqing like you wrote at the beginning of routine and then in the code replace (wcmatch) line with :

(wcmatch (vla-get-effectivename blk) (strcat titlePage "," nextPages))

Don't forget to localize titlePage and nextPages variables in defun of main routine...

M.R.

[hmsilva · Accepted solution]

---

@zph wrote:

That is awesome and works lighting fast!

One more thing if you will, I'd like the portion below modified to be structured so the block names can be changed at the top of the routine.

(wcmatch (vla-get-effectivename blk) "_SP_TITLE_PAGE_08SEP15,_SP-Border2-F28X40_08SEP2015")

-changed to something like this-

(setq titlePage "_SP_TITLE_PAGE_08SEP15")
(setq nextPages "_SP-Border2-F28X40_08SEP2015")

(wcmatch (vla-get-effectivename blk) titlePage,nextPages)

---

Revised, but untested...

Hope this helps,
Henrique

[zph]

Works perfectly and much better than before.

Thank you for your time and expertise, guys!

[hmsilva]

You're welcome, zph!
Glad I could help

Henrique