Anuncios

The Autodesk Community Forums has a new look. Read more about what's changed on the Community Announcements board.

jmdclemente
Explorer
en respuesta a: jmdclemente
‎06-05-2021 09:42 AM
‎06-05-2021 09:42 AM

(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 :cara_con_gafas_de_sol: "<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 :cara_con_gafas_de_sol: "<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)
msa_pisos.lsp
Denunciar
0 Me gusta
Responder
Report a website issue