by Sgarland » Mon Nov 07, 2011 8:55 pm
I am looking for a chspace lsp that will run in Intellicad.
I found the old version 1.0 from Australia back in 1992. It will work from Paperspace to Modelspace, but not from Model back to Paper.
Any help would be appreciated.
The code is:
;;;---------------------------------------------------------------------------;
;;;
;;; CHSPACE.LSP Version 1.0
;;;
;;; Copyright (C) 1992 by Autodesk Australia.
;;;
;;; Permission to use, copy, modify, and distribute this software and its
;;; documentation for any purpose and without fee is hereby granted.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.
;;; ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
;;; MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; by Gary Calwell
;;; 31 January 1992
;;;
;;;---------------------------------------------------------------------------;
;;; DESCRIPTION
;;;
;;; CHSPACE allows entities that have been drawn in paper space to be moved to
;;; model space and visa versa. Tilemode must be set to 0 otherwise an error
;;; message is given and the program terminates. This program works by making
;;; a block of the desired entities and then inerting them, exploded into the
;;; desired space. Consequently it is easy to change the insertion point, and
;;; scale of the entities in the new space.
;;;
;;; To run, type: CHSPACE tilemode must be set to 0.
;;;
;;; Next select the entities you wish to change and a reference point (the
;;; default is 0,0,0). Then select the new reference point in the new space
;;; (the default is 0,0,0) and finally select the scale (default = 1).
;;; If there are no active viewports on screen, a message is given and the
;;; program terminates.
;;;---------------------------------------------------------------------------;
;;;---------------------------------------------------------------------------;
;;; Internal error handling.
;;;---------------------------------------------------------------------------;
(defun csperr (s) ; If an error (such as CTRL-C) occurs
; while this command is active...
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setq S nil) ; Free selection-set if any
(setvar "CMDECHO" cm) ; Restore saved mode
(setq *error* olderr) ; Restore old *error* handler
(princ)
)
;;;---------------------------------------------------------------------------;
;;; dent (entype ss) e.g. (dent "LINE" ss1)
;;;
;;; dent (delete entity from selection set) is used to delete a specified type
;;; of entity such as "LINE" "CIRCLE" etc. from a specified selection set.
;;; The new selection set (minus the removed entities) is returned.
;;;---------------------------------------------------------------------------;
(defun dent (entyp ss / i ssnew)
(setq i 0) ; Counter for loop
(setq ssnew (ssadd)) ; Create empty selection set
(repeat (sslength ss) ; Repeat for each entity in the sel. set
;; If the entity type is not that specified, copy that entity name into
;; the new seletion set which will be returned at the end.
(if (not (= (cdr (assoc 0 (entget (ssname ss i)))) entyp))
(setq ssnew (ssadd (ssname ss i) ssnew))
)
(setq i (1+ i)) ; Increment counter for next loop
)
ssnew ; Return the new selection set
)
;;;---------------------------------------------------------------------------;
;;; actvp
;;;
;;; actvp (active viewport) returns T if there is an active viewport on the
;;; screen (other than the paper space one). If there is not an active
;;; viewport it returns nil.
;;;---------------------------------------------------------------------------;
(defun actvp (/ vp seta en ed)
(setq seta (ssget "X" (list (cons 0 "VIEWPORT")))) ; get all vport entities
(while (setq en (ssname seta 0)) ; step through each vport
(setq ed (entget en)) ; get entity data
(if (and (/= (cdr (assoc 69 ed)) 1) ; vport id is not paper space (1)
(> (cdr (assoc 68 ed)) 0) ; vport status is active and on screen
)
(setq vp T) ; set vp flag
)
(ssdel en seta) ; delete vport from selection set
)
vp ; return either T or nil
)
;;;---------------------------------------------------------------------------;
;;; Main Program.
;;;---------------------------------------------------------------------------;
(defun c:chspace (/ space dest ss ip sc)
(setq olderr *error*
*error* csperr)
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(cond
( (= (getvar "TILEMODE") 1)
(princ "\n *** Commmand not allowed while TILEMODE is on. ***")
)
( (not (actvp))
(princ "\n No active viewports on screen - use MVIEW to create")
)
( T
(progn
;; set "space" equal to current space, either mspace or pspace
(if (= (getvar "CVPORT") 1) (setq space "Pspace") (setq space "Mspace"))
;; set "dest" equal to the destination space, either mspace or pspace
(initget "Mspace Pspace")
(setq dest (getkword "Move entities to Pspace/<Mspace>: "))
(if (= dest nil) (setq dest "Mspace"))
;; change to the correct space to select entities to move
(if (and (= space "Mspace") (= dest "Mspace")) (command ".Pspace"))
(if (and (= space "Pspace") (= dest "Pspace")) (command ".Mspace"))
(princ (strcat "\nSelect entities to be moved to " dest ": "))
(while (not (setq ss (ssget)))) ; ss = entities to move
(if (= dest "Mspace")
(progn
(setq ss (dent "VIEWPORT" ss)) ; remove vports from selection set
(setq prom "\nSelect Paper Space reference point: <0> ")
)
(setq prom "\nSelect Model Space reference point: <0> ")
)
(setq ip (getpoint prom))
(if (= ip nil) (setq ip '(0 0))) ; ip = source insertion point
;; Search block table for pre-defined block. This will determine the
;; syntax for the block command (i.e. answer "yes" to overwrite existing
;; block).
(if (tblsearch "block" "change_space_block-$$$ac")
(command ".block" "change_space_block-$$$ac" "y" ip ss "")
(command ".block" "change_space_block-$$$ac" ip ss "")
)
;; change to the destination space
(if (= dest "Mspace")
(progn
(command ".Mspace")
(setq prom "\nSelect Model Space reference point: <0> ")
)
(progn
(command ".Pspace")
(setq prom "\nSelect Paper Space reference point: <0> ")
)
)
(setq ip nil)
(setq ip (getpoint prom))
(if (= ip nil) (setq ip '(0 0)))
(setq sc nil)
(setq sc (getreal "\nSelect scale: <1>"))
(if (= sc nil) (setq sc 1))
(command ".insert" (strcat "*" "change_space_block-$$$ac") ip sc "")
)
)
)
(setvar "CMDECHO" cm) ; Restore saved mode
(setq *error* olderr) ; Restore old *error* handler
(princ) ; Exit quietly
)
(princ "\n\tCHSPACE (change space) loaded. Start command with CHSPACE.")
(princ)