;;-----------------------=={ Viewport Outline }==-----------------------;;
;;                                                                      ;;
;;  This program allows the user to automatically generate a polyline   ;;
;;  in modelspace representing the outline of a selected paperspace     ;;
;;  viewport.                                                           ;;
;;                                                                      ;;
;;  The command is only available in paperspace (that is, when a        ;;
;;  layout tab other than the Model tab is the current layout, and no   ;;
;;  viewports are active).                                              ;;
;;                                                                      ;;
;;  Upon issuing the command syntax 'VPO' at the AutoCAD command-line,  ;;
;;  the user is prompted to select a viewport for which to construct    ;;
;;  the viewport outline in modelspace.                                 ;;
;;                                                                      ;;
;;  Following a valid selection, the boundary of the selected viewport  ;;
;;  is transformed appropriately to account for the position, scale,    ;;
;;  rotation, & orientation of the modelspace view displayed through    ;;
;;  the selected viewport, and a 2D polyline (LWPolyline) representing  ;;
;;  this transformed boundary is constructed in modelspace.             ;;
;;                                                                      ;;
;;  The program is compatible for use with all Rectangular, Polygonal & ;;
;;  Clipped Viewports (including those with Arc segments), and with all ;;
;;  views & construction planes.                                        ;;
;;                                                                      ;;
;;  The program also offers the ability to optionally offset the        ;;
;;  polyline outline to the interior of the viewport boundary by a      ;;
;;  predetermined number of paperspace units specified in the           ;;
;;  'Program Parameters' section of the program source code.            ;;
;;                                                                      ;;
;;  The program may also be configured to automatically apply a         ;;
;;  predefined set of properties (e.g. layer, colour, linetype, etc.)   ;;
;;  to the resulting polyline outline - these properties are also       ;;
;;  listed within the 'Program Parameters' section of the source code.  ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2015  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2015-01-02                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2016-08-11                                      ;;
;;                                                                      ;;
;;  - Program modified to account for polygonal viewports represented   ;;
;;    by 2D (Heavy) Polylines.                                          ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2017-09-03                                      ;;
;;                                                                      ;;
;;  - Added the ability to specify an optional interior offset          ;;
;;    (relative to Paperspace Viewport dimensions).                     ;;
;;  - Added default polyline properties.                                ;;
;;----------------------------------------------------------------------;;
;;  Version 1.3    -    2019-08-12                                      ;;
;;                                                                      ;;
;;  - Restructured program as a main function accepting a viewport      ;;
;;    entity argument.                                                  ;;
;;  - Added two additional custom commands:                             ;;
;;    - 'vpol' - outlines all viewports in the active Paperspace layout ;;
;;    - 'vpoa' - outlines all viewports in all Paperspace layouts       ;;
;;----------------------------------------------------------------------;;





;;----------------------------------------------------------------------;;
;;  VPO - Outline a selected viewport in the active Paperspace layout   ;;
;;----------------------------------------------------------------------;;

(defun c:vpoout1_4 (/ *error* sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "T" "A" "T_FENETRE" "")
  )
  (command-s "-calque" "ch" "T_FENETRE" "")
  (defun *error* (msg)
    (lm:endundo (lm:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (lm:startundo (lm:acdoc))
  (cond ((/= 1 (getvar 'cvport)) (princ "\nCommand not available in Modelspace."))
        ((setq sel (lm:ssget "\nSelect viewport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
         (vpo:main (ssname sel 0))
        )
  )
  (lm:endundo (lm:acdoc))
  (setvar "clayer" cav)
  (princ)
)







;;----------------------------------------------------------------------;;
;;  VPO - Outline a selected viewport in the active Paperspace layout   ;;
;;----------------------------------------------------------------------;;

(defun c:vpoout1_4_fenetre_nommee (/ *error* sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (setq osm (getvar "osmode"))
;;;  (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
;;;  (setq txtech (atof (getcfg "APPDATA/TXTECH")))
  (setq techl 0.01) ; dessin en metre techl=1, en centimetre techl=0.01, millimetre techl=0.001
  (setq txtech 1)
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "T" "A" "T_FENETRE" "")
  )
  (command-s "-calque" "ch" "T_FENETRE" "")
  (defun *error* (msg)
    (lm:endundo (lm:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (lm:startundo (lm:acdoc))
  (cond ((/= 1 (getvar 'cvport)) (princ "\nCommand not available in Modelspace."))
        ((setq sel (lm:ssget "\nSelect viewport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
;;;         (setq test123 (ssname sel 0))
         (setq l12 nil
               nomfenetre1 nil
               nompresentation1 nil
         )
         (vpo:main1 (ssname sel 0))
        )
  )
  (lm:endundo (lm:acdoc))
  (setvar "osmode" 0)
  (command-s "espaceo")
  (setq toutpoint (gc:massoc 10 (entget (entlast))))
;;;-----------------------------------------------------------------------------------------------------
;;;Le code suivant trie la liste en fonction du 1ème élément puis (en cas d'égalité) en fonction du 2ème inverser
;;;-----------------------------------------------------------------------------------------------------
  (setq toutpoint (vl-sort toutpoint
                           '(lambda (a b)
                              (if (eq (car a) (car b))
                                (> (cadr a) (cadr b))
                                (< (car a) (car b))
                              )
                            )
                  )
  )
  (setq poi1 (car toutpoint))
;;;  (setq poi1 (car (gc:massoc 10 (entget (entlast)))))
  (if (= nomfenetre1 nil)
    (progn (command-s "TEXTE"
                      "st"
                      "arial"
                      "j"
                      "mg"
                      (strcat (rtos (+ (car poi1) 5) 2 8) "," (rtos (- (cadr poi1) 10) 2 8) ",0")
                      (rtos (/ (* 0.03 txtech) techl) 2 8)
                      ""
                      (strcat "%%U" nompresentation1)
           )
    )
    (progn (setq ech1 (/ 10 (vla-get-customscale (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname sel 0))))))))
           (if (= ech1 2.5)
             (setq echl10 (rtos ech1 2 1))
             (setq echl10 (rtos ech1 2 0))
           )
           (command-s "TEXTE"
                      "st"
                      "arial"
                      "j"
                      "mg"
                      (strcat (rtos (+ (car poi1) 5) 2 8) "," (rtos (- (cadr poi1) 5) 2 8) ",0")
                      (rtos (/ (* 0.03 txtech) techl) 2 8)
                      ""
                      (strcat "%%U" nomfenetre1 "   1/" echl10 " ième")
           )
           (command-s "TEXTE"
                      "st"
                      "arial"
                      "j"
                      "mg"
                      (strcat (rtos (+ (car poi1) 5) 2 8) "," (rtos (- (cadr poi1) 10) 2 8) ",0")
                      (rtos (/ (* 0.03 txtech) techl) 2 8)
                      ""
                      (strcat "%%U" nompresentation1)
           )
    )
  )
  (command-s "espacep")
  (setvar "clayer" cav)
  (setvar "osmode" osm)
  (princ)
)



;; Radian to degree
(defun f:rb-rtd (r) (/ (* r 180.0) pi))




;;----------------------------------------------------------------------;;
;;  VPO - Outline a selected viewport in the active Paperspace layout   ;;
;;----------------------------------------------------------------------;;

(defun c:vpoout1_4_fenetre_nommee_tournee (/ *error* sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (setq osm (getvar "osmode"))
;;;  (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
;;;  (setq txtech (atof (getcfg "APPDATA/TXTECH")))
  (setq techl 0.01) ; dessin en metre techl=1, en centimetre techl=0.01, millimetre techl=0.001
  (setq txtech 1)
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "T" "A" "T_FENETRE" "")
  )
  (command-s "-calque" "ch" "T_FENETRE" "")
  (defun *error* (msg)
    (lm:endundo (lm:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (lm:startundo (lm:acdoc))
  (cond ((/= 1 (getvar 'cvport)) (princ "\nCommand not available in Modelspace."))
        ((setq sel (lm:ssget "\nSelect viewport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
         (setq l12 nil
               nomfenetre1 nil
               nompresentation1 nil
         )
         (vpo:main1 (ssname sel 0))
        )
  )
  (lm:endundo (lm:acdoc))
  (setvar "osmode" 0)
  (command-s "espaceo")
  (setq toutpoint (gc:massoc 10 (entget (entlast))))
  (setq anglerota1 (* (vla-get-twistangle (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname sel 0))))))
                      (/ 180 pi)
                   )
  )
  (command-s "scu" "z" (- anglerota1))
  (setq toutpoint1 (mapcar '(lambda (x) (trans x 0 1)) toutpoint))
;;;-----------------------------------------------------------------------------------------------------
;;;Le code suivant trie la liste en fonction du 1ème élément puis (en cas d'égalité) en fonction du 2ème inverser
;;;-----------------------------------------------------------------------------------------------------
  (setq toutpoint1 (vl-sort toutpoint1
                            '(lambda (a b)
                               (if (eq (car a) (car b))
                                 (> (cadr a) (cadr b))
                                 (< (car a) (car b))
                               )
                             )
                   )
  )
  (setq poi1 (car toutpoint1))
  (setq poi2 (cadr toutpoint1))
  (setq poia (polar (polar poi1 (angle poi1 poi2) 5) (+ (angle poi1 poi2) (/ pi 2)) 5))
  (setq poib (polar (polar poi1 (angle poi1 poi2) 10) (+ (angle poi1 poi2) (/ pi 2)) 5))
  (setq angletext (* (+ (angle poi1 poi2) (/ pi 2)) (/ 180 pi)))
  (if (= nomfenetre1 nil)
    (progn (command-s "TEXTE"
                      "st"
                      "arial"
                      "j"
                      "mg"
                      poib
                      (rtos (/ (* 0.03 txtech) techl) 2 8)
                      angletext
                      (strcat "%%U" nompresentation1)
           )
    )
    (progn (setq ech1 (/ 10 (vla-get-customscale (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname sel 0))))))))
           (if (= ech1 2.5)
             (setq echl10 (rtos ech1 2 1))
             (setq echl10 (rtos ech1 2 0))
           )
           (command-s "TEXTE"
                      "st"
                      "arial"
                      "j"
                      "mg"
                      poia
                      (rtos (/ (* 0.03 txtech) techl) 2 8)
                      angletext
                      (strcat "%%U" nomfenetre1 "   1/" echl10 " ième")
           )
           (command-s "TEXTE"
                      "st"
                      "arial"
                      "j"
                      "mg"
                      poib
                      (rtos (/ (* 0.03 txtech) techl) 2 8)
                      angletext
                      (strcat "%%U" nompresentation1)
           )
    )
  )
  (command-s "scu" "p")
  (command-s "espacep")
  (setvar "clayer" cav)
  (setvar "osmode" osm)
  (princ)
)
















;;----------------------------------------------------------------------;;
;;  VPOL - Outline all viewports in the active Paperspace layout        ;;
;;----------------------------------------------------------------------;;

(defun c:vpooutl1_4 (/ *error* idx sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "T" "A" "T_FENETRE" "")
  )
  (command-s "-calque" "ch" "T_FENETRE" "")
  (defun *error* (msg)
    (lm:endundo (lm:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (cond ((/= 1 (getvar 'cvport)) (princ "\nCommand not available in Modelspace."))
        ((setq sel (ssget "_X" (list '(0 . "VIEWPORT") '(-4 . "/=") '(69 . 1) (cons 410 (getvar 'ctab)))))
         (lm:startundo (lm:acdoc))
         (repeat (setq idx (sslength sel)) (vpo:main (ssname sel (setq idx (1- idx)))))
         (lm:endundo (lm:acdoc))
        )
        ((princ "\nNo viewports were found in the active layout."))
  )
  (setvar "clayer" cav)
  (princ)
)








;;----------------------------------------------------------------------;;
;;  VPOL - Outline all viewports in the active Paperspace layout        ;;
;;----------------------------------------------------------------------;;

(defun c:vpooutl1_4_fenetre_nommee (/ *error* idx sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (setq osm (getvar "osmode"))
;;;  (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
;;;  (setq txtech (atof (getcfg "APPDATA/TXTECH")))
  (setq techl 0.01) ; dessin en metre techl=1, en centimetre techl=0.01, millimetre techl=0.001
  (setq txtech 1)
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "T" "A" "T_FENETRE" "")
  )
  (command-s "-calque" "ch" "T_FENETRE" "")
  (defun *error* (msg)
    (lm:endundo (lm:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (cond ((/= 1 (getvar 'cvport)) (princ "\nCommand not available in Modelspace."))
        ((setq sel (ssget "_X" (list '(0 . "VIEWPORT") '(-4 . "/=") '(69 . 1) (cons 410 (getvar 'ctab)))))
         (lm:startundo (lm:acdoc))
         (repeat (setq idx (sslength sel))
           (setq name1 (ssname sel (setq idx (1- idx))))
           (setq l12 nil
                 nomfenetre1 nil
                 nompresentation1 nil
           )
;;;           (vpo:main2 (ssname sel (setq idx (1- idx))))
           (vpo:main2 name1)
           (setvar "osmode" 0)
           (command-s "espaceo")
           (setq toutpoint (gc:massoc 10 (entget (entlast))))
;;;-----------------------------------------------------------------------------------------------------
;;;Le code suivant trie la liste en fonction du 1ème élément puis (en cas d'égalité) en fonction du 2ème inverser
;;;-----------------------------------------------------------------------------------------------------
           (setq toutpoint (vl-sort toutpoint
                                    '(lambda (a b)
                                       (if (eq (car a) (car b))
                                         (> (cadr a) (cadr b))
                                         (< (car a) (car b))
                                       )
                                     )
                           )
           )
           (setq poi1 (car toutpoint))
;;;  (setq poi1 (car (gc:massoc 10 (entget (entlast)))))
           (if (= nomfenetre1 nil)
             (progn (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               (strcat (rtos (+ (car poi1) 5) 2 8) "," (rtos (- (cadr poi1) 10) 2 8) ",0")
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               ""
                               (strcat "%%U" nompresentation1)
                    )
             )
             (progn (setq ech1 (/ 10 (vla-get-customscale (vlax-ename->vla-object (cdr (assoc -1 (entget name1)))))))
                    (if (= ech1 2.5)
                      (setq echl10 (rtos ech1 2 1))
                      (setq echl10 (rtos ech1 2 0))
                    )
                    (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               (strcat (rtos (+ (car poi1) 5) 2 8) "," (rtos (- (cadr poi1) 5) 2 8) ",0")
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               ""
                               (strcat "%%U" nomfenetre1 "   1/" echl10 " ième")
                    )
                    (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               (strcat (rtos (+ (car poi1) 5) 2 8) "," (rtos (- (cadr poi1) 10) 2 8) ",0")
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               ""
                               (strcat "%%U" nompresentation1)
                    )
             )
           )
           (command-s "espacep")
         )
         (lm:endundo (lm:acdoc))
        )
        ((princ "\nNo viewports were found in the active layout."))
  )
  (setvar "clayer" cav)
  (setvar "osmode" osm)
  (princ)
)




;;----------------------------------------------------------------------;;
;;  VPOL - Outline all viewports in the active Paperspace layout        ;;
;;----------------------------------------------------------------------;;

(defun c:vpooutl1_4_fenetre_nommee_tournee (/ *error* idx sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (setq osm (getvar "osmode"))
;;;  (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
;;;  (setq txtech (atof (getcfg "APPDATA/TXTECH")))
  (setq techl 0.01) ; dessin en metre techl=1, en centimetre techl=0.01, millimetre techl=0.001
  (setq txtech 1)
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "T" "A" "T_FENETRE" "")
  )
  (command-s "-calque" "ch" "T_FENETRE" "")
  (defun *error* (msg)
    (lm:endundo (lm:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (cond ((/= 1 (getvar 'cvport)) (princ "\nCommand not available in Modelspace."))
        ((setq sel (ssget "_X" (list '(0 . "VIEWPORT") '(-4 . "/=") '(69 . 1) (cons 410 (getvar 'ctab)))))
         (lm:startundo (lm:acdoc))
         (repeat (setq idx (sslength sel))
           (setq name1 (ssname sel (setq idx (1- idx))))
           (setq l12 nil
                 nomfenetre1 nil
                 nompresentation1 nil
           )
;;;           (vpo:main2 (ssname sel (setq idx (1- idx))))
           (vpo:main2 name1)
           (setvar "osmode" 0)
           (command-s "espaceo")
           (setq toutpoint (gc:massoc 10 (entget (entlast))))
           (setq targetx    (getpropertyvalue (cdr (assoc -1 (entget name1))) "ViewTarget/X")
                 targety    (getpropertyvalue (cdr (assoc -1 (entget name1))) "ViewTarget/Y")
                 anglerota  (vla-get-twistangle (vlax-ename->vla-object (cdr (assoc -1 (entget name1)))))
                 anglerota1 (* (vla-get-twistangle (vlax-ename->vla-object (cdr (assoc -1 (entget name1))))) (/ 180 pi))
                 p1         (list targetx targety 0)
                 p2         (polar p1 (- anglerota) 200)
                 p3         (polar p1 (+ (- anglerota) (/ pi 2)) 200)
           )
           (command-s "SCU" "n" "3" p1 p2 p3)
           (setq toutpoint1 (mapcar '(lambda (x) (trans x 0 1)) toutpoint))
;;;-----------------------------------------------------------------------------------------------------
;;;Le code suivant trie la liste en fonction du 1ème élément puis (en cas d'égalité) en fonction du 2ème inverser
;;;-----------------------------------------------------------------------------------------------------
           (setq toutpoint1 (vl-sort toutpoint1
                                     '(lambda (a b)
                                        (if (eq (car a) (car b))
                                          (> (cadr a) (cadr b))
                                          (< (car a) (car b))
                                        )
                                      )
                            )
           )
           (setq poi1 (car toutpoint1))
           (setq poi2 (cadr toutpoint1))
           (setq poia (polar (polar poi1 (angle poi1 poi2) 5) (+ (angle poi1 poi2) (/ pi 2)) 5))
           (setq poib (polar (polar poi1 (angle poi1 poi2) 10) (+ (angle poi1 poi2) (/ pi 2)) 5))
           (setq angletext (* (+ (angle poi1 poi2) (/ pi 2)) (/ 180 pi)))
           (if (= nomfenetre1 nil)
             (progn (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               poib
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               angletext
                               (strcat "%%U" nompresentation1)
                    )
             )
             (progn (setq ech1 (/ 10 (vla-get-customscale (vlax-ename->vla-object (cdr (assoc -1 (entget name1)))))))
                    (if (= ech1 2.5)
                      (setq echl10 (rtos ech1 2 1))
                      (setq echl10 (rtos ech1 2 0))
                    )
                    (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               poia
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               angletext
                               (strcat "%%U" nomfenetre1 "   1/" echl10 " ième")
                    )
                    (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               poib
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               angletext
                               (strcat "%%U" nompresentation1)
                    )
             )
           )
           (command-s "scu" "p")
           (command-s "espacep")
         )
         (lm:endundo (lm:acdoc))
        )
        ((princ "\nNo viewports were found in the active layout."))
  )
  (setvar "clayer" cav)
  (setvar "osmode" osm)
  (princ)
)






























;;----------------------------------------------------------------------;;
;;  VPOA - Outline all viewports in all Paperspace layouts              ;;
;;----------------------------------------------------------------------;;

(defun c:vpoouta1_4 (/ *error* idx sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "T" "A" "T_FENETRE" "")
  )
  (command-s "-calque" "ch" "T_FENETRE" "")
  (defun *error* (msg)
    (lm:endundo (lm:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (cond ((setq sel (ssget "_X" '((0 . "VIEWPORT") (-4 . "<>") (69 . 1) (410 . "~Model"))))
         (lm:startundo (lm:acdoc))
         (repeat (setq idx (sslength sel)) (vpo:main (ssname sel (setq idx (1- idx)))))
         (lm:endundo (lm:acdoc))
        )
        ((princ "\nNo viewports were found in any Paperspace layouts."))
  )
  (setvar "clayer" cav)
  (princ)
)









;;----------------------------------------------------------------------;;
;;  VPOA - Outline all viewports in all Paperspace layouts              ;;
;;----------------------------------------------------------------------;;

(defun c:vpoouta1_4_fenetre_nommee (/ *error* idx sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (setq osm (getvar "osmode"))
;;;  (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
;;;  (setq txtech (atof (getcfg "APPDATA/TXTECH")))
  (setq techl 0.01) ; dessin en metre techl=1, en centimetre techl=0.01, millimetre techl=0.001
  (setq txtech 1)
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "T" "A" "T_FENETRE" "")
  )
  (command-s "-calque" "ch" "T_FENETRE" "")
  (defun *error* (msg)
    (lm:endundo (lm:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (cond ((setq sel (ssget "_X" '((0 . "VIEWPORT") (-4 . "<>") (69 . 1) (410 . "~Model"))))
         (lm:startundo (lm:acdoc))
         (repeat (setq idx (sslength sel))
           (setq l12 nil
                 nomfenetre1 nil
                 nompresentation1 nil
           )
           (setq name1 (ssname sel (setq idx (1- idx))))
;;;           (vpo:main2 (ssname sel (setq idx (1- idx))))
           (vpo:main2 name1)
           (setvar "osmode" 0)
           (command-s "espaceo")
           (setq toutpoint (gc:massoc 10 (entget (entlast))))
;;;-----------------------------------------------------------------------------------------------------
;;;Le code suivant trie la liste en fonction du 1ème élément puis (en cas d'égalité) en fonction du 2ème inverser
;;;-----------------------------------------------------------------------------------------------------
           (setq toutpoint (vl-sort toutpoint
                                    '(lambda (a b)
                                       (if (eq (car a) (car b))
                                         (> (cadr a) (cadr b))
                                         (< (car a) (car b))
                                       )
                                     )
                           )
           )
           (setq poi1 (car toutpoint))
           (if (= nomfenetre1 nil)
             (progn (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               (strcat (rtos (+ (car poi1) 5) 2 8) "," (rtos (- (cadr poi1) 10) 2 8) ",0")
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               ""
                               (strcat "%%U" nompresentation1)
                    )
             )
             (progn (setq ech1 (/ 10 (vla-get-customscale (vlax-ename->vla-object (cdr (assoc -1 (entget name1)))))))
                    (if (= ech1 2.5)
                      (setq echl10 (rtos ech1 2 1))
                      (setq echl10 (rtos ech1 2 0))
                    )
                    (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               (strcat (rtos (+ (car poi1) 5) 2 8) "," (rtos (- (cadr poi1) 5) 2 8) ",0")
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               ""
                               (strcat "%%U" nomfenetre1 "   1/" echl10 " ième")
                    )
                    (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               (strcat (rtos (+ (car poi1) 5) 2 8) "," (rtos (- (cadr poi1) 10) 2 8) ",0")
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               ""
                               (strcat "%%U" nompresentation1)
                    )
             )
           )
           (command-s "espacep")
         )
         (lm:endundo (lm:acdoc))
        )
        ((princ "\nNo viewports were found in any Paperspace layouts."))
  )
  (setvar "clayer" cav)
  (setvar "osmode" osm)
  (princ)
)






;;----------------------------------------------------------------------;;
;;  VPOA - Outline all viewports in all Paperspace layouts              ;;
;;----------------------------------------------------------------------;;

(defun c:vpoouta1_4_fenetre_nommee_tournee (/ *error* idx sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (setq osm (getvar "osmode"))
;;;  (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
;;;  (setq txtech (atof (getcfg "APPDATA/TXTECH")))
  (setq techl 0.01) ; dessin en metre techl=1, en centimetre techl=0.01, millimetre techl=0.001
  (setq txtech 1)
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "T" "A" "T_FENETRE" "")
  )
  (command-s "-calque" "ch" "T_FENETRE" "")
  (defun *error* (msg)
    (lm:endundo (lm:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (cond ((setq sel (ssget "_X" '((0 . "VIEWPORT") (-4 . "<>") (69 . 1) (410 . "~Model"))))
         (lm:startundo (lm:acdoc))
         (repeat (setq idx (sslength sel))
           (setq l12 nil
                 nomfenetre1 nil
                 nompresentation1 nil
           )
           (setq name1 (ssname sel (setq idx (1- idx))))
;;;           (vpo:main2 (ssname sel (setq idx (1- idx))))
           (vpo:main2 name1)
           (setvar "osmode" 0)
           (command-s "espaceo")
           (command-s "SCU" "G" "")
           (setq toutpoint (gc:massoc 10 (entget (entlast))))
           (setq targetx    (getpropertyvalue (cdr (assoc -1 (entget name1))) "ViewTarget/X")
                 targety    (getpropertyvalue (cdr (assoc -1 (entget name1))) "ViewTarget/Y")
                 anglerota  (vla-get-twistangle (vlax-ename->vla-object (cdr (assoc -1 (entget name1)))))
                 anglerota1 (* (vla-get-twistangle (vlax-ename->vla-object (cdr (assoc -1 (entget name1))))) (/ 180 pi))
                 p1         (list targetx targety 0)
                 p2         (polar p1 (- anglerota) 200)
                 p3         (polar p1 (+ (- anglerota) (/ pi 2)) 200)
           )
           (command-s "SCU" "n" "3" p1 p2 p3)
           (setq toutpoint1 (mapcar '(lambda (x) (trans x 0 1)) toutpoint))
;;;-----------------------------------------------------------------------------------------------------
;;;Le code suivant trie la liste en fonction du 1ème élément puis (en cas d'égalité) en fonction du 2ème inverser
;;;-----------------------------------------------------------------------------------------------------
           (setq toutpoint1 (vl-sort toutpoint1
                                     '(lambda (a b)
                                        (if (eq (car a) (car b))
                                          (> (cadr a) (cadr b))
                                          (< (car a) (car b))
                                        )
                                      )
                            )
           )
           (setq poi1 (car toutpoint1))
           (setq poi2 (cadr toutpoint1))
           (setq poia (polar (polar poi1 (angle poi1 poi2) 5) (+ (angle poi1 poi2) (/ pi 2)) 5))
           (setq poib (polar (polar poi1 (angle poi1 poi2) 10) (+ (angle poi1 poi2) (/ pi 2)) 5))
           (setq angletext (* (+ (angle poi1 poi2) (/ pi 2)) (/ 180 pi)))
           (if (= nomfenetre1 nil)
             (progn (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               poib
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               angletext
                               (strcat "%%U" nompresentation1)
                    )
             )
             (progn (setq ech1 (/ 10 (vla-get-customscale (vlax-ename->vla-object (cdr (assoc -1 (entget name1)))))))
                    (if (= ech1 2.5)
                      (setq echl10 (rtos ech1 2 1))
                      (setq echl10 (rtos ech1 2 0))
                    )
                    (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               poia
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               angletext
                               (strcat "%%U" nomfenetre1 "   1/" echl10 " ième")
                    )
                    (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               poib
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               angletext
                               (strcat "%%U" nompresentation1)
                    )
             )
           )
           (command-s "scu" "p")
           (command-s "espacep")
         )
         (lm:endundo (lm:acdoc))
        )
        ((princ "\nNo viewports were found in any Paperspace layouts."))
  )
  (setvar "clayer" cav)
  (setvar "osmode" osm)
  (princ)
)





(setq tm1 (getvar "TILEMODE"))
(if (= tm1 1)
  (progn (setvar "TILEMODE" 1) (prompt (strcat "\nPASSE EN ESPACE OBJET ( 1 ) ")))
  (progn (setvar "TILEMODE" 0) (prompt (strcat "\nPASSE EN ESPACE PAPIER ( 0 ) ")))
)






;;----------------------------------------------------------------------;;
;;  VPOA - Outline all viewports in all Paperspace layouts              ;;
;;----------------------------------------------------------------------;;

(defun c:vpoouta1_4_choix_presentation_fenetre_nommee_tournee (/ *error* idx sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (setq osm (getvar "osmode"))
  (setq tm1 (getvar "TILEMODE"))
;;;  (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
;;;  (setq txtech (atof (getcfg "APPDATA/TXTECH")))
  (setq techl 0.01) ; dessin en metre techl=1, en centimetre techl=0.01, millimetre techl=0.001
  (setq txtech 1)
  (setvar "osmode" 0)
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "T" "A" "T_FENETRE" "")
  )
  (command-s "-calque" "ch" "T_FENETRE" "")
  (defun *error* (msg)
    (lm:endundo (lm:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq selectfen nil
        listefen nil
        listobj nil
        lists1 nil
        compt 0
  )
  (setq selectfen (ssget "X" '((0 . "VIEWPORT") (-4 . "<NOT") (69 . 1) (-4 . "NOT>"))))
  (setq com (sslength selectfen))
  (setq nompresentationfiltre (getcfg "APPDATA/NOMPRESENTATIONFILTRE"))
  (setq boite "FILTRE DES PRESENTATIONS      [ * ]  POUR FILTRER AUCUNE PRESENTATIONS ")
  (setq message "LE(S) CARACTERE(S) A FILTRER DANS LE NOM DE LA PRESENTATION")
  (inputbox2 boite message nompresentationfiltre)
  (if (/= ret "")
    (setq nompresentationfiltre ret)
  )
  (setcfg "APPDATA/NOMPRESENTATIONFILTRE" nompresentationfiltre)
  (while (< compt com)
    (progn (setq obj1       (ssname selectfen compt)
                 pre_name   (cdr (assoc 410 (entget obj1)))
                 id_fen     (cdr (assoc 69 (entget obj1)))
                 center     (vlax-get (vlax-ename->vla-object (cdr (car (entget (ssname selectfen compt))))) 'center)
                 centerx    (car (vlax-get (vlax-ename->vla-object (cdr (car (entget (ssname selectfen compt))))) 'center))
                 centery    (cadr (vlax-get (vlax-ename->vla-object (cdr (car (entget (ssname selectfen compt))))) 'center))
                 height1    (vla-get-height (vlax-ename->vla-object (cdr (car (entget (ssname selectfen compt))))))
                 width1     (vla-get-width (vlax-ename->vla-object (cdr (car (entget (ssname selectfen compt))))))
                 nomfenetre (cdr (assoc 1000 (x_read obj1 "NOM_FENETRE")))
           )
           (if (= nomfenetre nil)
             (setq nomfenetre "_ _ _ _ _ _")
           )
           (setq li1 (strcat pre_name
                             "  /  Id [ "
                             (rtos id_fen 2 0)
                             " ]  /  "
                             nomfenetre
                             "  /  Centre [ "
                             (rtos centerx 2 1)
                             " x "
                             (rtos centery 2 1)
                             " ]  :  "
                             (rtos width1 2 1)
                             " x "
                             (rtos height1 2 1)
                     )
           )
           (if (wcmatch pre_name (strcat "*" nompresentationfiltre "*"))
             (setq listefen (cons li1 listefen)
                   listobj  (cons obj1 listobj)
             )
           )
    )
    (setq compt (1+ compt))
  )
  (setq viewport1 (getlviewport1 (reverse listefen) "CHOSISSEZ LES FENETRES A MODIFIER" t))
  (setq comlistefen (length listefen))
  (foreach ele viewport1
    (progn (setq lists1 (cons (- comlistefen (length (member ele listefen))) lists1)))
  )
  (setq lists1 (reverse lists1))
  (if (= tm1 1)
    (progn (setvar "TILEMODE" 0) (prompt (strcat "\nPASSE EN ESPACE PAPIER ( 0 ) ")))
  )
  (lm:startundo (lm:acdoc))
  (foreach l1 lists1
    (progn (setq viewport (nth l1 listobj))
;;;
;;;      (repeat (setq idx (sslength sel))
           (setq l12 nil
                 nomfenetre1 nil
                 nompresentation1 nil
           )
           (setq name1 (nth l1 listobj))
;;;           (vpo:main2 (ssname sel (setq idx (1- idx))))
           (vpo:main2 name1)
           
           (command-s "espaceo")
           (command-s "SCU" "G" "")
           (setq toutpoint (gc:massoc 10 (entget (entlast))))
           (setq targetx    (getpropertyvalue (cdr (assoc -1 (entget name1))) "ViewTarget/X")
                 targety    (getpropertyvalue (cdr (assoc -1 (entget name1))) "ViewTarget/Y")
                 anglerota  (vla-get-twistangle (vlax-ename->vla-object (cdr (assoc -1 (entget name1)))))
                 anglerota1 (* (vla-get-twistangle (vlax-ename->vla-object (cdr (assoc -1 (entget name1))))) (/ 180 pi))
                 p1         (list targetx targety 0)
                 p2         (polar p1 (- anglerota) 200)
                 p3         (polar p1 (+ (- anglerota) (/ pi 2)) 200)
           )
           (command-s "SCU" "n" "3" p1 p2 p3)
           (setq toutpoint1 (mapcar '(lambda (x) (trans x 0 1)) toutpoint))
;;;-----------------------------------------------------------------------------------------------------
;;;Le code suivant trie la liste en fonction du 1ème élément puis (en cas d'égalité) en fonction du 2ème inverser
;;;-----------------------------------------------------------------------------------------------------
           (setq toutpoint1 (vl-sort toutpoint1
                                     '(lambda (a b)
                                        (if (eq (car a) (car b))
                                          (> (cadr a) (cadr b))
                                          (< (car a) (car b))
                                        )
                                      )
                            )
           )
           (setq poi1 (car toutpoint1))
           (setq poi2 (cadr toutpoint1))
           (setq poia (polar (polar poi1 (angle poi1 poi2) 5) (+ (angle poi1 poi2) (/ pi 2)) 5))
           (setq poib (polar (polar poi1 (angle poi1 poi2) 10) (+ (angle poi1 poi2) (/ pi 2)) 5))
           (setq angletext (* (+ (angle poi1 poi2) (/ pi 2)) (/ 180 pi)))
           (if (= nomfenetre1 nil)
             (progn (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               poib
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               angletext
                               (strcat "%%U" nompresentation1)
                    )
             )
             (progn (setq ech1 (/ 10 (vla-get-customscale (vlax-ename->vla-object (cdr (assoc -1 (entget name1)))))))
                    (if (= ech1 2.5)
                      (setq echl10 (rtos ech1 2 1))
                      (setq echl10 (rtos ech1 2 0))
                    )
                    (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               poia
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               angletext
                               (strcat "%%U" nomfenetre1 "   1/" echl10 " ième")
                    )
                    (command-s "TEXTE"
                               "st"
                               "arial"
                               "j"
                               "mg"
                               poib
                               (rtos (/ (* 0.03 txtech) techl) 2 8)
                               angletext
                               (strcat "%%U" nompresentation1)
                    )
             )
           )
           (command-s "scu" "p")
           (command-s "espacep")
;;;         )
    )
  )
  (lm:endundo (lm:acdoc))
  (if (= tm1 1)
    (progn (setvar "TILEMODE" 1) (prompt (strcat "\nPASSE EN ESPACE OBJET ( 1 ) ")))
  )
  (setvar "clayer" cav)
  (setvar "osmode" osm)
  (princ)
)

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

(defun vpo:main (vpt / cen dpr ent lst ltp ocs ofe off tmp vpe)
  (setq ;;----------------------------------------------------------------------;;
        ;;                          Program Parameters                          ;;
        ;;----------------------------------------------------------------------;;
        ;; Optional Interior Offset
        ;; Set this parameter to nil or 0.0 for no offset
        off 0.0
        ;; Default Polyline Properties
        ;; Omitted properties will use current settings when the program is run
        dpr '((006 . "BYLAYER")
              ;; Linetype (must be loaded)
 ;(008 . "VPOutline") ;; Layer (automatically created if not present in drawing)
              (039 . 0.0)
              ;; Thickness
              (048 . 1.0)
              ;; Linetype Scale
              (062 . 256)
              ;; Colour (0 = ByBlock, 256 = ByLayer)
              (370 . -1)
              ;; Lineweight (-1 = ByLayer, -2 = ByBlock, -3 = Default, 0.3 = 30 etc.)
             )
            ;;----------------------------------------------------------------------;;
  )
  (if (setq vpt (entget vpt)
            ent (cdr (assoc 340 vpt))
      )
    (setq lst (vpo:polyvertices ent))
    (setq cen (mapcar 'list (cdr (assoc 10 vpt)) (list (/ (cdr (assoc 40 vpt)) 2.0) (/ (cdr (assoc 41 vpt)) 2.0)))
          lst (mapcar '(lambda (a) (cons (mapcar 'apply a cen) '(42 . 0.0))) '((- -) (+ -) (+ +) (- +)))
    )
  )
  (if (not (lm:listclockwise-p (mapcar 'car lst)))
    (setq lst (reverse (mapcar '(lambda (a b) (cons (car a) (cons 42 (- (cddr b))))) lst (cons (last lst) lst))))
  )
  (if (and (numberp off) (not (equal 0.0 off 1e-8)))
    (cond ((null
             (setq tmp (entmakex (append (list '(000 . "LWPOLYLINE")
                                               '(100 . "AcDbEntity")
                                               '(100 . "AcDbPolyline")
                                               (cons 90 (length lst))
                                               '(070 . 1)
                                         )
                                         (apply 'append (mapcar '(lambda (x) (list (cons 10 (car x)) (cdr x))) lst))
                                 )
                       )
             )
           )
           (princ "\nUnable to generate Paperspace outline for offset.")
          )
          ((vl-catch-all-error-p
             (setq ofe (vl-catch-all-apply 'vlax-invoke (list (vlax-ename->vla-object tmp) 'offset off)))
           )
           (princ (strcat "\nViewport dimensions too small to offset outline by " (rtos off) " units."))
           (entdel tmp)
          )
          ((setq ofe (vlax-vla-object->ename (car ofe))
                 lst (vpo:polyvertices ofe)
           )
           (entdel ofe)
           (entdel tmp)
          )
    )
  )
  (setq vpe (cdr (assoc -1 vpt))
        ocs (cdr (assoc 16 vpt))
  )
  (entmakex
    (append (list '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  (cons 90 (length lst))
                  '(070 . 1)
                  '(410 . "Model")
            )
            (if (and (setq ltp (assoc 6 dpr)) (not (tblsearch "ltype" (cdr ltp))))
              (progn (princ (strcat "\n\"" (cdr ltp) "\" linetype not loaded - linetype set to \"ByLayer\"."))
                     (subst '(6 . "BYLAYER") ltp dpr)
              )
              dpr
            )
            (apply 'append
                   (mapcar '(lambda (x) (list (cons 10 (trans (pcs2wcs (car x) vpe) 0 ocs)) (cdr x))) lst)
            )
            (list (cons 210 ocs))
    )
  )
)


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

(defun vpo:main1 (vpt / cen dpr ent lst ltp ocs ofe off tmp vpe)
  (setq ;;----------------------------------------------------------------------;;
        ;;                          Program Parameters                          ;;
        ;;----------------------------------------------------------------------;;
        ;; Optional Interior Offset
        ;; Set this parameter to nil or 0.0 for no offset
        off 0.0
        ;; Default Polyline Properties
        ;; Omitted properties will use current settings when the program is run
        dpr '((006 . "BYLAYER")
              ;; Linetype (must be loaded)
 ;(008 . "VPOutline") ;; Layer (automatically created if not present in drawing)
              (039 . 0.0)
              ;; Thickness
              (048 . 1.0)
              ;; Linetype Scale
              (062 . 256)
              ;; Colour (0 = ByBlock, 256 = ByLayer)
              (370 . -1)
              ;; Lineweight (-1 = ByLayer, -2 = ByBlock, -3 = Default, 0.3 = 30 etc.)
             )
            ;;----------------------------------------------------------------------;;
  )
  (setq nomappli1 "NOM_FENETRE")
  (setq l12              (gc:massoc 1000 (x_read (ssname sel 0) nomappli1))
        nomfenetre1      (car l12)
        nompresentation1 (cadr l12)
  )
  (if (= nompresentation1 nil)
    (setq nompresentation1 (cdr (assoc 410 (entget (ssname sel 0)))))
  )
  (if (setq vpt (entget vpt)
            ent (cdr (assoc 340 vpt))
      )
    (setq lst (vpo:polyvertices ent))
    (setq cen (mapcar 'list (cdr (assoc 10 vpt)) (list (/ (cdr (assoc 40 vpt)) 2.0) (/ (cdr (assoc 41 vpt)) 2.0)))
          lst (mapcar '(lambda (a) (cons (mapcar 'apply a cen) '(42 . 0.0))) '((- -) (+ -) (+ +) (- +)))
    )
  )
  (if (not (lm:listclockwise-p (mapcar 'car lst)))
    (setq lst (reverse (mapcar '(lambda (a b) (cons (car a) (cons 42 (- (cddr b))))) lst (cons (last lst) lst))))
  )
  (if (and (numberp off) (not (equal 0.0 off 1e-8)))
    (cond ((null
             (setq tmp (entmakex (append (list '(000 . "LWPOLYLINE")
                                               '(100 . "AcDbEntity")
                                               '(100 . "AcDbPolyline")
                                               (cons 90 (length lst))
                                               '(070 . 1)
                                         )
                                         (apply 'append (mapcar '(lambda (x) (list (cons 10 (car x)) (cdr x))) lst))
                                 )
                       )
             )
           )
           (princ "\nUnable to generate Paperspace outline for offset.")
          )
          ((vl-catch-all-error-p
             (setq ofe (vl-catch-all-apply 'vlax-invoke (list (vlax-ename->vla-object tmp) 'offset off)))
           )
           (princ (strcat "\nViewport dimensions too small to offset outline by " (rtos off) " units."))
           (entdel tmp)
          )
          ((setq ofe (vlax-vla-object->ename (car ofe))
                 lst (vpo:polyvertices ofe)
           )
           (entdel ofe)
           (entdel tmp)
          )
    )
  )
  (setq vpe (cdr (assoc -1 vpt))
        ocs (cdr (assoc 16 vpt))
  )
  (entmakex
    (append (list '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  (cons 90 (length lst))
                  '(070 . 1)
                  '(410 . "Model")
            )
            (if (and (setq ltp (assoc 6 dpr)) (not (tblsearch "ltype" (cdr ltp))))
              (progn (princ (strcat "\n\"" (cdr ltp) "\" linetype not loaded - linetype set to \"ByLayer\"."))
                     (subst '(6 . "BYLAYER") ltp dpr)
              )
              dpr
            )
            (apply 'append
                   (mapcar '(lambda (x) (list (cons 10 (trans (pcs2wcs (car x) vpe) 0 ocs)) (cdr x))) lst)
            )
            (list (cons 210 ocs))
    )
  )
  (if (= nomfenetre1 nil)
    (vla-setxdata (vlax-ename->vla-object (entlast))
                  (vlax-make-variant
                    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 3)) '(1001 1002 1000 1002))
                  )
                  (vlax-make-variant
                    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 3))
                                         (mapcar 'vlax-make-variant (list nomappli1 "{" nompresentation1 "}"))
                    )
                  )
    )
    (vla-setxdata
      (vlax-ename->vla-object (entlast))
      (vlax-make-variant
        (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 4)) '(1001 1002 1000 1000 1002))
      )
      (vlax-make-variant
        (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 4))
                             (mapcar 'vlax-make-variant (list nomappli1 "{" nomfenetre1 nompresentation1 "}"))
        )
      )
    )
  )
)






(defun vpo:main2 (vpt / cen dpr ent lst ltp ocs ofe off tmp)
  (setq ;;----------------------------------------------------------------------;;
        ;;                          Program Parameters                          ;;
        ;;----------------------------------------------------------------------;;
        ;; Optional Interior Offset
        ;; Set this parameter to nil or 0.0 for no offset
        off 0.0
        ;; Default Polyline Properties
        ;; Omitted properties will use current settings when the program is run
        dpr '((006 . "BYLAYER")
              ;; Linetype (must be loaded)
 ;(008 . "VPOutline") ;; Layer (automatically created if not present in drawing)
              (039 . 0.0)
              ;; Thickness
              (048 . 1.0)
              ;; Linetype Scale
              (062 . 256)
              ;; Colour (0 = ByBlock, 256 = ByLayer)
              (370 . -1)
              ;; Lineweight (-1 = ByLayer, -2 = ByBlock, -3 = Default, 0.3 = 30 etc.)
             )
            ;;----------------------------------------------------------------------;;
  )
  (setq nomappli1 "NOM_FENETRE")
  (setq l12              (gc:massoc 1000 (x_read name1 nomappli1))
        nomfenetre1      (car l12)
        nompresentation1 (cadr l12)
  )
  (if (= nompresentation1 nil)
    (setq nompresentation1 (cdr (assoc 410 (entget name1))))
  )
  (if (setq vpt (entget vpt)
            ent (cdr (assoc 340 vpt))
      )
    (setq lst (vpo:polyvertices ent))
    (setq cen (mapcar 'list (cdr (assoc 10 vpt)) (list (/ (cdr (assoc 40 vpt)) 2.0) (/ (cdr (assoc 41 vpt)) 2.0)))
          lst (mapcar '(lambda (a) (cons (mapcar 'apply a cen) '(42 . 0.0))) '((- -) (+ -) (+ +) (- +)))
    )
  )
  (if (not (lm:listclockwise-p (mapcar 'car lst)))
    (setq lst (reverse (mapcar '(lambda (a b) (cons (car a) (cons 42 (- (cddr b))))) lst (cons (last lst) lst))))
  )
  (if (and (numberp off) (not (equal 0.0 off 1e-8)))
    (cond ((null
             (setq tmp (entmakex (append (list '(000 . "LWPOLYLINE")
                                               '(100 . "AcDbEntity")
                                               '(100 . "AcDbPolyline")
                                               (cons 90 (length lst))
                                               '(070 . 1)
                                         )
                                         (apply 'append (mapcar '(lambda (x) (list (cons 10 (car x)) (cdr x))) lst))
                                 )
                       )
             )
           )
           (princ "\nUnable to generate Paperspace outline for offset.")
          )
          ((vl-catch-all-error-p
             (setq ofe (vl-catch-all-apply 'vlax-invoke (list (vlax-ename->vla-object tmp) 'offset off)))
           )
           (princ (strcat "\nViewport dimensions too small to offset outline by " (rtos off) " units."))
           (entdel tmp)
          )
          ((setq ofe (vlax-vla-object->ename (car ofe))
                 lst (vpo:polyvertices ofe)
           )
           (entdel ofe)
           (entdel tmp)
          )
    )
  )
  (setq vpe (cdr (assoc -1 vpt))
        ocs (cdr (assoc 16 vpt))
  )
  (entmakex
    (append (list '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  (cons 90 (length lst))
                  '(070 . 1)
                  '(410 . "Model")
            )
            (if (and (setq ltp (assoc 6 dpr)) (not (tblsearch "ltype" (cdr ltp))))
              (progn (princ (strcat "\n\"" (cdr ltp) "\" linetype not loaded - linetype set to \"ByLayer\"."))
                     (subst '(6 . "BYLAYER") ltp dpr)
              )
              dpr
            )
            (apply 'append
                   (mapcar '(lambda (x) (list (cons 10 (trans (pcs2wcs (car x) vpe) 0 ocs)) (cdr x))) lst)
            )
            (list (cons 210 ocs))
    )
  )
  (if (= nomfenetre1 nil)
    (vla-setxdata (vlax-ename->vla-object (entlast))
                  (vlax-make-variant
                    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 3)) '(1001 1002 1000 1002))
                  )
                  (vlax-make-variant
                    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 3))
                                         (mapcar 'vlax-make-variant (list nomappli1 "{" nompresentation1 "}"))
                    )
                  )
    )
    (vla-setxdata
      (vlax-ename->vla-object (entlast))
      (vlax-make-variant
        (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 4)) '(1001 1002 1000 1000 1002))
      )
      (vlax-make-variant
        (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 4))
                             (mapcar 'vlax-make-variant (list nomappli1 "{" nomfenetre1 nompresentation1 "}"))
        )
      )
    )
  )
)





































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

(defun vpo:polyvertices (ent)
  (apply '(lambda (foo bar) (foo bar))
         (if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
           (list (lambda (enx)
                   (if (setq enx (member (assoc 10 enx) enx))
                     (cons (cons (cdr (assoc 10 enx)) (assoc 42 enx)) (foo (cdr enx)))
                   )
                 )
                 (entget ent)
           )
           (list (lambda (ent / enx)
                   (if (= "VERTEX" (cdr (assoc 0 (setq enx (entget ent)))))
                     (cons (cons (cdr (assoc 10 enx)) (assoc 42 enx)) (foo (entnext ent)))
                   )
                 )
                 (entnext ent)
           )
         )
  )
)

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

;; List Clockwise-p  -  Lee Mac
;; Returns T if the point list is clockwise oriented

(defun lm:listclockwise-p (lst)
  (minusp (apply '+
                 (mapcar (function (lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))))
                         lst
                         (cons (last lst) lst)
                 )
          )
  )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun lm:ssget (msg
                 arg
                 /
;;;                 sel
                )
  (princ msg)
  (setvar 'nomutt 1)
  (setq sel (vl-catch-all-apply 'ssget arg))
  (setvar 'nomutt 0)
  (if (not (vl-catch-all-error-p sel))
    sel
  )
)

;; PCS2WCS (gile)
;; Translates a PCS point to WCS based on the supplied Viewport
;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active
;; pnt : PCS point
;; ent : Viewport ename

(defun pcs2wcs (pnt ent / ang enx mat nor scl)
  (setq pnt (trans pnt 0 0)
        enx (entget ent)
        ang (- (cdr (assoc 51 enx)))
        nor (cdr (assoc 16 enx))
        scl (/ (cdr (assoc 45 enx)) (cdr (assoc 41 enx)))
        mat (mxm (mapcar (function (lambda (v) (trans v 0 nor t))) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)))
                 (list (list (cos ang) (- (sin ang)) 0.0) (list (sin ang) (cos ang) 0.0) '(0.0 0.0 1.0))
            )
  )
  (mapcar '+
          (mxv mat (mapcar '+ (vxs pnt scl) (vxs (cdr (assoc 10 enx)) (- scl)) (cdr (assoc 12 enx))))
          (cdr (assoc 17 enx))
  )
)

;; Matrix Transpose  -  Doug Wilson
;; Args: m - nxn matrix

(defun trp (m) (apply 'mapcar (cons 'list m)))

;; Matrix x Matrix  -  Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm (m n) ((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n)))

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv (m v) (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m))

;; Vector x Scalar  -  Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs (v s) (mapcar '(lambda (n) (* n s)) v))

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun lm:startundo (doc) (lm:endundo doc) (vla-startundomark doc))

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun lm:endundo (doc) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc)))

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun lm:acdoc nil
  (eval (list 'defun 'lm:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
  (lm:acdoc)
)

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

(princ (strcat "\n:: VPOutline.lsp | Version 1.3 | \\U+00A9 Lee Mac "
               ((lambda (y)
                  (if (= y (menucmd "m=$(edtime,0,yyyy)"))
                    y
                    (strcat y "-" (menucmd "m=$(edtime,0,yyyy)"))
                  )
                )                                                 "2015"
               )
               " www.lee-mac.com ::"
               "\n:: \"vpoout1_4\"  - Outline single viewport                ::"
               "\n:: \"vpooutl1_4\" - Outline all viewports in active layout ::"
               "\n:: \"vpoouta1_4\" - Outline all viewports in all layouts   ::"
       )
)


















(defun c:vpooutl1_4_auto (/ *error* idx sel)
  (setvar "cmdecho" 0)
  (setq cav (getvar "clayer"))
  (if (= (tblsearch "layer" "T_FENETRE_EXPORT") nil)
    (command-s "-calque" "n" "T_FENETRE_EXPORT" "co" "10" "T_FENETRE_EXPORT" "T" "A" "T_FENETRE_EXPORT" "")
  )
  (command-s "-calque" "ch" "T_FENETRE_EXPORT" "")
;;;    (defun *error* ( msg )
;;;        (LM:endundo (LM:acdoc))
;;;        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
;;;            (princ (strcat "\nError: " msg))
;;;        )
;;;        (princ)
;;;    )
  (cond
;;;        (   (/= 1 (getvar 'cvport))
;;;            (princ "\nCommand not available in Modelspace.")
;;;        )
        ((setq sel (ssget "_X"
                          (list '(0 . "VIEWPORT")
                                
;;;                                        '(-4 . "<>")
                                '
                                 (69 . 1)
                                (cons 410 (getvar 'ctab))
                          )
                   )
         )
         (lm:startundo (lm:acdoc))
         (repeat (setq idx (sslength sel)) (vpo:main (ssname sel (setq idx (1- idx)))))
         (lm:endundo (lm:acdoc))
        )
;;;        (   (princ "\nNo viewports were found in the active layout."))
  )
  (setvar "clayer" cav)
  (princ)
)






;; gc:massoc
;; Retourne la liste de toutes les valeurs pour le code spécifié dans une liste d'association
;;
;; Arguments
;; code : le code de groupe pour les entrées
;; alst : la liste d'association

(defun gc:massoc (code alst)
  (if (setq alst (member (assoc code alst) alst))
    (cons (cdar alst) (gc:massoc code (cdr alst)))
  )
)


 ;------------------------------------------------------------------------------
 ;------------------------------------------------------------------------------
 ;------------------------------------------------------------------------------
 ;                       lit une liste en xdata
 ;  entrées : enam : nom d'entité
 ;            appli: application
 ;
 ;  retourne : liste XDATA correspondant à l'application
 ;------------------------------------------------------------------------------
(defun x_read (enam appli / l ent)
  (regapp appli)
  (setq ent (entget enam (list appli)))
  (if (assoc -3 ent)
    (cdr (assoc appli (cdr (assoc -3 ent))))
  )
)






;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;
;|«Visual LISP© Format Options»
(120 2 1 2 nil "Ende von " 100 100 1 1 2 nil nil nil T)
;*** NE PAS AJOUTER de texte au-dessous du commentaire! ***|;