Help: Auto Number Layouts By i

homasa · 发表于 2022-7-5 17:28:23

Hello Again

I found this script that i wanna change because it does not work well when layouts are not "Layout 1", "Layout 2" , etc
even for example if i already have the layouts numbered but have to create another one or simply re-arrange them

copy

(alert "Use at command line to execute program:\n\n numlay")(defun c:numlay (/ i) (vl-load-com) (setq i 0) (foreach x (layoutlist)   (vla-put-name     (vla-item        (vla-get-layouts          (vla-get-activedocument (vlax-get-acad-object))        )        x     )              (strcat (itoa (setq i (1+ i))))     ) ) (princ))

I wanna it to :
1) Auto-number Layout using the sequence in which they really are
2) That autonumbering prefix an 0 before the number if it is

this last topic i tryied using this code without sucess ....

copy

(cond               ((and (> i 0) (< i 10))                (strcat "0" (itoa i))       )

thx in advanced

homasa · 发表于 2022-7-5 17:36:52

at least anyone can tell me what am i doing wrong here:

copy

(alert "Use at command line to execute program:\n\n cat")(defun c:cat (/ i) (vl-load-com) (setq i 0) (foreach x (layoutlist)   (vla-put-name     (vla-item        (vla-get-layouts          (vla-get-activedocument (vlax-get-acad-object))        )        x     )(strcat (itoa (setq i (1+ i))))(if (< (atoi i) 10)(setq i (strcat "0" i)))   ) ) (princ))

BIGAL · 发表于 2022-7-5 17:42:00

I think I have exactly what you want, credits to Lee mac & AlanJT

It changes a number of attributes on the title block one being the layout name as a sheet number including those less than 10

copy

; change the 410 to layout name;;-------------------=={ Parse Numbers }==--------------------;;;;                                                            ;;;;  Parses a list of numerical values from a supplied string. ;;;;------------------------------------------------------------;;;;  Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]       ;;;;------------------------------------------------------------;;;;  Arguments:                                                ;;;;  s - String to process                                     ;;;;------------------------------------------------------------;;;;  Returns:  List of numerical values found in string.       ;;;;------------------------------------------------------------;;(defun LM:ParseNumbers ( s ) (   (lambda ( l )     (read       (strcat "("         (vl-list->string           (mapcar             (function               (lambda ( a b c )                 (if                   (or                     (< 47 b 58)                     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))                     (and (= 46 b) (< 47 a 58) (< 47 c 58))                   )                   b 32                 )               )             )             (cons nil l) l (append (cdr l) (list nil))           )         )         ")"       )     )   )   (vl-string->list s) ));(defun ah:sheetupdate1 (ss1 lay plotabs tabname dwgname)(defun ah:sheetupdate1 ()(setq doc (vla-get-activedocument (vlax-get-acad-object)))(vlax-for lay (vla-get-Layouts doc) (setq plotabs (cons (vla-get-name lay) plotabs)))(setq title "Please enter dwg number")(setq width "   edit_width = 12;")(setq limit "     edit_limit = 9;")(ah:getval title width limit)(setq dwgname item)(setq title "Please enter version for all sheets  no change")(setq width "   edit_width = 8;")(setq limit "     edit_limit = 5;")(ah:getval title width limit)  (setq newstr4 item)(princ "0")(setq len (length plotabs))(setq x 0)(setq bname "DA1DRTXT") ; block name is bname(repeat len (setq tabname (nth x plotabs)) (if (/= tabname "Model")   (progn     (setvar "ctab" tabname)     (setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname)(cons 410 tabname))))     (setq dwgnum (Lm:parsenumbers tabname))     (setq sheetnum (car dwgnum))     (setq oldtag1 "SHT_NO") ; attribute1 tag name     (setq newstr1 (rtos sheetnum 2 0))     (setq oldtag2 "DRG_NO") ;attribute2 tag name     (setq oldtag3 "PROJ_NO") ;attribute3 tag name     (setq newstr3 dwgname)     (setq oldtag4 "REV_NO") ;attribute4 tag name; if less than 10(if (< (car dwgnum) 10.0)      (setq newstr2 (strcat dwgname "-D0"  (rtos sheetnum 2 0)))     (setq newstr2 (strcat dwgname "-D"  (rtos sheetnum 2 0))))     (foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)       (if (= oldtag1 (strcase (vla-get-tagstring att)))       (vla-put-textstring att newstr1)        ) ; end if       (if (= oldtag2 (strcase (vla-get-tagstring att)))       (vla-put-textstring att newstr2)        ) ; end if       (if (= oldtag3 (strcase (vla-get-tagstring att)))       (vla-put-textstring att newstr3)        ) ; end if       (if (and (/= version nil) (= oldtag4 (strcase (vla-get-tagstring att))) )       (vla-put-textstring att newstr4)        ) ; end if       ) ; end foreach   ) ; end progn) ; end if(setq x (+ x 1))) ; end repeat(setq ss1 nil)  ) ; end defun ah(ah:sheetupdate1)(princ)

Getval.lsp load it first before lisp above

copy

;; Input  Dialog box with variable title;; By Ah June 2012;; code (ah:getval title);; Credits to AlanJT for original idea(defun AH:Getval (title width limit / fo)(setq fname "C://acadtemp//getval.dcl")(setq fo (open fname "w"))(write-line "ddgetval : dialog {" fo)(write-line " : row {" fo)(write-line ": edit_box {" fo)(write-line (strcat "    key = "  (chr 34) "sizze" (chr 34) ";") fo)(write-line  (strcat " label = "  (chr 34) title (chr 34) ";"  )   fo); these can be replaced with shorter value etc;(write-line "     edit_width = 18;" fo) ;(write-line "     edit_limit = 15;" fo)(write-line width fo) (write-line limit fo)(write-line "   is_enabled = true;" fo)        (write-line "    }" fo)(write-line "  }" fo)(write-line "ok_cancel;}" fo)(close fo)(setq dcl_id (load_dialog  "c:\\acadtemp\\getval"))(if (not (new_dialog "ddgetval" dcl_id))(exit))(action_tile "sizze" "(setq item  $value)(done_dialog)")(mode_tile "sizze" 3)(start_dialog); returns the value of item)

homasa · 发表于 2022-7-5 17:46:20

Hey Bigal thx for the answer

well i try to run it in the order like you said and it gives me an ; error: bad argument type: streamp nil

Just a note: i do not have a title block so i only need to number / re-number layouts in the order they are when i run the lisp.
my lisp above do it but i do not know why it doesn't respect order unless they are labeled "Layout 1", "Layout 2", etc...

regards

irneb · 发表于 2022-7-5 17:49:49

You mean something like this?

copy

(defun vlax-collection->list (col / lst) (vlax-for item col (setq lst (cons item lst))) (reverse lst))(defun c:LayoutRenum  (/ layouts n name digits) (vl-load-com) (setq n       0       digits  2       layouts (vl-remove-if                 '(lambda (lay) (= (vla-get-ModelType lay) :vlax-true))                 (vlax-collection->list (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)))))) (foreach lay layouts (vla-put-Name lay (vla-get-Handle lay))) (foreach lay  (vl-sort layouts '(lambda (a b) (apply '< (mapcar 'vla-get-Taborder (list a b)))))   (setq name (itoa (setq n (1+ n))))   (repeat (- digits (strlen name)) (setq name (strcat "0" name)))   (vla-put-Name lay name)) (princ))

Edit: You need to sort the list because both vla-get-Layouts and layoutlist gets in creation order. If you rearranged the tabs after you created them, the taborder property is the only one which allows you to get to their "displayed order".

homasa · 发表于 2022-7-5 17:55:21

Hello irneb

thx for your answer, and yes that's exactly what i was looking for.
TTTHHHHHXXXXXX so MMMMMUUUUCCCHHH both.

By the way irneb can you please explain me why the other one didnt respected layout order ??? (i am starting at lisp)

best regards to both

homasa · 发表于 2022-7-5 17:58:25

oh oh didn't saw

well thats the answer

Thx again very much for your help

king regards

irneb · 发表于 2022-7-5 18:03:56

And actually seeing as you always number from 1, you need not do the sorting idea either. Just use the TabOrder number as the new name:

copy

(defun c:LayoutRenum (/ layouts digits name) (vl-load-com) (setq digits 2       layouts (vl-remove-if '(lambda (lay) (= (vla-get-ModelType lay) :vlax-true))                 (vlax-collection->list (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)))))) (vlax-for lay layouts (vla-put-Name lay (vla-get-Handle lay))) (vlax-for lay layouts   (setq name (itoa (vla-get-TabOrder lay)))   (repeat (- digits (strlen name)) (setq name (strcat "0" name)))   (vla-put-Name lay name)))

Notice also that I first name the tab to its Handle string, and then to its new number. This is to try an prevent a situation where a duplicate name happens - which would cause the routine to error and not rename correctly.

homasa · 发表于 2022-7-5 18:08:45

always learning

Lee Mac · 发表于 2022-7-5 18:14:34

That looks like it will error as 'layouts' is a list, not a collection (I'm sure you knew this already). But I think the 'vlax-collection->list' and 'vl-remove-if' expressions are unnecessary loops:

copy

(defun c:layoutrenum ( / l n )   (vlax-for x (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))       (if (= :vlax-false (vla-get-modeltype x))           (progn               (vla-put-name x (vla-get-handle x))               (setq l (cons x l))           )       )   )   (foreach x l       (setq n (itoa (vla-get-taborder x)))       (repeat (- 2 (strlen n)) (setq n (strcat "0" n)))       (vla-put-name x n)   )   (princ))(vl-load-com) (princ)

Good idea Irné

[编程交流] Help: Auto Number Layouts By i

发表回复

精选推荐