(DEFUN *error* (msg)
(IF (OR (= msg "Function cancelled")
(= msg "quit / exit abort")
)
(PRINC)
(PRINC (STRCAT "\nError: " msg))
)
)
;;;reset system variables
(SETVAR "CMDECHO" 0)
(SETQ users1 "")
(SETQ users2 "")
(SETQ users3 "")
(COMMAND "units" "2" "4" "1" "3" "0" "n")
(SETVAR "osnapcoord" 1)
;;; system variables build-up
(DEFUN get_imf (/ dict)
(SETVAR
"useri5"
(COND ((SETQ dict (DICTSEARCH (NAMEDOBJDICT) "ACAD_IMAGE_VARS"))
(CDR (ASSOC 70 dict))
)
(T 1)
)
)
)
(SETQ users1 (RTOS (GETVAR "USERR1") 2 8))
(SETQ users2 (STRCAT "@" users1 "<90"))
(SETQ users3 (STRCAT "@" users1 "<270"))
(DEFUN setstline (/ stline)
(get_imf)
(SETQ
stline (STRCAT
"S+A PISOS: ""$(RTOS,$(GETVAR,USERR1),2,0)"
" - OSNAP: ""$(getvar,osmode)"
" - LTS: ""$(getvar,ltscale)"
" - PSLTS: ""$(getvar,psltscale)"
" - IMF: ""$(getvar,useri5)"
" - PJN: ""$(getvar,projectname)"
)
)
(SETVAR "modemacro" stline)
)
(setstline)
(PRINC)
;;;Useful UNDO BACK function
(DEFUN c:ub () (COMMAND "undo" "back"))
;;; Check for story height
(DEFUN c:pisos (/ dist)
(COMMAND "undo" "begin")
(SETQ dist 0)
(PRINC (STRCAT "\n[S+A PISOS] Distância actual entre pisos é "
users1
" unidades."
)
)
(SETQ dist (GETREAL "Qual a nova distância entre pisos? "))
(IF dist
(SETVAR "USERR1" dist)
)
(SETQ users1 (RTOS (GETVAR "USERR1") 2 8))
(SETQ users2 (STRCAT "@" users1 "<90"))
(SETQ users3 (STRCAT "@" users1 "<270"))
(setstline)
(PRINC)
(PRINC (STRCAT "\n[S+A PISOS] A distância entre pisos é agora de "
users1
" unidades."
)
)
(PRINC)
(COMMAND "undo" "end")
(PRINC)
)
;;;if story-height equals 0, msapisos has never been loaded. Call routine "pisos"
(DEFUN c:imf ()
(setstline)
(c:tframes)
(setstline)
(PRINC)
)
(DEFUN-Q
chkpisos
()
(IF (= (GETVAR "USERR1") 0.0)
(PROMPT
"\n \n ****************** MENSAGEM DE S+A PISOS ****************** \n AVISO! S+A pisos está activo, mas nunca foi utilizado.\n Use o commando PISOS para definir a distância entre pisos."
)
)
(IF (NOT (= (GETVAR "USERR1") 0.0))
(PROMPT
(STRCAT
"\n \n ****************** MENSAGEM DE S+A PISOS ****************** \n Distância entre pisos está definida para "
users1
" unidades\n Use o commando PISOS para definir outra distância entre pisos."
)
)
)
)
(DEFUN c:up ()
(COMMAND "undo" "begin")
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "-pan" "0,0,0" users3)
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "undo" "end")
)
(DEFUN c:up2 (/ tmp)
(SETQ tmp (STRCAT "@" (RTOS (/ (ATOF users1) 2) 2 😎 "<270"))
(COMMAND "undo" "begin")
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "-pan" "0,0,0" tmp)
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "undo" "end")
)
(DEFUN c:dn ()
(COMMAND "undo" "begin")
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "-pan" "0,0,0" users2)
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "undo" "end")
)
(DEFUN c:dn2 (/ tmp)
(SETQ tmp (STRCAT "@" (RTOS (/ (ATOF users1) 2) 2 😎 "<90"))
(COMMAND "undo" "begin")
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "-pan" "0,0,0" tmp)
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "undo" "end")
)
(DEFUN c:su (/ numpisos desloc_y valor)
(COMMAND "undo" "begin")
(SETQ numpisos (GETINT "[Storey Up - Go how many floors up?] Quantos pisos para cima? "))
(SETQ desloc_y (* numpisos (GETVAR "USERR1")))
(SETQ valor (RTOS desloc_y 2 4))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "-pan" "0,0,0" (STRCAT "@" valor "<270"))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "undo" "end")
)
(DEFUN c:sd (/ numpisos desloc_y valor)
(COMMAND "undo" "begin")
(SETQ numpisos (GETINT "[Storey Down - Go how many floors down?] Quantos pisos para baixo? "))
(SETQ desloc_y (* numpisos (GETVAR "USERR1")))
(SETQ valor (RTOS desloc_y 2 4))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "-pan" "0,0,0" (STRCAT "@" valor "<90"))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "undo" "end")
)
(DEFUN c:cu (/ ss)
(COMMAND "undo" "begin")
(PRINC
"[Copy Up - Select objects to copy one storey up...] Seleccione o que quer copiar para o piso acima...\n"
)
(SETQ ss (SSGET))
(IF ss
(PROGN (COMMAND "pickstyle" "1")
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "copy" ss "" "0,0,0" users2)
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "pickstyle" "1")
)
)
(PRINC)
(COMMAND "undo" "end")
)
(DEFUN c:cd (/ ss)
(COMMAND "undo" "begin")
(PRINC
"[Copy Down - Select objects to copy one storey down...] Seleccione o que quer copiar o piso abaixo...\n"
)
(SETQ ss (SSGET))
(IF ss
(PROGN (COMMAND "pickstyle" "1")
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "copy" ss "" "0,0,0" users3)
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "pickstyle" "1")
)
)
(PRINC)
(COMMAND "undo" "end")
)
(DEFUN c:mu (/ ss)
(COMMAND "undo" "begin")
(PRINC
"[Move Up - Select objects to move one storey up...] Seleccione o que quer mover para o piso acima...\n"
)
(SETQ ss (SSGET))
(IF ss
(PROGN (COMMAND "pickstyle" "1")
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "move" ss "" "0,0,0" users2)
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "pickstyle" "1")
)
)
(COMMAND "undo" "end")
)
(PRINC)
(DEFUN c:md (/ ss)
(COMMAND "undo" "begin")
(PRINC
"[Move Down - Select objects to move one storey down...] Seleccione o que quer mover para o piso abaixo...\n"
)
(SETQ ss (SSGET))
(IF ss
(PROGN (COMMAND "pickstyle" "1")
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "move" ss "" "0,0,0" users3)
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "pickstyle" "1")
)
)
(COMMAND "undo" "end")
)
(PRINC)
(DEFUN c:mcu (/ numpisos contador ss desloc_y valor)
(COMMAND "undo" "begin")
(PRINC
"[Multiple Copy Up - Select objects to copy up to each of the storeys...] Seleccione o quer copiar para cada um dos pisos acima...\n"
)
(SETQ ss (SSGET))
(if ss
(progn
(SETQ numpisos
(GETINT
"[Type the number of storeys you want the objects to be copied.] Introduza o numero de pisos para os quais quer copiar os itens. "
)
)
(SETQ contador numpisos)
(COMMAND "pickstyle" "1")
(WHILE (> contador 0)
(SETQ desloc_y (* contador (GETVAR "USERR1")))
(SETQ valor (RTOS desloc_y 2 4))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "copy" ss "" "0,0,0" (STRCAT "@" valor "<90"))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(SETQ contador (- contador 1))
)
(COMMAND "pickstyle" "1")
)
)
(COMMAND "undo" "end")
)
(DEFUN c:mcd (/ numpisos contador ss desloc_y valor)
(COMMAND "undo" "begin")
(PRINC
"[Multiple Copy Down - Select objects to copy down to each of the storeys...] Seleccione o quer copiar para cada um dos pisos abaixo...\n"
)
(SETQ ss (SSGET))
(if ss
(progn
(SETQ numpisos
(GETINT
"[Type the number of storeys you want the objects to be copied.] Introduza o numero de pisos para os quais quer copiar os itens. "
)
)
(SETQ contador numpisos)
(COMMAND "pickstyle" "1")
(WHILE (> contador 0)
(SETQ desloc_y (* contador (GETVAR "USERR1")))
(SETQ valor (RTOS desloc_y 2 4))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "copy" ss "" "0,0,0" (STRCAT "@" valor "<270"))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(SETQ contador (- contador 1))
)
(COMMAND "pickstyle" "1")
)
)
(COMMAND "undo" "end")
)
(DEFUN c:mun (/ numpisos ss desloc_y valor)
(COMMAND "undo" "begin")
(PRINC
"[Move Up to storey N - Select objects to move up...] Seleccione objectos a mover para cima...\n"
)
(SETQ ss (SSGET))
(if ss
(progn
(SETQ numpisos (GETINT "[Move to how many storeys up?] Mover quantos pisos para cima? "))
(COMMAND "pickstyle" "1")
(SETQ desloc_y (* numpisos (GETVAR "USERR1")))
(SETQ valor (RTOS desloc_y 2 4))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "move" ss "" "0,0,0" (STRCAT "@" valor "<90"))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "pickstyle" "1")
)
)
(COMMAND "undo" "end")
)
(DEFUN c:mdn (/ numpisos ss desloc_y valor)
(COMMAND "undo" "begin")
(PRINC
"[Move Down to storey N - Select objects to move down...] Seleccione objectos a mover para baixo...\n"
)
(SETQ ss (SSGET))
(if ss
(progn
(SETQ numpisos (GETINT "[Move how many storeys down?] Mover quantos pisos para baixo? "))
(COMMAND "pickstyle" "1")
(SETQ desloc_y (* numpisos (GETVAR "USERR1")))
(SETQ valor (RTOS desloc_y 2 4))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "move" ss "" "0,0,0" (STRCAT "@" valor "<270"))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "pickstyle" "1")
)
)
(COMMAND "undo" "end")
)
(DEFUN c:cun (/ numpisos ss desloc_y valor)
(COMMAND "undo" "begin")
(PRINC
"[Copy Up to storey N - Select objects to copy up...] Seleccione objectos a copiar para cima...\n"
)
(SETQ ss (SSGET))
(if ss
(progn
(SETQ numpisos (GETINT "[Copy how many storeys up?] Copiar quantos pisos para cima? "))
(COMMAND "pickstyle" "1")
(SETQ desloc_y (* numpisos (GETVAR "USERR1")))
(SETQ valor (RTOS desloc_y 2 4))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "copy" ss "" "0,0,0" (STRCAT "@" valor "<90"))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "pickstyle" "1")
)
)
(COMMAND "undo" "end")
)
(DEFUN c:cdn (/ numpisos ss desloc_y valor)
(COMMAND "undo" "begin")
(PRINC
"[Copy Down to storey N - Select objects to copy down...] Seleccione objrctos a copiar para baixo...\n"
)
(SETQ ss (SSGET))
(if ss
(progn
(SETQ numpisos (GETINT "[Copy how many storeys down?] Quantos pisos para baixo? "))
(COMMAND "pickstyle" "1")
(SETQ desloc_y (* numpisos (GETVAR "USERR1")))
(SETQ valor (RTOS desloc_y 2 4))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "w")
(COMMAND "copy" ss "" "0,0,0" (STRCAT "@" valor "<270"))
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "ucs" "p")
(COMMAND "pickstyle" "1")
)
)
(COMMAND "undo" "end")
)
(SETQ s::startup (APPEND s::startup chkpisos))
(PROMPT
"\n ****************** S+A PISOS está carregado no Autocad ****************** \n"
)
(PRINC)
