Add to the code the ability to create layouts for non-standard formats

[Nikon]

Hello everyone! There is a wonderful lisp AddLay.LSP. I've been using it for a few years now. 
It creates layouts standard A1, A2, and A3 formats...

Can anyone add to this code the ability to create layouts for non-standard formats (A4x3, A4x4, A3x3, A3x4, A2x3, A2x4...). 
So far, no one has been able to implement this. I would be very grateful. 
The code creates viewports for non-standard formats, but the formats need to be set manually.

The code works with polyline frames and dynamic frame blocks.
In the file dwg shows that a viewport is being created for a non-standard format, but the format is not being set.

List of non-standard formats:

  _A4x3_(297.00_x_630.00_MM)
  _A4x4_(297.00_x_841.00_MM)
  _A4x5_(297.00_x_1051.00_MM)

  _A3x3_(420.00_x_891.00_MM)
  _A3x4_(420.00_x_1189.00_MM)
  _A3x5_(420.00_x_1486.00_MM)

  _A2x3_(594.00_x_1261.00_MM)
  _A2x4_(594.00_x_1682.00_MM)
  _A2x5_(594.00_x_2102.00_MM)

 

;;; AddLayEn / Original AddLay Author: Andrey_13 / 08.2015 /
;;; Translation to English: 03.2025
;;; Creation of Layouts and Viewports based on frames in Model Space

(defun C:AL (/
		 ActiveDocument
		 Application
		 Display
		 DeleteLayouts
		 FirstSheet
		 Flag
		 Formats
		 i
		 j
		 Layout
		 Layouts
		 Layer
		 ModelSpace
		 NumberFormats
		 PaperSpace
		 Points
		 MatchSheet
		 MinPoint
		 MaxPoint
		 NoMatchSheet
		 Object
		 Point1
		 Point2
		 Point1x
		 Point1y
		 Point2x
		 Point2y
		 Scale
		 Square
		 ViewportHeight
		 ViewportWidth
		 Viewport
		 X
		 Y
		 )
  (vl-load-com) ; Load ActiveX functions
  (setvar "CTAB" "Model") ; Switch to Model tab
  (initget 6) 
  (setq Application (vlax-get-acad-object) ; Application object
	ActiveDocument (vla-get-ActiveDocument Application) ; Active document object
	ModelSpace (vla-get-ModelSpace ActiveDocument) ; Model space pointer
	Layouts (vla-get-Layouts ActiveDocument) ; Layouts collection
	Display (vla-get-Display (vla-get-Preferences Application)) ; Display preferences
	)

  ;;; Prompt for the layer containing frames by selecting an object
  (while (null Object)
    (setq Object (car (entsel "
Select an object to define the frames layer: ")))
    )
  (setq Layer (cdr (assoc 8 (entget Object))) ; Determine layer name
	Formats (ssget (list (cons 8 Layer))) ; Select all objects on that layer
	NumberFormats (sslength Formats) ; Count number of frames
	Scale (getreal "
Enter scale 1:<1>: ") ; Request scale
	i 0
	Points ()
	)
  (if (not Scale) (setq Scale 1))

  (repeat NumberFormats
    (setq Format (vlax-ename->vla-object (ssname Formats i)))
    (if
      (and (= (vla-get-ObjectName Format) "AcDbBlockReference") (= (vla-get-IsDynamicBlock Format) :vlax-true)) ; Check if dynamic block
      (progn
	(setq Points (append Points (list (GetBoundingBox_dynblock (vlax-vla-object->ename Format))))) ; Get points for dynamic block
	(setq i (1+ i))
	)
      (progn
	(vla-GetBoundingBox Format 'MinPoint 'MaxPoint) ; Get points for regular object
	(setq
	  Points (append Points (list (list (vlax-safearray->list MinPoint) (vlax-safearray->list MaxPoint))))
	  i (1+ i)
	  )
	)
      )
    )

  ;;; Determine sorting order for the points
  (setq i 0)
  (repeat (length Points) ; Build lists of X and Y coordinates
    (setq X (append X (list (caar (nth i Points)))))
    (setq Y (append Y (list (cadar (nth i Points)))))
    (setq i (1+ i))
    )
  (if
    (> (- (MaxElement X) (MinElement X)) (- (MaxElement Y) (MinElement Y))) ; Decide sorting axis
    (setq Points (vl-sort Points (function (lambda (P1 P2) (< (caar P1) (caar P2)))))) ; Sort by X
    (setq Points (vl-sort Points (function (lambda (P1 P2) (> (cadar P1) (cadar P2)))))) ; Sort by Y
    )

  ;;; Disable automatic viewport creation on new layouts
  (if
    (= (vla-get-LayoutCreateViewport Display) :vlax-true)
    (progn
      (vla-put-LayoutCreateViewport Display :vlax-false)
      (setq Flag T)
      )
    )

  ;;; Layout management
  (initget 1 "Yes No")
  (setq DeleteLayouts (getkword "
Delete existing layouts? [Yes/No]: "))
  (cond
    (
     (= DeleteLayouts "Yes")
     ;;; Delete all layouts except Model
     (vlax-for Layout Layouts
       (if
	 (/= (vla-get-Name Layout) "Model")
	 (vla-delete Layout)
	 )
       )
     (initget 6)
     (setq FirstSheet (getint "
Starting sheet number: "))
     (vla-put-Name (vla-Item Layouts 1) (itoa FirstSheet)) ; Rename the default remaining layout
     )    
    ;;; Handle existing layouts if not deleting
    (
     (= DeleteLayouts "No")
     (while (= NoMatchSheet nil)
       (progn
	 (initget 6)
	 (setq
	   i 0
	   FirstSheet (getint "
Starting sheet number: ")
	   MatchSheet nil
	   )
	 (repeat NumberFormats
	   (if
	     (not (null (member (itoa (+ FirstSheet i)) (layoutlist))))
	     (setq MatchSheet T)
	     )
	   (setq i (1+ i))
	   )
	 (if
	   (= MatchSheet T)
	   (alert "Error: Layout names already exist!")
	   (setq NoMatchSheet T)
	   )
	 )
       )
     )
    )

  ;;; Insert new layouts and create viewports
  (setq i 0 j 0)
  (repeat NumberFormats
    (cond
      ;;; Workflow if layouts were deleted
      (
       (= DeleteLayouts "Yes")
       (if
	 (= i 0)
	 (progn
	   (setq Layout (vla-item Layouts 0))
	   (setvar "CTAB" (itoa FirstSheet))
	   )
	 (progn
	   (setq Layout (vla-Add Layouts (itoa (+ FirstSheet i))))
	   (setvar "CTAB" (itoa (+ FirstSheet i)))
	   )
	 )
       )
      ;;; Workflow if adding to existing layouts
      (
       (= DeleteLayouts "No")
       (progn
	 (setq Layout (vla-Add Layouts (itoa (+ FirstSheet i))))
	 (setvar "CTAB" (itoa (+ FirstSheet i)))
	 )
       )
      )

    ;;; Viewport creation logic
    (setq Point1 (car (nth j Points))
	  Point2 (cadr (nth j Points))
	  PaperSpace (vla-get-paperspace ActiveDocument)
	  Point1x (car Point1)
	  Point1y (cadr Point1)
	  Point2x (car Point2)
	  Point2y (cadr Point2)
	  ViewportHeight (/ (abs (- Point1y Point2y)) Scale)
	  ViewportWidth (/ (abs (- Point1x Point2x)) Scale)
	  Viewport (vla-AddPViewport PaperSpace (vlax-3d-point (list (/ ViewportWidth 2) (/ ViewportHeight 2))) ViewportWidth ViewportHeight))
    
    (vla-display Viewport :vlax-true)
    (vla-put-mspace ActiveDocument :vlax-true) ; Activate model space inside viewport
    (vla-zoomcenter Application (vlax-3d-point (list (/ (+ Point1x Point2x) 2) (/ (+ Point1y Point2y) 2))) 1.0)
    (vla-put-mspace ActiveDocument :vlax-false) ; Deactivate model space
    (vla-put-standardscale Viewport acVpCustomScale)
    (vla-put-CustomScale Viewport (/ 1.0 Scale))
    (vla-put-DisplayLocked Viewport :vlax-true) ; Lock viewport

    ;;; Page Setup
    (vla-put-StyleSheet Layout "monochrome.ctb")
    (vla-put-PlotType Layout 5) ; Set plot area to "Layout"

    ;;; Determine Paper Size based on viewport area (Square)
    (setq Square (* ViewportHeight ViewportWidth))
    (cond
      ((and (> Square 59251) (< Square 65488)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A4_(297.00_x_210.00_MM)"))
      ((and (> Square 118503) (< Square 130977)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A3_(420.00_x_297.00_MM)"))
      ((and (> Square 237006) (< Square 261954)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A2_(594.00_x_420.00_MM)"))
      ((and (> Square 474012) (< Square 523908)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A1_(841.00_x_594.00_MM)"))
      ((and (> Square 948024) (< Square 1047816)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A0_(841.00_x_1189.00_MM)"))
      (T (vla-put-ConfigName Layout "None")) ; Default to No plotter for non-standard sizes
      )
    
    (if (> ViewportHeight ViewportWidth) (vla-put-PlotRotation Layout 1) (vla-put-PlotRotation Layout 0)) ; Orientation
    (command "_Zoom" "_All")
    (setq i (1+ i) j (1+ j))
    )

  ;;; Restore "Automatic Viewport Creation" setting if it was originally ON
  (if (= Flag T) (vla-put-LayoutCreateViewport Display :vlax-true))
  (setvar "CTAB" "Model") ; Return to Model tab
  (princ "
Creation of layouts completed.")
  (princ)
  )

;;; Find minimum element in list
(defun MinElement (X /) (car (vl-sort X '<)))

;;; Find maximum element in list
(defun MaxElement (X /) (car (vl-sort X '>)))

;;; Get correct Bounding Box for Dynamic Blocks
(defun GetBoundingBox_dynblock (ent / lst ins_pt min_point max_point 3d_polarp)
  (if
    (and (or ent
	     (= (type (setq ent (vl-catch-all-apply (function (lambda () (car (entsel "
Select Dynamic Block: "))))))) 'ename)
	     )
	 (setq ent (vlax-ename->vla-object ent))
	 (vlax-property-available-p ent 'isdynamicblock)
	 (equal (vla-get-isdynamicblock ent) :vlax-true)
	 )
    (progn
      (vlax-for item
		(vla-item
		  (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
		  (vla-get-name ent)
		  )
		(if (equal (vla-get-visible item) :vlax-true)
		  (setq lst (cons item lst))
		  )
		)
      (setq
	ins_pt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint ent)))
	lst (vl-remove nil
		       (mapcar
			 '(lambda (x / minp maxp)
			    (if (not (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (vla-getboundingbox x 'minp 'maxp))))))
			      (list (cons "min" (vlax-safearray->list minp)) (cons "max" (vlax-safearray->list maxp)))
			      )
			    )
			 lst
			 )
		       )
	lst (mapcar
	      '(lambda (mins)
		 (mapcar
		   '(lambda (fun)
		      (apply (read mins)
			     (mapcar (function fun)
				     (mapcar '(lambda (pts) (cdr (assoc mins pts))) lst)
				     )
			     )
		      )
		   (list car cadr caddr)
		   )
		 )
	      (list "min" "max")
	      )
	lst (mapcar
	      '(lambda (ept)
		 (mapcar
		   '(lambda (coord_pt coord_line coord_ins)
		      (+ (* coord_pt ((eval (read (strcat "vla-get-" coord_line "EffectiveScaleFactor"))) ent)) coord_ins)
		      )
		   ept
		   '("X" "Y" "Z")
		   ins_pt
		   )
		 )
	      lst
	      )
	)
      )
    )
  )

 

AL.dwg     

Edited 1 hour ago by Nikon