;;;
;;;    CHSPACE.LSP - Written by Randy Kintzley
;;;    Copyright © 1999 by Autodesk, Inc.
;;;
;;;    Your use of this software is governed by the terms and conditions of the
;;;    License Agreement you accepted prior to installation of this software.
;;;    Please note that pursuant to the License Agreement for this software,
;;;    "[c]opying of this computer program or its documentation except as
;;;    permitted by this License is copyright infringement under the laws of
;;;    your country.  If you copy this computer program without permission of
;;;    Autodesk, you are violating the law."
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;  ----------------------------------------------------------------
 
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:chspace ( / ss ss2 flag flag2 vp lim flt )
(acet-error-init 
 (list (list   "cmdecho" 0
             "highlight" 0 
                "osmode" 0
             "ucsfollow" 0
               "insname" (getvar "insname")
              "limcheck" 0
       );list
       T
       '(progn (setvar "cmdecho" 0) 
               (acet-table-purge "block" "bns_chspace" nil);purge this block if something goes 
                                                           ;wrong before we are done.
               (setvar "cmdecho" 1) 
        );progn
 );list
);acet-error-init
 
(if (equal (getvar "pickfirst") 1)
    (setq ss (cadr (ssgetfirst)))
);if
(sssetfirst nil nil)
 
(setvar "highlight" 1)
(cond 
 ((not (equal 0 (getvar "tilemode")))
  (princ "\n** Command not allowed in Model Tab **")
 );cond #1
 ((and (not (equal (getvar "cvport")
                   (car (setq flag (acet-viewport-next-pickable))) 
            );equal
       );not
       (not (equal 1 (getvar "cvport")))
  );and
  (princ "\n  That command may not be invoked in a perspective view  ")
 );cond #2
 ((car flag) 
  (progn
 
   (setq vp (getvar "cvport")) 
   (if (and (or ss
                (setq ss (ssget))
            );or
            (setq flt (list (list "LAYERUNLOCKED")
                      );list
                   ss (car (acet-ss-filter (list ss flt T)))
            );setq
            (setq ss (ss_remove_viewports ss))
            (> (sslength ss) 0)
       );and
       (progn
        (setvar "cvport" vp)
        (command "_.mspace")
        (if (and (setq ss2 (ssget "_x" '((0 . "VIEWPORT") (67 . 1))));setq
                 (= (sslength ss2) 2)
            );and
            (setq flag2 T)
        );if
        (while (not flag2)
         (if (equal vp 1)
             (getstring "\nSet the TARGET viewport active and press ENTER to continue.")
             (getstring "\nSet the SOURCE viewport active and press ENTER to continue.")
         );if
         (if (equal (getvar "cvport") 
                    (car (setq flag (acet-viewport-next-pickable)))
             );equal
             (setq flag2 T)
             (progn
              (princ "\n*Invalid*") 
              (princ (strcat "\nCannot use viewports that are turned"
                             " off or have perspective view on."
                     )
              );princ
             );progn
         );if  
        );while
        (if (equal vp 1)
            (command "_.pspace")
        );if 
        (if (bns_check_for_f_vp ss)
            (progn
             (sssetfirst nil nil)
             (setvar "highlight" 0)
             (chspace ss)
            );progn then
        );if
       );progn
   );if
  );progn 
 );cond #3
 ((and (not (car flag))
       (cadr flag)
  );and
  (princ (cadr flag))
 );cond #4
);cond close
 
 
(setq lim (getvar "limcheck"))
(acet-error-restore)
(setvar "limcheck" lim)
 
(princ)
);defun c:chspace
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun chspace ( ss / msg ss2 na e1 n a b c d xd target )
 
(acet-table-purge "block" "bns_chspace" T)
 
(if (not (equal (getvar "cvport") 1))
    (progn
     (acet-ucs-cmd (list "_view"))
     (setq na (acet-currentviewport-ename)
           e1 (entget na '("ACAD"))
           xd (cdr (car (cdr (assoc -3 e1))))
            a (cdr (assoc 41 e1))
            b (getvar "viewsize")
            c (/ a b)
            d '(0.0 0.0 0.0)
     );setq
     (acet-sysvar-set (list "limcheck" 0))
     (sssetfirst nil nil)
     (command "_.block" "bns_chspace" 
                        (trans d 0 1)
                        ss ""
     );command
     (acet-sysvar-restore)
 
     (setq   d (trans d 0 1))
     (setq   d (trans d 1 2))
     (setq   d (trans d 2 3))
 
     (acet-ucs-cmd (list "_p"))
     (command "_.pspace")
     (acet-ucs-cmd (list "_W")) ;was view
 
     (setq msg " MODEL space to PAPER space.")
    );progn then model space is where we started
    (progn   
     (command "_.mspace") 
     (acet-ucs-cmd (list "_view"))
     (setq  na (acet-currentviewport-ename)
            e1 (entget na '("ACAD"))
            xd (cdr (car (cdr (assoc -3 e1))))
             a (cdr (assoc 41 e1))
             b (getvar "viewsize")
             c (/ b a)
             d '(0.0 0.0 0.0)
            target (cdr (assoc 1010 xd))
     );setq
     (acet-ucs-cmd (list "_p"))
     (command "_.pspace")
     (acet-ucs-cmd (list "_w")) ;was view
     (setq d (trans d 0 1)
           d (trans d 1 2)
           d (trans d 2 3)
     );setq
 
     (acet-sysvar-set (list "limcheck" 0))
     (sssetfirst nil nil)
     (command "_.block" "bns_chspace"
              d
              ss ""
     );command
     (acet-sysvar-restore)
 
     (acet-ucs-cmd (list "_p"))
     (command "_.mspace")
     (acet-ucs-cmd (list "_view"))
     (setq   d '(0.0 0.0 0.0)
             d (trans d 0 1) ;added
 
             d (acet-geom-vector-add d 
                              (trans target 0 1 T)
               )
 
           msg " PAPER space to MODEL space."
     );setq
    );progn else paper space is where we started
);if
(setq na (entlast))
 
(acet-sysvar-set (list "limcheck" 0))
(command "_.insert" "*bns_chspace")
(command d)
(command c 0)
(acet-sysvar-restore)
 
 
(if (setq ss2 (acet-ss-new na))
    (command "_.select" ss2 "")
);if
(if (setq ss (ssget "_p" 
                    '(
                      (-4 . "<OR") 
                        (0 . "DIMENSION")
                        (0 . "LEADER") 
                      (-4 . "OR>") 
                     )   
             );ssget
    );setq
    (progn
     (setq n 0)
     (repeat (sslength ss)
     (setq na (ssname ss n)
           e1 (entget na '("ACAD"))
            a (cdr (car (cdr (assoc -3 e1))))
            b '(1070 . 40)
            d '(1070 . 144)
     );setq
     (if (member b a)
         (setq b (* c (cdr (cadr (member b a))))) 
         (setq b c)
     );if
     (if (member d a)
         (setq d (* (/ 1.0 c) (cdr (cadr (member d a))))) 
         (setq d (/ 1.0 c));setq
     );if
     (command "_.dimoverride" 
              "_dimscale" b 
              "_dimlfac"  d
              "" 
              na ""
     );command
     (setq n (+ n 1))
     );repeat
    );progn then
);if
(acet-table-purge "block" "bns_chspace" nil)
 
 
(command "_.select" ss2 "")
(acet-ucs-cmd (list "_p"))
(princ (strcat "\n" (itoa (sslength ss2)) " object(s) changed from " msg))
(princ (strcat "\nObjects were scaled by a factor of " 
               (ai_rtos c) 
               " to maintain visual appearance."
       )
)
);defun chspace
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ss_remove_viewports ( ss / n j)
 (if (and ss
          (> (sslength ss) 0)
     );and
     (progn
      (setq n (sslength ss))
      (command "_.select" ss "")
      (setq ss (ssget "_p" '((-4 . "<NOT") (0 . "VIEWPORT") (-4 . "NOT>"))));setq
      (if (not ss)
          (setq j 0)
          (setq j (sslength ss))
      );if
      (if (not (equal n j))
          (princ (strcat "\nIgnoring " (itoa (- n j)) 
                         " selected viewport(s)."
                 );strcat
          );princ then
      );if
     );progn then
 );if
 ss
);defun ss_remove_viewports
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bns_check_for_f_vp ( ss / ss2 na2 na e1 n a flag lst)
 
(if (not (equal (getvar "cvport") 1))
    (progn
     (command "_.pspace")
     (setq na2 (acet-currentviewport-ename));setq
     (setq lst (acet-viewport-frozen-layer-list na2))
     (setq n 0)
     (while (< n (sslength ss))
     (setq na (ssname ss n)
           e1 (entget na)
            a (cdr (assoc 8 e1))
     );setq 
     (if (member a lst)
         (setq flag T)
     );if
     (setq n (+ n 1));setq 
     );while
     (command "_.mspace")
    );progn then model space is where we started
    (progn   
     (command "_.mspace")
     (setq na2 (acet-currentviewport-ename));setq
     (setq lst (acet-viewport-frozen-layer-list na2))
     (setq n 0)
     (while (< n (sslength ss))
     (setq na (ssname ss n)
           e1 (entget na)
            a (cdr (assoc 8 e1))
     );setq 
     (if (member a lst)
         (setq flag T)
     );if
     (setq n (+ n 1));setq 
     );while
     (command "_.pspace")
    );progn else paper space is where we started
);if
(if flag
    (progn
     (princ (strcat "\nOne or more selected objects are on a layer that is frozen "
                    "in the target viewport."
            )
     );princ
     (initget "Yes No")
     (if (equal (getkword "\nContinue anyway? <Y>: ")
                "No"
         );equal
         (setq flag nil)
         (setq flag T) 
     );if
    );progn then
    (setq flag T) 
);if
flag
);defun bns_check_for_f_vp


(acet-autoload2	'("ai_utils.lsp"	(ai_rtos val)))
(princ)