home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 8
/
CDASC08.ISO
/
VRAC
/
JUN93.ZIP
/
DTAB.LSP
next >
Wrap
Lisp/Scheme
|
1993-03-30
|
6KB
|
206 lines
;==========================================================
; DTAB.LSP Copyright 1993 by Looking Glass Microproducts
;==========================================================
; Justify Text its Decimal Point
;=============================================================
(defun C:DTAB (/ ERROR PUSHVARS POPVARS SYSVARS OLD-ERROR NOTRANS
ITEM SS1 FILTER DTAB ONE_DTAB REPLACE BS SP BP PER
)
(setq
BS "\010" ; back space
SP "\040" ; space
BP "\011" ; back period
PER "." ; period
)
;==========================================================
; Error Handler
(defun ERROR (S)
(if (not
(member
S
'("Function cancelled" "console break")
)
)
(princ S)
)
(if UNDOIT
(progn
(princ "\nUndoing...")
(command
"_undo" "_end" "_undo" 1
)
)
)
(POPVARS)
(princ)
)
;==========================================================
; Set and Save System Variables
(defun PUSHVARS (VLIST)
(foreach PAIR VLIST
(setq
SYSVARS (cons
(cons
(strcase (car PAIR))
(getvar
(car PAIR)
)
)
SYSVARS
)
)
(if (cdr PAIR) (setvar (car PAIR) (cdr PAIR)))
)
)
;==========================================================
; Restore System Variables
(defun POPVARS ()
(foreach PAIR SYSVARS (setvar (car PAIR) (cdr PAIR)))
(setq
*error* OLD-ERROR
)
(setq SYSVARS nil)
)
;==========================================================
; Disallow transparent invocation of routine.
(defun NOTRANS ()
(cond
((zerop (logand (getvar "cmdactive") (+ 1 2 4 8))))
((alert
"This command may not be invoked transparently."
)
)
)
)
;==========================================================
; Item from association list
(defun ITEM (A B) (cdr (assoc A B)))
;============================================================
; Something for the eyes on the status line
(defun ENTERTAIN (PRMPT I SUFFIX)
(setvar "modemacro" (strcat PRMPT (itoa I) SUFFIX))
)
;=========================================================
; Apply func to every entity in ss
(defun MAPSET (FUNC SS PRMPT / I L SUFFIX ENAME MM)
(if SS
(progn
(setq
FUNC (eval FUNC)
I 0
L (sslength SS)
SUFFIX (strcat ":" (itoa L))
MM (getvar "modemacro")
)
(repeat
L
(setq ENAME (ssname SS 0) I (1+ I))
(ssdel
ENAME
SS
)
(if PRMPT (ENTERTAIN PRMPT I SUFFIX))
(FUNC
ENAME
)
)
(setvar "modemacro" MM)
)
)
)
;========================================================
; Return copy of selection set
(defun SSCOPY (SS)
(if SS (progn (command "_select" SS "") (ssget "p")))
)
;==========================================================
; Replace item in association list
(defun REPLACE (NEW_ITEM ALIST / OLD_ITEM)
(if (setq OLD_ITEM (assoc (car NEW_ITEM) ALIST))
(subst
NEW_ITEM
OLD_ITEM
ALIST
)
(append ALIST (list NEW_ITEM))
)
)
;==========================================================
; Decimal tab one text entity
(defun ONE_DTAB (ENAME / ENT VALUE I PREFIX)
(setq ENT (entget ENAME) VALUE (ITEM 1 ENT))
; Strip leading control characters
(while (< (substr VALUE 1 1) SP)
(setq
VALUE (substr VALUE 2)
)
)
; Add a backperiod plus backspace for each character before the period
(setq PREFIX BP I 1)
(while (/= (substr VALUE I 1) PER)
(setq
PREFIX (strcat BS PREFIX)
I (1+ I)
)
)
(setq VALUE (strcat PREFIX VALUE))
(entmod
(REPLACE (cons 1 VALUE) ENT)
)
)
;==========================================================
; Main Routine
(defun DTAB (/ SS2)
(if (null SS1)
(setq SS1 (ssget FILTER))
(princ
(strcat "\n" (itoa (sslength SS1)) " found.")
)
)
(cond
((null SS1))
(t
(setvar "highlight" 0)
(setq SS2 (SSCOPY SS1))
(MAPSET
'ONE_DTAB
SS1
"Justifying "
)
(command "_select" SS2 "")
(setq SS1 nil SS2 nil)
)
)
)
;==========================================================
; Body of c:dtab
(if (NOTRANS)
(progn
(setq OLD-ERROR *error* *error* ERROR UNDOIT t)
(setvar
"cmdecho" 0
)
(setq
FILTER '((0 . "TEXT")
(1 . "*`.*")
(72 . 0)
(73 . 0)
)
SS1 (ssget "I" FILTER)
)
(command "_undo" "_group")
(PUSHVARS
'(("modemacro") ("highlight"))
)
(DTAB)
(POPVARS)
(command "_undo" "_end")
)
)
(princ)
)
(princ
" DTAB.LSP (Copyright 1993 by Looking Glass Microproducts) loaded."
)
(princ)