Create Layouts from Selected Polylines

Create Layouts from Selected Polylines

majdoviyed25
Explorer Explorer
527 Views
10 Replies
Message 1 of 11

Create Layouts from Selected Polylines

majdoviyed25
Explorer
Explorer

Hello 

a LISP routine that create a new layout for each selected polyline (rectangle) in model space, and places a viewport zoomed to fit each polyline inside that layout:

  • select multiple polylines in model space
  • For each selected polyline:

                    A new layout is created.

                    A viewport is inserted and zoomed to fit that polyline.

                    The layout is named PolyLayout1, PolyLayout2, etc.

0 Likes
Accepted solutions (1)
528 Views
10 Replies
Replies (10)
Message 2 of 11

Sea-Haven
Mentor
Mentor

Like this. Three versions, walk along a pline, make layouts by placement, pick a point and scale.

 

SeaHaven_0-1749085541473.png

 

Not free but cheap as I normally have to edit the code to suit the end users title blocks and scales.

 

Have made 44 layouts in one go.

0 Likes
Message 3 of 11

majdoviyed25
Explorer
Explorer

This lisp is created by ChatGPT but one layout is created includ all object zoom all for model 

 

 

(defun c:PolyLayouts ( / ss i ent entObj minPt maxPt layoutName vpCenter vpWidth vpHeight paperWidth paperHeight doc layouts layoutObj block vpObj)

(vl-load-com)

;; Helper functions
(defun vlax-2d-point (lst)
(vlax-make-safearray vlax-vbDouble '(0 . 1))
(setq pt (vlax-make-safearray vlax-vbDouble '(0 . 1)))
(vlax-safearray-fill pt (list (car lst) (cadr lst)))
pt
)

(defun vlax-3d-point (lst)
(vlax-make-safearray vlax-vbDouble '(0 . 2))
(setq pt (vlax-make-safearray vlax-vbDouble '(0 . 2)))
(vlax-safearray-fill pt lst)
pt
)

;; Select polylines
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(if (not ss)
(progn (princ "\nNo polylines selected.") (exit))
)

(setq i 0)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq layouts (vla-get-Layouts doc))

(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq entObj (vlax-ename->vla-object ent))

;; Get bounding box
(vla-GetBoundingBox entObj 'minPt 'maxPt)
(setq minPt (vlax-safearray->list minPt))
(setq maxPt (vlax-safearray->list maxPt))

;; Calculate center and size
(setq vpCenter (mapcar '(lambda (a b) (/ (+ a b) 2.0)) minPt maxPt))
(setq vpWidth (* (- (car maxPt) (car minPt)) 1.1)) ; 10% margin
(setq vpHeight (* (- (cadr maxPt) (cadr minPt)) 1.1))

;; Create new layout
(setq layoutName (strcat "PolyLayout" (itoa (1+ i))))
(command "._layout" "new" layoutName)
(setvar 'ctab layoutName)

;; Get layout and block
(setq layoutObj (vla-Item layouts layoutName))
(setq block (vla-get-Block layoutObj))

;; Create viewport in center of paper
(setq paperWidth 420.0) ; A3 in mm
(setq paperHeight 297.0)

(setq vpObj (vla-AddPViewport block (vlax-3d-point (list (/ paperWidth 2.0) (/ paperHeight 2.0) 0)) vpWidth vpHeight))

;; Configure viewport
(vla-put-DisplayLocked vpObj :vlax-false)
(vla-put-Visible vpObj :vlax-true)
(vla-put-MViewCenter vpObj (vlax-2d-point vpCenter))
(vla-put-Width vpObj vpWidth)
(vla-put-Height vpObj vpHeight)
(vla-put-DisplayLocked vpObj :vlax-true)

(vla-put-Target vpObj (vlax-3d-point '(0 0 0)))
(vla-put-Direction vpObj (vlax-3d-point '(0 0 1)))

(setq i (1+ i))
)

(princ "\n Layouts created, each showing only one polyline.")
(princ)
)

0 Likes
Message 4 of 11

paullimapa
Mentor
Mentor
Accepted solution

Yet another case where ChatGPT fails miserably

1. Function vlax-3d-point already exists so no need to define

; vlax-3d-point function already exists so no need
;(defun vlax-3d-point (lst)
;(vlax-make-safearray vlax-vbDouble '(0 . 2))
;(setq pt (vlax-make-safearray vlax-vbDouble '(0 . 2)))
;(vlax-safearray-fill pt lst)
;pt
;)

2. Using BoundingBox function on selected Plines to determine vport width and height does not work since these are model dimensions which would be too large to fit on A3 size in Paperspace

; (setq entObj (vlax-ename->vla-object ent))
;; Get bounding box
; (vla-GetBoundingBox entObj 'minPt 'maxPt)
; (setq minPt (vlax-safearray->list minPt))
; (setq maxPt (vlax-safearray->list maxPt))

;; Calculate center and size
; (setq vpCenter (mapcar '(lambda (a b) (/ (+ a b) 2.0)) minPt maxPt))
; 
;(setq vpWidth (* (- (car maxPt) (car minPt)) 1.1)) ; 10% margin
;(setq vpHeight (* (- (cadr maxPt) (cadr minPt)) 1.1))

3. When creating a new Layout need to delete Vport if created based on current Option settings

paullimapa_0-1749164010536.png

;; Create new layout
(setq layoutName (strcat "PolyLayout" (itoa (1+ i))))
(command "_.Layout" "_New" layoutName)
(setvar 'ctab layoutName)

; chk if vports
(setq ssvp (ssget "_X" (list '(0 . "VIEWPORT") (cons 410 (getvar "ctab"))))
      j 0
)
; chk if there's a vport 
(if (> (sslength ssvp) 1) 
  ; then delete vport
  (repeat (sslength ssvp)(entdel (ssname ssvp j))(setq j (1+ j)))
)

4. Need to set paper size to A3 on new Layout:

; setup A3 layout 
(command "_.-PAGESETUP" "DWG TO PDF.pc3" "ISO full bleed A3 (420.00 x 297.00 MM)" "_M" "_Landscape" "_No" "_Layout" "1:1" "0,0" "_Yes" "." "_Yes" "_No" "_No" "_No")  
;

5. Use 10% margin for Vport width & height based on A3 paper size

;; Create viewport in center of paper
(setq paperWidth 420.0) ; A3 in mm
(setq paperHeight 297.0)

; set vport size based on A3 
(setq vpWidth (* paperWidth 0.90)) ; 10% margin
(setq vpHeight (* paperHeight 0.90))
;

6. Zoom out to see entire A3 size sheet and turn on Vport:

; zoom out  
(command "_.Zoom" "_E")  

;; Configure viewport
(vla-put-DisplayLocked vpObj :vlax-false)
(vla-put-Visible vpObj :vlax-true)

; Need to turn on vport
(vla-put-ViewportOn vpObj :vlax-true)
;

7a. MViewCenter property does not exist on Vports:

VLA-PUT-MVIEWCENTER  should be VLA-PUT-CENTER 

7b. Vport's Center property expects a 3d array point and not 2d

 

; no such property as MViewCenter
;(vla-put-MViewCenter vpObj (vlax-2d-point vpCenter))
; needs to be a 3d point 
;(vla-put-Center vpObj (vlax-3d-point vpCenter)) 
; 
; using these sizes will get giant vport
;(vla-put-Width vpObj vpWidth)
;(vla-put-Height vpObj vpHeight)
  
; (vla-put-DisplayLocked vpObj :vlax-true) ; move this down below
; no need to do this
;(vla-put-Target vpObj (vlax-3d-point '(0 0 0)))
;(vla-put-Direction vpObj (vlax-3d-point '(0 0 1)))

 

8. Use the following method to create a Vport matching Pline:

 

; vport mspace zoom to location of pline
(command "_.MSPACE") ; go inside vport
(command "_.ZOOM" "_OB" ent "") ; zoom to pline obj
(command "_.Copy" ent "" "0,0,0" "@")
(command "_.Chspace" (entlast) "") ; make a copy of the pline and change it from mspace to pspace
(command "_.PSPACE") ; go back outside vport
(entdel (vlax-vla-object->ename vpobj)) ; delete the original vport
(command "_.Mview" "_Ob" (entlast)) ; create vport based on pline boundary
(setq vpObj (vlax-ename->vla-object (entlast))) ; convert new vport to vl obj
(command "_.MSPACE") ; go inside vport
(command "_.ZOOM" "_OB" ent "") ; zoom to pline obj
(command "_.PSPACE") ; go back outside vport

 

9. Now ready to lock Vport display:

; now lock display
(vla-put-DisplayLocked vpObj :vlax-true)

I also add at the beginning and end of code to make sure to start in Model tab:

 

; Make sure to start in Model tab
(setvar "tilemode" 1)
;
; return back to Model tab
(setvar "tilemode" 1) 
;

 

 


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 5 of 11

Sea-Haven
Mentor
Mentor

In the walk along p/line make layouts also creates the mview with correct orientation, the code uses the size available for the mview and sets correct scale. In this image the view is rotated to suit each rectang orientation. So the road in this case appears approx  horizontal.

 

SeaHaven_0-1749168144791.png

When I say cheap I am talking about the price of a coffee.

 

There are others here who also have done make layouts. Not sure if free or not.

 

last comment Chatgp & Copilot are still learning how to write code.

0 Likes
Message 6 of 11

sigmmadesigner
Advocate
Advocate

The DCL of this file was great

0 Likes
Message 7 of 11

sigmmadesigner
Advocate
Advocate

https://www.cadtutor.net/forum/topic/76216-create-layout-from-a-grid-in-model-space/#findComment-666...

 

This is the best programming in relation to placing each rectangle in layout and numbering each layout
But it still cannot rotate the sheets in the model to be parallel to the viewport, and adjust to the scale of the project, but it is still the best programming 50% of the heavy work done successfully!!!


;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-first-layout-multiple-times-and...;;;
(defun c:vpfrectngl-multi (/ trap1 olderr baselay tablist layname cnt entrec objrec a b nn adoc curpos curtab lytname lytcnt i n)

(defun trap1 (errmsg)
(setq *error* olderr); restore *error* symbol
(princ)

)

(setq olderr *error*); assign current function defintion held by the *error* symbol to a local variable - olderr
(setq *error* trap1); pointing the *error* symbol to new function definition - trap1


(if (= (getvar "tilemode") 0);if1 in layout
(progn;progn-1
(setq baselay (getvar 'ctab));;store base layout
(setvar "tilemode" 1);;move to mode space

(if (setq ssrect (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))));;;;;;;;;;if2
(progn ;progn-2
(setq n (sslength ssrect))
(setvar 'ctab baselay);;back to base layout
(and (= 0 (getvar 'tilemode))
(setq i (getint "\nEnter begining integer for suffix: "))
(setq curtab (getvar 'ctab))
(repeat n
(setq lytcnt 1)
(setq lytname (strcat curtab "." (itoa (+ (1- n) i))))

(while (member lytname (layoutlist));while-1 if layout tab name exist add 1 to suffix until it is a new name
(setq lytname (strcat curtab "." (itoa (+ (1- n) (+ i lytcnt)))))
(setq lytcnt (1+ lytcnt))
);while-1

(command "._layout" "_copy" "" lytname) ;(strcat curtab "." (itoa (+ (1- n) i))));;create new layout tab
(setq tablist (cons lytname tablist)) ;(strcat curtab "." (itoa (+ (1- n) i)))
(setvar 'ctab (strcat curtab "." (itoa (+ (1- n) i)))) ;(strcat curtab "." (itoa (+ (1- n) i))));move to new layout tab
(setq i (1- i))
);repeat
);and
);end progn-2
);;;;;;;;;;end if-2


(setq nn (sslength ssrect))
(setq cnt (- (sslength ssrect) 1))
(repeat nn
(setq layname (nth cnt tablist))
(setvar 'ctab layname)
;;;;;;;;;;;;;;;;by Steven P https://www.cadtutor.net/forum/topic/76216-create-layout-from-a-grid-in-model-space/;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;create viewport from rectangle in current layout;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (setq entrec (ssname ssrect cnt));get rectangle ename
(progn
(setq objrec (vlax-ename->vla-object entrec));Transforms entrec to a VLA-object
(vlax-invoke-method objrec 'GetBoundingBox 'a 'b); get max and min points of the rectangle as safe array
(setq a (vlax-safearray->list a));convert a from safe array to list
(setq b (vlax-safearray->list b));convert b from safe array to list
(command "mspace")
(vl-cmdf "_.zoom" a b)
(command "pspace")
);progn
(alert "no ent")
);if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq cnt (1- cnt))
(setvar "tilemode" 0)
);repeat
);end progn-1
(alert "NOT IN PAPER SPACE")
);end if1

;(princ tablist)
(TabSort)
(setq *error* olderr); restore *error* symbol
(princ)
);defun


;;;;https://www.cadtutor.net/forum/topic/10087-re-ordering-layout-tabs/;;;;;
;; ---------------------------------------------------------------------------
;; Function: tabsort
;; Purpose : sort Tabs by the prefix then the first numbers found
;; AUTHOR Charles Alan Butler @ TheSwamp.org

;; ---------------------------------------------------------------------------

;; Last Update 03/01/2006 CAB
(defun TabSort (/ cnt doc lay)
(vl-load-com)

;; ---------------------------------------------------------------------------
;; Function: Num_sort
;; Purpose : sort list of strings by the prefix then the first numbers found
;; AUTHOR Charles Alan Butler @ TheSwamp.org
;; Params : tablst: list of strings to sort
;; Returns : sorted list
;; ---------------------------------------------------------------------------
(defun Num_Sort (tablst / tab ptr len loop tmp tmp2 sub lst)

(defun vl-sort-it (lst func)
(mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst func))

)

(defun sort2 (tmp2 sub)
(setq tmp2 (append
(vl-sort-it sub '(lambda (e1 e2) (< (cadr e1) (cadr e2))))
tmp2

)
)
)

;; convert to a list (string) -> (prefix num string)
(foreach tab tablst
(setq ptr 1
len (strlen tab)
loop t
)
(while loop
(cond
((wcmatch "0123456789" (strcat "*" (substr tab ptr 1) "*"))
(setq tmp (cons (list (substr tab 1 (1- ptr))
(atof (substr tab ptr))
tab
)
tmp
)
loop nil
)
)
((> (setq ptr (1+ ptr)) len)
;; no number in string
(setq tmp (cons (list tab nil tab) tmp)
loop nil
)
)
) ; end cond stmt

)
)

;; sort on the prefix
(setq tmp (vl-sort-it tmp '(lambda (e1 e2) (< (car e1) (car e2)))))

;; Do a number sort on each group of matching prefex
(setq idx (length tmp))
(while (> (setq idx (1- idx)) -1)
(cond
((not sub)
(setq sub (List (nth idx tmp))
str (car (nth idx tmp))
)
)
((= (car (nth idx tmp)) str) ; still in the group
(setq sub (cons (nth idx tmp) sub))
)
) ; end cond stmt

(if (= idx 0) ; fim da lista
(progn
(setq tmp2 (sort2 tmp2 sub))
(if (/= (car (enésimo idx tmp)) str)
(setq tmp2 (append (lista (enésimo idx tmp)) tmp2))
)(
setq str (car (nth idx tmp)))

)
)

(if (/= (car (enésimo idx tmp)) str)
;; próximo grupo, então ordene o grupo
anterior(setq tmp2 (sort2 tmp2 sub)
sub (list (enésimo idx tmp))
str (carro (enésimo idx tmp))
))

) ; end while
(setq lst (mapcar 'caddr tmp2))(
princ)
lst
) ; terminar defun

;;==========================================================================

(setq cnt 1
doc (vla-get-activedocument (vlax-get-acad-object))
)
(foreach lay (num_sort (vl-remove "Model" (layoutlist)))(
vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
(setq cnt (1+ cnt))
)(
princ)
) ; fim da defunção
;; (prompt "\nTabSort carregado, digite TabSort para executar.")
(princípio)

 

0 Likes
Message 8 of 11

aridzv
Enthusiast
Enthusiast

@sigmmadesigner 

 

Hi.

See if This Code helps:

;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-first-layout-multiple-times-and-number-incrementally/td-p/7030955;;;
;;;;https://www.cadtutor.net/forum/topic/76216-create-layout-from-a-grid-in-model-space/?_fromLogin=1&_fromLogout=1;;;;
(defun c:vpfrectngl-multitwist_old (/ trap1 olderr baselay tablist layname cnt entrec objrec a b nn adoc curpos curtab lytname lytcnt i n twa vp1 vp1name vp1ent h fac vpvlax)

(defun trap1 (errmsg)
  (setq *error* olderr); restore *error* symbol
  (princ)
)

(setq olderr *error*); assign current function defintion held by the *error* symbol to a local variable - olderr
(setq *error* trap1); pointing the *error* symbol to new function definition - trap1

(if (tblsearch "layer" "Layout_Frame");if-0
(progn ;progn-0 
(if (= (getvar "tilemode") 0);if1 in layout
 (progn;progn-1 
   (setq baselay (getvar 'ctab));;store base layout
   (setvar "tilemode" 1);;move to mode space

   (if (setq ssrect (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))));;(ssget '((0 . "LWPOLYLINE") (90 . 4) (8 . "Layout_Frame") (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>"))));;;;;;;;;;if2
    (progn ;progn-2
      (setq n (sslength ssrect))
      (setvar 'ctab baselay);;back to base layout
      (and (= 0 (getvar 'tilemode))
         (setq i (getint "\nEnter begining integer for suffix: "))
         (setq curtab (getvar 'ctab))
         (repeat n 
           (setq lytcnt 1)
           (setq lytname (strcat curtab "." (itoa (+ (1- n) i))))

             (while (member lytname (layoutlist));while-1 if layout tab name exist add 1 to suffix until it is a new name  
                 (setq lytname (strcat curtab "." (itoa (+ (1- n) (+ i lytcnt)))))
                 (setq lytcnt (1+ lytcnt))
             );while-1

              (command "._layout" "_copy" "" lytname) ;(strcat curtab "." (itoa (+ (1- n) i))));;create new layout tab
              (setq tablist (cons lytname tablist)) ;(strcat curtab "." (itoa (+ (1- n) i)))
              (setvar 'ctab (strcat curtab "." (itoa (+ (1- n) i)))) ;(strcat curtab "." (itoa (+ (1- n) i))));move to new layout tab
              (setq i (1- i))
         );repeat     
       );and
    );end progn-2
    (alert "''Layout_Frame'' is not The rectangles layer.\nSet the rectangles layer to ''Layout_Frame''")
   );;;;;;;;;;end if-2

 (if ssrect ;if-3
  (progn;progn-3 
   (setq nn (sslength ssrect))
   (setq cnt (- (sslength ssrect) 1))
   (repeat nn
     (setq layname (nth cnt tablist))
     (setvar 'ctab layname)
;;;;;;;;;;;;;;;;by Steven P https://www.cadtutor.net/forum/topic/76216-create-layout-from-a-grid-in-model-space/;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;create viewport from rectangle in current layout;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
           (if (setq entrec (ssname ssrect cnt));get rectangle ename
             (progn
               (command "mspace")
;;;;;;;;;;;;;;;;;;;;twist model space view;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
               (setq pt1 (vlax-curve-getPointAtParam entrec 0))
               (setq pt2 (vlax-curve-getPointAtParam entrec 1))
               (setq twa (angle pt1 pt2))
               
               ;(if (and (/= twa 0)(< twa pi))
               ;  (setq twa (+ twa pi))
               ;(if (and (/= twa 0)(> twa pi))
               ;    (setq twa (- twa pi))
               ;  )
               ;)

               (SETVAR "SNAPANG" twa)
               (setq twa (angtos twa (getvar 'aunits)))
               (setq twa (strcat "-" twa))
               (command "_.dview" "" "_tw" twa "")
;;;;;;;;;;;;;;;;;;;;twist model space view;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;set viewport BoundingBox frame ;;;;;;;;;;;;;;;;;;;;;;;;
               (setq objrec (vlax-ename->vla-object entrec));Transforms entrec to a VLA-object
               (vlax-invoke-method objrec 'GetBoundingBox 'a 'b); get max and min points of the rectangle as safe array
               (setq a (vlax-safearray->list a));convert a from safe array to list
               (setq b (vlax-safearray->list b));convert b from safe array to list
               (vl-cmdf "_.zoom" a b)
;;;;;;;;;;;;;;;;;;;;set viewport BoundingBox frame ;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;Apply Viewport scale ;;;;;;;;;;;;;;;;;;;;;;;;;
               (setq vp1 (ssget "X" (list '(0 . "VIEWPORT")(cons 410 (getvar 'ctab))(cons 69 2))));;;;get the layout viewports object selection set
               (setq vp1name (ssname vp1 0));;;get the first (and only...) viewport object name in the current layout
               (setq vp1ent (entget vp1name));;;get the viewport entity data list
               (setq h (cdr(assoc 40 vp1ent)));;;get viewport width
               (setq fac (/ h (distance pt1 pt2)));;;get the scale factor by divide the viewport width by rectangle width  
               (setq vpvlax (vlax-ename->vla-object vp1name));;;Transforms vp1name to a VLA-object
               (vla-put-customscale vpvlax fac);;;apply the scale factor to the viewport
;;;;;;;;;;;;;;;;;;;;Apply Viewport scale ;;;;;;;;;;;;;;;;;;;;;;;;;
               (command "pspace")

               (if (TBLSEARCH "BLOCK" "COMPASS_SYMBOLE_2")
                 (command "_insert" "COMPASS_SYMBOLE_2" "0,0,0" "1" "1" twa)
               )
             );progn
             (alert "no ent")
           );if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (setq cnt (1- cnt)) 
     (setvar "tilemode" 0)  
   );repeat
  );end progn-3
 );end if-3
 );end progn-1 
 (alert "You are in model Space\ngo to the layout you want to use as the base layout")
)end if1
);end progn-0
(alert "Layer ''Layout_Frame'' does not exist.\nCreate this layer and make sure this is the rectangles layer.")
);end if-0
;(princ tablist)
(TabSort)
(setvar 'ctab baselay)
(setq *error* olderr); restore *error* symbol
(princ)
);defun 


;;;;https://www.cadtutor.net/forum/topic/10087-re-ordering-layout-tabs/;;;;;
;; --------------------------------------------------------------------------- 
;; Function: tabsort 
;; Purpose : sort Tabs by the prefix then the first numbers found 
;; AUTHOR  Charles Alan Butler @ TheSwamp.org
;; --------------------------------------------------------------------------- 

;; Last Update 03/01/2006  CAB
(defun TabSort (/ cnt doc lay)
 (vl-load-com)

 ;; --------------------------------------------------------------------------- 
 ;; Function: Num_sort 
 ;; Purpose : sort list of strings by the prefix then the first numbers found 
 ;; AUTHOR  Charles Alan Butler @ TheSwamp.org
 ;; Params  : tablst:    list of strings to sort
 ;; Returns : sorted list
 ;; --------------------------------------------------------------------------- 
 (defun Num_Sort (tablst / tab ptr len loop tmp tmp2 sub lst)

   (defun vl-sort-it (lst func)
     (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst func))
   )

   (defun sort2 (tmp2 sub)
     (setq tmp2 (append
                  (vl-sort-it sub '(lambda (e1 e2) (< (cadr e1) (cadr e2))))
                  tmp2
                )
     )
   )

   ;;  convert to a list (string) -> (prefix num string)
   (foreach tab tablst
     (setq ptr  1
           len  (strlen tab)
           loop t
     )
     (while loop
       (cond
         ((wcmatch "0123456789" (strcat "*" (substr tab ptr 1) "*"))
          (setq tmp  (cons (list (substr tab 1 (1- ptr))
                                 (atof (substr tab ptr))
                                 tab
                           )
                           tmp
                     )
                loop nil
          )
         )
         ((> (setq ptr (1+ ptr)) len)
          ;;  no number in string
          (setq tmp  (cons (list tab nil tab) tmp)
                loop nil
          )
         )
       )                     ; end cond stmt
     )
   )

   ;;  sort on the prefix
   (setq tmp (vl-sort-it tmp '(lambda (e1 e2) (< (car e1) (car e2)))))

   ;; Do a number sort on each group of matching prefex
   (setq idx (length tmp))
   (while (> (setq idx (1- idx)) -1)
     (cond
       ((not sub)
        (setq sub (List (nth idx tmp))
              str (car (nth idx tmp))
        )
       )
       ((= (car (nth idx tmp)) str) ; still in the group
        (setq sub (cons (nth idx tmp) sub))
       )
     )                       ; end cond stmt

     (if (= idx 0)           ; end of list
       (progn
         (setq tmp2 (sort2 tmp2 sub))
         (if (/= (car (nth idx tmp)) str)
           (setq tmp2 (append (list (nth idx tmp)) tmp2))
         )
         (setq str (car (nth idx tmp)))
       )
     )

     (if (/= (car (nth idx tmp)) str)
       ;; next group, so sort previous group
       (setq tmp2 (sort2 tmp2 sub)
             sub  (list (nth idx tmp))
             str  (car (nth idx tmp))
       )
     )
   )                         ; end while
   (setq lst (mapcar 'caddr tmp2))
   (princ)
   lst
 )                           ; end defun
 ;;==========================================================================

 (setq cnt 1
       doc (vla-get-activedocument (vlax-get-acad-object))
 )
 (foreach lay (num_sort (vl-remove "Model" (layoutlist)))
   (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
   (setq cnt (1+ cnt))
 )
 (princ)
)                           ; end defun
;;(prompt "\nTabSort loaded, enter TabSort to run.")
(princ)
Message 9 of 11

sigmmadesigner
Advocate
Advocate

Wow, It Rotated Beautifully, It Is Possible To Create The Viewport The Size Of The Selected Rectangle, If That Is Possible, If So. The Program Will Be A Rocket

Message 10 of 11

aridzv
Enthusiast
Enthusiast

@sigmmadesigner 

glad it helped!!

 

actually,

you don't Create The Viewport to The Size Of The Selected Rectangle but the other way around:

 

draw a rectangle on the viewport,

copyclip it to model space and use it.

you can also scale this rectangle to known value.

the original is 1:1 and if you scale it by 5 it will be 1:5 etc'.

 

make sure you Draw the viewport and the rectangle from left to right.

This can be from top left to bottom right or bottom left to top right but must be left to right.

 

see attache video.

 

0 Likes
Message 11 of 11

Sea-Haven
Mentor
Mentor

I do the opposite of this, drawing the rectang based on desired dwg scale and the title block being used, which defines the mview size in a layout, matching the correct title block. See the image in post 2. As mentioned rectang's can be rotated and the viewport will reflect this rotation.

 

draw a rectangle on the viewport,

copyclip it to model space and use it.

you can also scale this rectangle to known value.

 

This movie is an example of making layouts. Its a specific version to make a single size layout. The result is 17 layouts. The flashing which normally does not happen it is to do with screen recording of the layouts being made. You can though see the rotation being done in each viewport.

SeaHaven_0-1749603326761.png

SeaHaven_1-1749603353027.png

 

 

 

 

0 Likes