Estes são alguns dos arquivos com rotinas AutoLISP©, que fazem parte do "Curso E.Fernal de AutoLISP©".
O objetivo deste curso é dar ao usuário do AutoCAD© conhecimentos suficientes de programação nesta poderosa linguagem, habilitando-o a desenvolver suas próprias rotinas e assim aumentar sua performance e produtividade.


;;--------------------------------------------------------------------------	ARQUIVO 01
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

(DEFUN c:ponto1	(/ ponto)
  (SETVAR "CMDECHO" 0)
  (ALERT
    "Esta função irá solicitar o fornecimento (opcional) de um ponto..."
  )
  (SETQ ponto (GETPOINT "\n-> Forneça um ponto : "))
  (IF ponto
    (ALERT (STRCAT "Você forneceu o ponto \n( "
		   (RTOS (CAR ponto) 2 (GETVAR "LUPREC"))
		   "\t"
		   (RTOS (CADR ponto) 2 (GETVAR "LUPREC"))
		   "\t"
		   (RTOS (CADDR ponto) 2 (GETVAR "LUPREC"))
		   ")"
	   )
    )
    (ALERT "Você não forneceu nenhum ponto...")
  )
  (PRINC )
)

;; fim da rotina

;| início de comentários sobre esta função
	
	Os textos entre [ ] são opcionais, podem ou não ser incluidos...

	DEFUN é a função do AutoLISP que define uma nova função.
		'DEfine FUNction'
		
		Sintaxe
			(DEFUN [c:]nome-da-funcao ( [argumentos] / [variaveis-locais] )
			    ...expressoes...
			   [...expressoes...]
			   [................]
			   [...expressoes...]
			)
			
			Quando o nome da função é precedido por c:, como neste
			exemplo, então ao se carregar o arquivo será criado um
			novo comando. Para executar este comando, bastando digitar
			este nome, sem o C:
			Caso contrário, será necessário digitar o nome da função
			entre parênteses.
			Toda nova função criada com o AutoLISP sobrepõe-se às
			já existentes, portanto você deve assegurar-se de não
			utilizar nomes já existentes. Para checar, você pode
			utilizar a função ATOMS-FAMILY do AutoLISP ou digitar
			!nome-da-funcao e teclar Enter. Caso o retorno seja nil,
			então até este momento o nome está disponível.
			Argumentos devem ser passados somente para funções sem C:,
			embora possam ser passados nos dois casos.
			Você deve declarar como locais as variáveis que somente
			serão utilizadas nesta rotina, para evitar que as mesmas
			permaneçam na memória inutilmente.
			
****************************************************************************************
	SETVAR é a função do AutoLISP que permite alterar uma variável
		de sistema do AutoCAD©
****************************************************************************************
	"CMDECHO" é a variável de sistema do AutoCAD© que define se o echo
		dos comandos será ou não eliminado. 0 (zero) elimina o echo,
		e 1 o habilita.
		Obs.: 	Não há nenhum sentido em habilitá-lo, exceto quando estamos
			programando e desejamos acompanhar uma determinada etapa de
			procedimentos.
****************************************************************************************
	ALERT é a função do AutoLISP que apresenta o quadro de mensagens
		AutoCAD Message - Esta função exige um só argumento,
		e este tem quer ser um string de caracteres...
		(strings são caracteres entre aspas)
****************************************************************************************
	SETQ é a função do AutoLISP que atribui a uma variável um valor
		Sintaxe
			(SETQ 	variavel1 valor1
				[variavel2 valor2]
				[variaveln valorn]				
				[variavel255 valor255]
			)
****************************************************************************************
	GETPOINT é a função AutoLISP que solicita ao operador o fornecimento
		de um ponto, seja clicando ou entrando pelo teclado.
****************************************************************************************
	IF é uma função que existe em todas linguagens de programação e quer dizer
		SE.
		Sintaxe
			(IF condicao
				expressao1
				[expressao2]
			)
			Se a condição 'condicao' for verdadeira, então a função
			executará a expressão 'expressao1'. Caso contrário,
			executará a expressão 'expressao2', se esta estiver
			presente.
****************************************************************************************
	STRCAT é a função do AutoLISP que concatena (une) dois ou mais strings de
		caracteres.
		Sintaxe
			(STRCAT string1 string2 [string3] [string-n] )
			Exemplo :
				(STRCAT	"Este "
					"é um string "
					"formado por "
					" 4 sub-strings"
				)
				retorna
				 "Este é um string formado por 4 sub-strings"
****************************************************************************************
	RTOS é a função do AutoLISP que converte um número real em string.
		(Real TO String)
		Vide opçoes para RTOS no catálogo de funções
		Exemplos :
			(RTOS 12.5589 1 4)	-> retorna "1.2559E+01"
			(RTOS 12.5589 2 4)	-> retorna "12.5589"
			(RTOS 12.5589 3 4)	-> retorna "1'-0.5589""
			(RTOS 12.5589 4 4)	-> retorna "1'-0 9/16""
			(RTOS 12.5589 5 4)	-> retorna "12 9/16"
****************************************************************************************
	CAR é a função do AutoLISP que retorna o primeiro elemento de uma lista.
		Sintaxe
			(CAR lista)
			Exemplos :
				(CAR (LIST 1 2 3)) -> retorna 1
				(CAR (LIST 3 2 1)) -> retorna 3
****************************************************************************************
	GETVAR é a função do AutoLISP que recupera o valor de uma variável de		
		sistema do AutoCAD©
		Sintaxe
			(GETVAR variavel-de-sistema)
				variavel-de-sistema deve ser o nome da variavel
				desejada, em STRING
				Utilize o comando SETVARS deste curso para
				conhecer estas variáveis.
****************************************************************************************
	"LUPREC" é a variável de sistema do AutoCAD© que armazena o número
		de casas decimais. Você pode alterar este valor digitando, na linha
		de comandos do AutoCAD© a palavra LUPREC . Tecle Enter e defina o
		valor desejado que deve estar entre 0 e 16
****************************************************************************************
	PRINC  é a função do AutoLISP que envia um string para a linha de
		comandos ou para um arquivo. Se usada sem argumentos, elimina o
		último retorno do AutoLISP. Sempre usada ao fim dos comandos
		definidos com AutoLISP, para uma saida silenciosa e elegante.
			Sintaxe
				(PRINC  [string [arquivo]])
****************************************************************************************
	Fim de comentários
|;	

;;--------------------------------------------------------------------------	ARQUIVO 02
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

(DEFUN c:ponto2	(/ ponto)
  (SETVAR "CMDECHO" 0)
  (ALERT
    "Esta função irá solicitar o fornecimento (obrigatório) de um ponto..."
  )
  (INITGET 1)
  (SETQ ponto (GETPOINT "\n-> Forneça um ponto : "))
  (ALERT (STRCAT "Você forneceu o ponto \n( "
		 (RTOS (CAR ponto) 2 (GETVAR "LUPREC"))
		 "\t"
		 (RTOS (CADR ponto) 2 (GETVAR "LUPREC"))
		 "\t"
		 (RTOS (CADDR ponto) 2 (GETVAR "LUPREC"))
		 ")"
	 )
  )
  (PRINC )
)

;; fim da rotina

;| início de comentários sobre esta função
	
	Os textos entre [ ] são opcionais, podem ou não ser incluidos...

	INITGET é a função do AutoLISP que define qual opção será tomada
	para uma função seguinte, que deverá ser uma destas :

		ENTSEL
		NENTSEL
		NENTSELP
		GETINT
		GETREAL
		GETDIST
		GETANGLE
		GETORIENT
		GETPOINT
		GETCORNER
		GETKWORD

		Os bits de controle mais usados são :

		1 - Impede que a resposta seja um toque na barra de espaço
		2 - Impede que a resposta seja 0 (zero)
		4 - Impede que a resposta seja um número negativo
		8 - Permite fornecer um ponto fora dos limites definidos

		É válida a soma dos bits, portanto
		(INITGET 7) -> ou 1 + 2 + 4
			impede a entrada de um número que não seja maior
			que zero.

	fim de comentários
|;

;;--------------------------------------------------------------------------	ARQUIVO 03
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

(DEFUN c:real1 (/ numero)
  (SETVAR "CMDECHO" 0)
  (ALERT
    "Esta função irá solicitar o fornecimento (opcional) de um número real..."
  )
  (SETQ numero (GETREAL "\n-> Forneça um número : "))
  (IF numero
    (ALERT (STRCAT "Você forneceu o número " (RTOS numero 2 5)))
    (ALERT "Você não forneceu nenhum número...")
  )
  (PRINC )
)

 ;; fim da rotina

;| início de comentários sobre esta função
		
	GETREAL é a função do AutoLISP que permite ao operador fornecer
	um número real, através do teclado. Caso não seja utilizada a
	função INITGET, a entrada pelo usuário poderá ser nula, caso
	se tecle Enter ou a barra de espaços sem antes digitar um
	número qualquer.
	Vide 'Como obter um número real, 2' como forçar o usuário a
	realmente fornecer um número.

	fim de comentários
|;

;;--------------------------------------------------------------------------	ARQUIVO 04
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

(DEFUN c:real2 (/ numero)
  (SETVAR "CMDECHO" 0)
  (ALERT
    "Esta função irá solicitar o fornecimento (obrigatório) de um número real..."
  )
  (INITGET 1)
  (SETQ numero (GETREAL "\n-> Forneça um número : "))
  (ALERT
    (STRCAT "Você forneceu o número   " (RTOS numero 2 5))
  )
  (PRINC )
)

;; fim da rotina

;| início de comentários sobre esta função

	A função INITGET foi usado com o bit 1, que impede que se
	tecle Enter ou a barra de espaços como resposta.
	Deste modo, enquanto o operador não digitar um número, seja
	negativo, zero ou maior que zero, o AutoLISP seguirá pedindo
	por um número real.

	fim de comentários
|;	

;;--------------------------------------------------------------------------	ARQUIVO 05
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

(DEFUN c:real3 (/ numero)
  (SETVAR "CMDECHO" 0)
  (ALERT
    (STRCAT "Esta função irá solicitar o fornecimento"
	    "\n(obrigatório) de um número real dIFerente de zero..."
    )
  )
  (INITGET 3)
  (SETQ numero (GETREAL "\n-> Forneça um número : "))
  (ALERT (STRCAT "Você forneceu o número " (RTOS numero 2 5)))
  (PRINC )
)

;; fim da rotina

;| início de comentários sobre esta função

	A função INITGET foi usado com o bit 3, que impede que se
	tecle Enter, a barra de espaços ou ainda 0 (ZERO) como resposta.
	Deste modo, enquanto o operador não digitar um número DIFERENTE
	de zero, o AutoLISP seguirá pedindo por um número real.

	fim de comentários
|;

;;--------------------------------------------------------------------------	ARQUIVO 06
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

(DEFUN c:real4 (/ numero)
  (SETVAR "CMDECHO" 0)
  (ALERT
    (STRCAT "Esta função irá solicitar o fornecimento"
	    "\n(obrigatório) de um número real MAIOR que zero..."
    )
  )
  (INITGET 7)
  (SETQ numero (GETREAL "\n-> Forneça um número : "))
  (ALERT
    (STRCAT "Você forneceu o número " (RTOS numero 2 5))
  )
  (PRINC )
)
;; fim da rotina

;| início de comentários sobre esta função

	A função INITGET foi usado com o bit 7, que impede que se
	tecle Enter, a barra de espaços, 0 (ZERO) ou um número menor que 0
	como resposta.
	Deste modo, enquanto o operador não digitar um número MAIOR QUE
	ZERO, o AutoLISP seguirá pedindo por um número real.

	fim de comentários
|;

;;--------------------------------------------------------------------------	ARQUIVO 07
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

Quadro de diálogo desta rotina


(DEFUN c:entrar (/ dh [email protected])
  (SETVAR "CMDECHO" 0)
  (IF (> (SETQ dh (LOAD_DIALOG "c:\\curso\\dcl\\curso.dcl")) 0)
    (IF	(NEW_DIALOG "ENTRADAS" dh)
      (PROGN
	(IF ((NOT dado1)
	  (SETQ dado1 "100")
	)
	(IF ((NOT dado2)
	  (SETQ dado2 "200")
	)
	(IF ((NOT dado3)
	  (SETQ dado3 "300")
	)
	(IF ((NOT dado4)
	  (SETQ dado4 "400")
	)
	(SET_TILE "dado1" dado1)
	(SET_TILE "dado2" dado2)
	(SET_TILE "dado3" dado3)
	(SET_TILE "dado4" dado4)
	(ACTION_TILE
	  "dado1"
	  "(SETQ dado1 $value)(check_number dado1)"
	)
	(ACTION_TILE
	  "dado2"
	  "(SETQ dado2 $value)(check_number dado2)"
	)
	(ACTION_TILE
	  "dado3"
	  "(SETQ dado3 $value)(check_number dado3)"
	)
	(ACTION_TILE
	  "dado4"
	  "(SETQ dado4 $value)(check_number dado4)"
	)
	(ACTION_TILE "cancel" "(DONE_DIALOG 0)")
	(ACTION_TILE "accept" "(DONE_DIALOG 1)")
	(ACTION_TILE
	  "help"
	  "(ALERT \"Rotina de demonstração de como entrar com\ndados em um quadro de diálogo.\")"
	)
	(SETQ [email protected] (START_DIALOG))
	(UNLOAD_DIALOG dh)
	(COND ((= [email protected] 0) (PRINC  "\n-> Cancelado..."))
	      ((= [email protected] 1)
	       (ALERT "Nesta parte você deve continuar o programa...")
	      )
	)
      )
      nil
    )
    (ALERT "Arquivo DCL não pôde ser carregado...")
  )
  (PRINC )
)

 ;|	fim da rotina

	início de comentários

	LOAD_DIALOG é a função AutoLISP que carrega para a memória um arquivo .DCL,
		que contém definições de quadros de diálogo do AutoCAD©.
		Se este carregamento for bem sucedido, o retorno será um número
		inteiro MAIOR que zero. Caso contrário, a função retornará zero ou
		menor que zero, indicando o fracasso do carregamento.
		Podemos armazenar este valor em uma variável, no caso 'dh', e
		prosseguir com a rotina somente no caso de sucesso do carregamento,
		isto é, se 'dh' for maior que zero.
***************************************************************************************
	NEW_DIALOG é a função que localiza, dentro do conteudo do arquivo .DCL
		carregado pela função LOAD_DIALOG, por um determinado quadro, neste
		exemplo "ENTRADAS".
		Se localizado e correto, então o quadro é lançado na tela.
		Em DCL, MAIÚSCULAS são diferentes de MINÚSCULAS, portanto poderíamos
		ter, no mesmo arquivo, um quadro com o nome de "ENTRADAS", outro com
		o nome de "entradas", ainda outro com o nome de "Entradas" e assim
		por diante. A linguagem DCL segue a sintaxe de C
		Se a função fracassar, isto é, se no arquivo DCL carregado não houver
		(neste exemplo) o quadro "ENTRADAS", o AutoLISP automaticamente
		enviará uma mensagem de erro padrão. Observe que, por isso, retornamos
		'nil' no nosso código.
**************************************************************************************
	PROGN é uma função que permite diversas expressões AutoLISP. Ela foi utilizada
		porque a função IF só permite avaliar uma expressão, caso o retorno seja
		verdadeiro, e uma expressão alternativa, caso contrário.
		
	Dentro deste PROGN
		Como, até aqui, tudo está OK, inicializamos as variáveis globais, que
		chamamos de 'DADO1', 'DADO2', 'DADO3' e 'DADO4'. Estas devem ser
		strings de caracteres ou então, convertidas para este tipo de átomo,
		pois, em um quadro de diálogo, sòmente strings são permitidas.
		Observe a expressão

			(IF ((NOT dado1)
			  (SETQ dado1 "100")
			)

		Ela diz o seguinte :

			Se a variável 'dado1' não tiver valor, isto é, for 'nil',
			então atribua a ela o valor de "100"

			Obviamente, se ela tiver valor, suponhamos "345.45", nada
			será feito e ela, portanto, continuará com este valor.

		Idem para as demais variáveis 'dado2', 'dado3' e 'dado4'

		Um outro modo seria :

			(IF dado1 
				nil
				(SETQ dado1 "100")
			)
			
			que quer dizer :

				Se a variável 'dado1' tiver valor, isto é, for 
				diferente de 'nil', então 'nil', isto é, não faça
				nada. Caso contrário, atribua à variável 'dado1'
				o valor de "100"
		
**************************************************************************************
	SET_TILE é a função AutoLISP que insere um valor em um 'tile' de um
		quadro de diálogo.
		Neste exemplo, os tiles são do tipo 'edit_box', ou campo de edição
		de textos.
**************************************************************************************
	ACTION_TILE é a função AutoLISP que permite chamar uma função 'callback'
		ao se selecionar um 'tile' em um quadro de diálogo do AutoCAD©.
		A expressão
			(ACTION_TILE
			  "dado1"
			  "(SETQ dado1 $value)(check_number dado1)"
			)

		significa o seguinte :
			execute as expressões
				(SETQ dado1 $value)(check_number dado1)
			para o tile cuja identificador, ou $key, é "dado1"

		Observe que os parâmetros para ACTION_TILE são dois strings:
			o primeiro é a chave do tile, exatamente como definido
			no arquivo .DCL e o segundo um string representando
			expressões válidas para o AutoLISP.
**************************************************************************************
	DONE_DIALOG é a função do AutoLISP que se aplica para qualquer um
		dos tiles do quadro de diálogo. Normalmente é utilizada nos
		tiles "cancel", "accept", "help" e "info", mas você poderá
		utilizá-la onde quizer.
		Ela retorna sempre um inteiro, que poderá ser pré-determinado,
		caso você o forneça.
		Sintaxe
			(DONE_DIALOG [inteiro-de-retorno])
			
			
**************************************************************************************
	START_DIALOG é a função que retira o quadro de diálogo da tela e retorna
		o 'inteiro-de-retorno' especificado por cada chamada da função
		DONE_DIALOG.
		Armazenando este 'inteiro-de-retorno' em uma variável,
			podemos encaminhar a rotina para uma opção entre
			muitas.
			No exemplo acima, a expressão
				(SETQ [email protected] (START_DIALOG))
				armazena 'inteiro-de-retorno' em '[email protected]', sendo que :

					[email protected] = 1 se o usuário clicou o botão "Ok"
					[email protected] = 0 se o usuário clicou o botão "Cancel"
**************************************************************************************
	UNLOAD_DIALOG é a função que elimina da memória todo o conteudo do arquivo
		.DCL carregado pela função LOAD_DIALOG e cujo ponteiro identificador
		foi, neste exemplo, atribuido à variável 'dh'.
**************************************************************************************
	COND é uma função do AutoLISP equivalente à "select case" do VB, à "case" do
		DELPHI, "switch" do C.
		Ela avalia as expressões em sequência e retorna a primeira avaliação
		que resultar verdadeira.
		Uma alternativa pode ser fornecida, e deve ser inserida em último
		lugar, através da função 'T' (que significa TRUE, ou verdadeiro).
		Exemplo :
			(COND
			  ((> 1 5) (ALERT "1 é maior que cinco"))
			  ((< 5 1) (ALERT "5 é menor que 1"))
			  ((= "a" "b")
			   (ALERT "A letra 'a' é igual à letra 'b'")
			  )
			  (T
			   (ALERT
			     (STRCAT
			       "Esta mensagem será sempre exibida, pois todas"
			       "\nas expressões anteriores são bobagens..."
			     )
			   )
			  )
			)
***************************************************************************************

	fim de comentários
|;

;;--------------------------------------------------------------------------	ARQUIVO 08
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

(DEFUN c:associacao () (le-arquivo "DXF" ".TXT") (PRINC ))

;| 	inicio de comentários

	Neste caso, definimos o comando ASSOCIACAO, que executa a função
	le-arquivo, que por sua vez está definida no arquivo LISP001.LSP.
	Observe o código fonte desta função :

(DEFUN le-arquivo (arquivo  extensao /	      arq      linha
		   lista    dh	     [email protected]	      narq     diretorio
		   mensagem
		  )
  (SETVAR "CMDECHO" 0)
  (SETQ	diretorio (SUBSTR extensao 2)
	narq	  nil
	narq	  (FINDFILE
		    (STRCAT "C:\\CURSO\\" diretorio "\\" arquivo extensao)
		  )
  )
  (IF (AND narq (SETQ arq (OPEN narq "r")))
    (PROGN
      (WHILE (SETQ linha (READ-LINE arq))
	(SETQ lista (APPEND lista (LIST linha)))
      )
      (CLOSE arq)
      (IF (> (SETQ dh (LOAD_DIALOG "C:\\CURSO\\DCL\\CURSO.DCL")) 0)
	(IF (NEW_DIALOG "curso001" dh)
	  (PROGN (SET_TILE
		   "texto"
		   (SETQ mensagem
			  (STRCAT "Arquivo C:\\CURSO\\"
				  diretorio
				  "\\"
				  (STRCASE arquivo)
				  extensao
			  )
		   )
		 )
		 (START_LIST "lista")
		 (MAPCAR 'ADD_LIST lista)
		 (END_LIST)
		 (SET_TILE "lista" "18")
		 (ACTION_TILE "accept" "(DONE_DIALOG 2)")
		 (ACTION_TILE "cancel" "(DONE_DIALOG 0)")
		 (ACTION_TILE "abrir" "(DONE_DIALOG 1)")
		 (ACTION_TILE
		   "help"
		   "(ALERT (STRCAT \"Este é o \" mensagem))"
		 )
		 (SETQ [email protected] (START_DIALOG))
		 (UNLOAD_DIALOG dh)
		 (COND ((= [email protected] 0) (PRINC  "\n-> Encerrado..."))
		       ((= [email protected] 2) (PRINC  "\n-> Ok, saindo da rotina..."))
		       ((= [email protected] 1)
			((STARTAPP
			  (STRCAT "NOTEPAD.EXE"
				  " C:\\CURSO\\"
				  diretorio
				  "\\"
				  arquivo
				  extensao
			  )
			)
		       )
		 )
	  )
	  nil
	)
	(ALERT "Arquivo DCL não pôde ser carregado...")
      )
    )
    (ALERT (STRCAT "C:\\CURSO\\"
		   diretorio
		   "\\"
		   (STRCASE arquivo)
		   (STRCASE extensao)
		   " não encontrado!"
	   )
    )
  )
  (PRINC )
)

e aqui, como esta única função é usada para criar comandos diversos,
	com um único trabalho...
	
(DEFUN c:sintaxe () (le-arquivo "SINTAXE" ".TXT") (PRINC ))
(DEFUN c:cur-intro () (le-arquivo "INTRO" ".TXT") (PRINC ))
(DEFUN c:funcoes () (le-arquivo "FUNCOES" ".TXT") (PRINC ))
(DEFUN c:ASSOCiacao () (le-arquivo "DXF" ".TXT") (PRINC ))
(DEFUN c:estrutura () (le-arquivo "ESTRUT" ".TXT") (PRINC ))
(DEFUN c:lisp001 () (le-arquivo "LISP001" ".LSP") (PRINC ))
(DEFUN c:SETVARs () (le-arquivo "SETVAR" ".TXT") (PRINC ))
(DEFUN c:dcls () (le-arquivo "CURSO" ".DCL") (PRINC ))
(DEFUN c:compdcls () (le-arquivo "COMPDCL" ".DCL") (PRINC ))
(DEFUN c:listas () (le-arquivo "LISTAS" ".TXT") (PRINC ))
(DEFUN c:cur-aju () (le-arquivo "CUR-AJU" ".TXT") (PRINC ))
(DEFUN c:forb () (le-arquivo "FORB" ".TXT") (PRINC ))
(DEFUN c:slides () (le-arquivo "SLIDES" ".LSP") (PRINC ))
(DEFUN c:global () (le-arquivo "GLOBAL" ".LSP") (PRINC ))

	fim de comentários
|;

;;--------------------------------------------------------------------------	ARQUIVO 09
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

(DEFUN c:comenta ()
  (ALERT
   ;|
		este trecho é um comentário desde a palavra
		'este' e encerrando-se na palavra
		'término'
				|;
	 "Neste comando existe um comentário INLINE"
  )
);|	INICIO DE COMENTARIOS 1
	Estas rotinas fazem parte do curso E.Fernal de AutoLISP
	http://www.gr-acad.com.br

Demonstraremos como inserir slides em uma imagem de um quadro de diálogo,
através do comando 'SLIDES1'
Após Ok, digite SLIDES1 e tecle Enter para conferir...

A rotina utiliza um arquivo .DCL, que é C:\\CURSO\DCL\SLIDES.DCL, cujo
conteudo são as linhas abaixo, até a marca 'EOF'

slides : dialog { label = "Curso E.Fernal de AutoLISP";
:text{label="Como inserir slides";alignment=centered;key="tx1";}
:row{
:column{
:image_button{key="i1";width=16;aspect_ratio=0.66;color=0;}
:image_button{key="i4";width=16;aspect_ratio=0.66;color=0;}
:image_button{key="i7";width=16;aspect_ratio=0.66;color=0;}}
:column{
:image_button{key="i2";width=16;aspect_ratio=0.66;color=0;}
:image_button{key="i5";width=16;aspect_ratio=0.66;color=0;}
:image_button{key="i8";width=16;aspect_ratio=0.66;color=0;}}
:column{
:image_button{key="i3";width=16;aspect_ratio=0.66;color=0;}
:image_button{key="i6";width=16;aspect_ratio=0.66;color=0;}
:image_button{key="i9";width=16;aspect_ratio=0.66;color=0;}}
}
spacer_1;
:row{
:toggle{key="to1";label="moldura";}
ok_cancel_help;
}}

	'EOF de C:\CURSO\DCL\SLIDES.DCL

Criaremos agora o comando SLIDES1 para carregar este dcl e inserir slides no mesmo.
Deveremos ter a biblioteca de slides C:\CURSO\SLB\SLB001.SLB, que deverá conter os
slides 'teste1', 'teste2', 'teste3' ... até 'teste9'

	FIM DE COMENTARIOS 1
|;
Quadro de diálogo desta rotina


(DEFUN c:slides1 (/ dcl_id dcl_response x moldura flip last_pick)
  (SETVAR "CMDECHO" 0)
  ;;--A função abaixo é um exemplo de uma função 'call-back', que será executada ao
  ;;--se clicar em um elemento do quadro de diálogo, no caso o TOGGLE "to1"
  (DEFUN moldura (value / color)
    (IF	(= value "1")
      (SET_TILE
	"tx1"
	"moldura em resposta à função 'call-back'"
      )
      (SET_TILE "tx1" "Eliminamos a moldura...")
    )
    (FOREACH
	   x '("i1" "i2" "i3" "i4" "i5" "i6" "i7" "i8" "i9")
      (SETQ color (COND	((= value "1") 1)
			((= value "0") 0)
		  )
      )
      (START_IMAGE x)
      (FILL_IMAGE 0 0 (DIMX_TILE x) 5 color)
      (FILL_IMAGE 0 0 5 (DIMY_TILE x) color)
      (FILL_IMAGE
	0
	(- (DIMY_TILE x) 5)
	(DIMX_TILE x)
	(DIMY_TILE x)
	color
      )
      (FILL_IMAGE
	(- (DIMX_TILE x) 5)
	0
	(DIMX_TILE x)
	(DIMY_TILE x)
	color
      )
      (END_IMAGE)
    )
  )
  ;;--FIM DA FUNÇÃO 'call-back' QUE SERÁ EXECUTADA AO SE CLICAR NO toggle
  ;;--Inicio da função 'call-back' flip
  (DEFUN flip (key)
    (IF	last_pick
      (MODE_TILE last_pick 4)
    )
    (MODE_TILE key 4)
    (SETQ last_pick key)
    (SET_TILE "tx1" (STRCAT "Iluminando a imagem " key))
  )
  ;;--FIM DE flip
  (IF (> (SETQ dcl_id (LOAD_DIALOG "c:\\curso\\dcl\\slides.dcl"))
	 0
      )
    (IF	(NEW_DIALOG "slides" dcl_id)
      (PROGN
	;|
	(ALERT (STRCAT "dx = "
		       ((ITOA (DIMX_TILE "i1"))
		       "\ndy = "
		       ((ITOA (DIMY_TILE "i1"))
	       )
	)
	;;	(DIMX_TILE = 96
	;;	(DIMY_TILE = 63
	|;
	(FOREACH
	       x '("i1" "i2" "i3" "i4" "i5" "i6" "i7" "i8" "i9")
	  (START_IMAGE x)
	  (SLIDE_IMAGE
	    5
	    5
	    (- (DIMX_TILE x) 5)
	    (- (DIMY_TILE x) 10)
	    (STRCAT "c:\\curso\\slb\\slb001(teste" (SUBSTR x 2) ")")
	  )
	  (END_IMAGE)
	)
	(FOREACH
	       x '("i1" "i2" "i3" "i4" "i5" "i6" "i7" "i8" "i9")
	  (ACTION_TILE x "(flip $key)")
	)
	(ACTION_TILE "to1" "(moldura $value)")
	(ACTION_TILE "accept" "(DONE_DIALOG 1)")
	(ACTION_TILE "cancel" "(DONE_DIALOG 0)")
	(ACTION_TILE
	  "help"
	  "(ALERT \"Mensagem para ajuda deve ser aqui, ou então utilizar uma função call-back\")"
	)
	(SETQ dcl_response (START_DIALOG))
	(UNLOAD_DIALOG dcl_id)
	(COND ((= dcl_response 0)
	       (ALERT "Você saiu apertando 'Cancel'...")
	      )
	      ((= dcl_response 1)
	       (ALERT "Programar algo de útil neste campo...")
	      )
	)
      )
      nil
    )
    (ALERT
      "Arquivo C:\\CURSO\\DCL\\SLIDES.DCL não pôde ser carregado..."
    )
  )
  (PRINC )
)

;;--------------------------------------------------------------------------	ARQUIVO 10
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

(DEFUN c:slides2 (/	       dh	    [email protected]		 ajuda
		  executiva-aqui	    bloco-a-inserir
		  lista	       selecionar
		 )
  (SETVAR "CMDECHO" 0)
  (SETQ	p1 nil
	lista '()
	bloco-a-inserir	nil
  )
  ;;---------------------------------------------------------------
  ;;funcoes locais, exigidas se o usuário pressionar o botão "Help"
  ;;ou o botão "Ok"
  ;;
  ;; A função abaixo será disparada toda vez que o usuário clicar no botao "Help"
  (DEFUN ajuda ()
    (ALERT
      (STRCAT "Este texto pode ser substituido por uma mensagem mais"
	      "\nadequada à cada uma das rotinas."
	      "\nEste é somente um exemplo..."
      )
    )
  )
  ;; A função abaixo será executada toda vez que o usuário clicar um item
  ;; na lista de blocos disponíveis...
  (DEFUN selecionar (value / dx dy)
    (SETQ bloco-a-inserir (NTH (ATOI value) lista)
	  dx		  (DIMX_TILE "imagem")
	  dy		  (DIMY_TILE "imagem")
    )
    ;;(ALERT (STRCAT "Dx = " ((ITOA dx) "\nDy = " ((ITOA dy)))
    ;; ALERT acima retornou dx = 180 e dy = 180
    (SET_TILE "saida" (STRCAT "Inserir " bloco-a-inserir))
    (START_IMAGE "imagem")
    (FILL_IMAGE 0 0 dx dy 0)
    (SLIDE_IMAGE
      0
      0
      dx
      dy
      (STRCAT "c:\\curso\\slb\\slb001(" bloco-a-inserir ")")
    )
    (END_IMAGE)
    bloco-a-inserir
  )
  ;; A função abaixo será disparada se o usuário clicar no botão "Ok"
  (DEFUN executiva-aqui	(/ p1)
    (IF	bloco-a-inserir
      (IF (SETQ
	    p1 (GETPOINT "\n-> Selecione ponto de inserção do bloco : ")
	  )
	(ALERT
	  (STRCAT
	    "Você forneceu o ponto..."
	    "\nNeste trecho, a rotina deverá ser programada para"
	    "\ninserir o bloco selecionado, se encontrado..."
	    "\nIsto deverá ser feito substituindo-se este 'ALERT' por"
	    "\nexpressões AutoLISP que localizem o arquivo externo e/ou"
	    "\no bloco na tabela de blocos, inserindo-o ou com o comando"
	    "\n'INSERT' ou usando a função (ENTMAKE '((0 . \"INSERT\")....))"
	    "\nO comandos SLIDES3 é uma réplica deste, inserindo blocos...")
	)	
	(ALERT "Ponto de inserção não foi fornecido...")
      )
      (ALERT "Bloco não foi selecionado...")
    )
  )
  ;;-----------------------------------------FIM DAS FUNCOES LOCAIS
  (IF (> (SETQ dh (LOAD_DIALOG "C:\\CURSO\\DCL\\SLIDES2.DCL")) 0)
    (IF	(NEW_DIALOG "slides2" dh)	; o nome do quadro tem que ser exatamente o
					; mesmo do arquivo .DCL, inclusive respeitando
					; minúsculas e maísculas
      (PROGN ;; Criamos uma lista com o nome dos blocos disponíveis
	     (SETQ lista '("Bloco1"	"Bloco2"     "Bloco3"
			   "Bloco4"	"Bloco5"     "Bloco6"
			   "Bloco7"	"Bloco8"     "Bloco9"
			   "Bloco10"
			  )
	     )
	     ;; Inserimos esta lista no campo 'list_box' do quadro de diálogo
	     (START_LIST "lista")	; esta chave "lista" deve ser exatamente igual
					; ao que foi escrito no arquivo .DCL
	     (MAPCAR 'ADD_LIST lista)
	     (END_LIST)
	     ;; Ok, a lista foi inserida no quadro de diálogo.
	     (ACTION_TILE "accept" "(DONE_DIALOG 1)")
	     (ACTION_TILE "cancel" "(DONE_DIALOG 0)")
	     (ACTION_TILE "lista" "(selecionar $value)")
	     (ACTION_TILE "help" "(ajuda)")
	     ;;apertar "Help" dispara a funcao 'ajuda'
	     (SETQ [email protected] (START_DIALOG))
	     ;;Aqui o quadro de diálogo é retirado
					; da tela
	     (UNLOAD_DIALOG dh)
	     ;;e aqui, o arquivo DCL é eliminado da memória
	     (COND ((= [email protected] 0) (PRINC  "\n-> Cancelado..."))
		   ;; Aqui o usuário apertou "Cancel"
		   ((= [email protected] 1) (executiva-aqui))
		   ;; Aqui o usuário apertou "Ok"
	     )
      )
      nil
    )
    (ALERT
      "Arquivo C:\\CURSO\\DCL\\SLIDES2.DCL não pôde ser carregado..."
    )
  )
  (PRINC )
)

;;--------------------------------------------------------------------------	ARQUIVO 11
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------

(DEFUN c:txt1 (/	 p1	   p2	     dh	       [email protected]
	       ang	 pmedio	   altura    estilo    expert
	       string	 oldlay	   dcl-da-string       path
	       meu_error old-error afonte
	      )
  (SETVAR "CMDECHO" 0)
  ;;-------------------------------------  Início de COMENTÁRIOS 0
  ;;	Abaixo definimos uma função de erro, para o caso do usuário,
  ;;	no meio da rotina, clicar'ESC' ou 'CTRL + C'. Assim, prevenimos
  ;; 	o trace do AutoLISP, bem como restauramos as variáveis modificadas
  ;;	por necessidade da rotina, e ainda descarregamos o arquivo .DCL
  ;;	da memória...
  ;;
  ;;	Lembrar que *error* é uma função do AutoLISP que pode ser redefinida...
  ;;
  ;;-------------------------------------  Fim de COMENTÁRIOS 0
  (DEFUN meu_error (msg)
    (PRINC  "\n-> Erro : ")
    (PRINC  msg)
    (PRINC )
    (IF	expert
      (SETVAR "EXPERT" expert)
    )
    (IF	estilo
      (SETVAR "TEXTSTYLE" estilo)
    )
    (IF	dh
      (UNLOAD_DIALOG dh)
    )
    (PRINC )
  )
  (SETQ	old-error *error*
	*error*	meu_error
  )
  ;;-------------------------------------  Início de COMENTÁRIOS 1
  ;;	A função 'dcl-da-string' lança o quadro de diálogo para inserção
  ;;	do texto a ser escrito. Este é armazenado na variável 'STRING',
  ;;	e é retornado por esta função.
  ;;-------------------------------------  Fim de COMENTÁRIOS 1
  (DEFUN dcl-da-string ()
    (IF	(NEW_DIALOG "txt1" dh)
      (PROGN (SETQ string nil)
	     (ACTION_TILE "texto" "(SETQ string $value)")
	     (ACTION_TILE "accept" "(DONE_DIALOG)")
	     (START_DIALOG)
      )
      (ALERT
	"Erro : Arquivo SUPPORT\\DCL-TXT1.DCL não pôde ser escrito..."
      )
    )
    string
  )
  ;;-------------------------------------   Início de COMENTÁRIOS 2
  ;;
  ;;	o trecho ABAIXO localiza o diretório SUPPORT do AutoCAD© e
  ;; 	armazena seu path na variável 'path'.
  ;;	Caso o arquivo DCL 'DCL-TXT1.DCL' não exista neste diretório,
  ;;	ele será escrito. Este é um MODO DE GARANTIR a existência de
  ;;	pequenos arquivos DCL.
  ;;
  ;;-------------------------------------   Fim de COMENTARIOS 2
  (SETQ	path (SUBSTR (FINDFILE "ACAD.PAT")
		     1
		     (- (STRLEN (FINDFILE "ACAD.PAT")) 8)
	     )
  )
  (IF ((NOT (FINDFILE (STRCAT path "DCL-TXT1.DCL")))
    (PROGN
      (SETQ arq (OPEN (STRCAT path "DCL-TXT1.DCL") "w"))
      (PRINC  "txt1 : dialog { label = \"Curso E.Fernal de AutoLISP\";\n"
	     arq
      )
      (PRINC  "initial_focus = \"texto\";\n" arq)
      (PRINC 
	":edit_box { label = \"Texto = \"; key = \"texto\"; edit_width = 40; \n"
	arq
      )
      (PRINC  "allow_accept = true;\n" arq)
      (PRINC  "is_tab_stop = false; }\n" arq)
      (PRINC  "ok_only;}" arq)
      (CLOSE arq)
      (SETQ arq nil)
    )
    nil
  )
  ;;	O arquivo DCL-TXT1.DCL, SE NÃO EXISTIA, AGORA EXISTE...
  (SETQ	path nil
	dh   nil
	dh   (LOAD_DIALOG "DCL-TXT1.DCL")
					; agora carregamos o arquivo DCL para a memória
  )
  ;;--------------------------------------  Inicializamos a altura_da_fonte, se
  ;;--------------------------------------  esta variável ainda não existir....
  ;;--------------------------------------  Ela será o valor por DEFAULT
  (IF ((NOT altura_da_fonte)
    (SETQ altura_da_fonte 12.5)
  )
  ;;--------------------------------------  Fim da inicialização
  ;;---------------  Aqui pedimos a altura para os textos.
  ;;---------------  Caso o usuário tecle enter sem entrar com
  ;;---------------  um valor válido, altura_da_fonte será adotada...
  (SETQ	altura (GETREAL	(STRCAT	"\n-> Favor indicar a altura da fonte < "
				(RTOS altura_da_fonte 2 6)
				" > : "
			)
	       )
	estilo (GETVAR "TEXTSTYLE")
	expert (GETVAR "EXPERT")
	oldlay (GETVAR "CLAYER")
  )
  (IF (OR ((NOT altura)			;Se não houver 'altura'...
	  (= altura 0.0)		;Ou se ela for zero
	  (MINUSP altura)		;Ou ainda se for um número negativo...
      )
    (SETQ altura altura_da_fonte)	;Então 'altura' será altura_da_fonte!
  )
  (SETQ altura_da_fonte altura)		;E 'altura_da_fonte' será 'altura', assim
					;'altura' será tornada DEFAULT...
  ;;----------------------------------------------------------------------------------
  ;;--------------------------- Se a camada 'TEXTOS-MAPAS' não existir, será criada...
  (IF (NULL (TBLSEARCH "LAYER" "TEXTOS-MAPAS"))
    (COMMAND "_.LAYER" "M" "TEXTOS-MAPAS" "S" oldlay "")
  )
  ;;----------------------------------------------------------------------------------
  ;;--------------------------- Se o estilo 'VERDANA' não existir, será criado...  
  (SETVAR "EXPERT" 5)
  (IF (NULL (TBLSEARCH "style" "VERDANA"))
    (COMMAND "style" "VERDANA" "ROMANS.SHX" 0.0	1.0 0.0	"N" "N"	"N")
    nil
  )
  (SETQ retorno (TBLSEARCH "style" "VERDANA"))
  ;;--------------------  Eis um possível 'RETORNO'
  ;|
  		((0 . "style")
		  (2 . "VERDANA")
		  (70 . 0)
		  (40 . 7.77)
		  (41 . 1.0)
		  (50 . 0.0)
		  (71 . 0)
		  (42 . 7.77)
		  (3 . "ROMANS.SHX")
		  (4 . "")
		)
  |;
  ;;-------------------- Precisamos verificar se a 'altura' é ZERO...
  (SETQ afonte (CDR (ASSOC 40 retorno)))
  ;;----------------------------------------------------------------------------------
  ;;Agora iniciamos o LOOPING 'WHILE'. Enquanto fornecermos P1, ele solicitará P2 e, se
  ;;este for fornecido, irá solicitar o texto por intermédio de um quadro de diálogo e
  ;;o escreverá. Se o texto for vazio, isto é, um string "", ele não será escrito.

Quadro DCL desta rotina

 


  ;;----------------------------------------------------------------------------------
  (WHILE (SETQ p1 (GETPOINT "\n-> Primeiro ponto referencial : "))
    (IF	(SETQ p2 (GETPOINT p1 "\n-> Segundo ponto referencial : "))
      (PROGN (SETQ ;;------------------ Localizamos o ponto médio de P1 e P2
		   pmedio (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0))
		   ;;------------------ Calculamos o ângulo entre P1 e P2
		   ang	  (ANGLE p1 p2)
		   ;;------------------ Sempre ajustamos o ângulo 'ang' do texto...
		   ang	  (COND	((AND (>= ang 0.0) (<= ang (* PI 0.5))) ang)
				((< ang (* PI 1.5)) (+ ang PI))
				(T ang)
			  )
		   ;;------------------ eliminamos 'string' para garantir um novo
                   ;;------------------ fornecimento de 'string'
		   string nil
	     )
	     ;;---------------- Aqui solicitamos o 'string' a escrever...
	     (dcl-da-string)
	     ;;---------------- O string é válido?
	     (IF (AND string (> (STRLEN string) 0))
	       ;;---------------- Sim, é válido...
	       ;;---------------- Usamos 'COMMAND' para escrever o texto...
	       (IF (= afonte 0.0)
		 ;;----------------- O estilo tem altura 0.0, então o texto será
		 ;;----------------- escrito com a altura solicitada...
		 (COMMAND "_.TEXT"
			  "MC"
			  "_NON"
			  pmedio
			  altura
			  (* 180.0 (/ ang PI))
			  string
			  "_.CHPROP"
			  (ENTLAST)
			  ""
			  "LA"
			  "TEXTOS-MAPAS"
			  ""
		 )
		 ;;----------------- O estilo 'VERDANA' tem altura definida, então esta
		 ;;----------------- prevalecerá para o texto...
		 (COMMAND "_.TEXT"
			  "MC"
			  "_NON"
			  pmedio
			  (* 180.0 (/ ang PI))
			  string
			  "_.CHPROP"
			  (ENTLAST)
			  ""
			  "LA"
			  "TEXTOS-MAPAS"
			  ""
		 )
	       )
	       ;;--------------------- Não, o string é inválido.
	       ;;--------------------- Então retornamos 'NIL'
	       nil
	     )
      )
      (ALERT "P2 não fornecido, recomeçando...")
					; P2 inexistente, volta ao 'WHILE'
    )
    ;;----------------------- Não forneceu P1, então encerra o looping 'WHILE'...
  )
  ;;----------------------------------------- Agora reconfiguramos o AutoCAD© tal
  ;;----------------------------------------- como estava...
  (IF estilo
    (SETVAR "textstyle" estilo)
  )
  (IF expert
    (SETVAR "EXPERT" expert)
  )
  ;;----------------------------------------- E aqui, descarregamos o DCL da memória...
  (IF dh
    (UNLOAD_DIALOG dh)
  )
  ;;----------------------------------------- Restabelecemos *error* ao original...
  (SETQ *error* old-error)
  (PRINC )
)
;;----------------- Aí está!!!!!!!
;;-----------------
;;-----------------EOF de txt1.lsp

;;--------------------------------------------------------------------------	ARQUIVO 12
;; Curso E.Fernal de AutoLISP
;; [email protected]
;; http://www.gr-acad.com.br
;; NÃO ALTERE ESTE ARQUIVO OU A ROTINA PODERÁ NÃO FUNCIONAR ADEQUADAMENTE...
;; início da rotina
;;---------------------------------------------------------------------------
;;
;;*****************************************************************************;;
;|
Obs.:
	Esta rotina é uma réplica do arquivo c:\curso\dup\slides2.lsp,
	tendo sido alterada a função 'EXECUTIVA_AQUI', trocando o (ALERT ...)
	por outras mensagens...
        Você pode trocar os paths dos arquivos .dwg, devendo ainda substituir
	os slides na biblioteca C:\CURSO\SLB\SLB001, ou mesmo substituindo
	paths e bibliotecas.
	A lista de blocos poderá ser alterada, substituindo-se "Bloco1", "Bloco2",
	etc., pelos nomes dos seus blocos...
|;
;;*****************************************************************************;;
(DEFUN c:slides3 (/	       dh	    [email protected]		 ajuda
		  executiva-aqui	    bloco-a-inserir
		  lista	       selecionar
		 )
  (SETVAR "CMDECHO" 0)
  (SETQ	p1 nil
	lista '()
	bloco-a-inserir	nil
  )
  ;;---------------------------------------------------------------
  ;;funcoes locais, exigidas se o usuário pressionar o botão "Help"
  ;;ou o botão "Ok"
  ;;
  ;; A função abaixo será disparada toda vez que o usuário clicar no botao "Help"
  (DEFUN ajuda ()
    (ALERT
      (STRCAT "Este texto pode ser substituido por uma mensagem mais"
	      "\nadequada à cada uma das rotinas."
	      "\nEste é somente um exemplo..."
      )
    )
  )
  ;; A função abaixo será executada toda vez que o usuário clicar um item
  ;; na lista de blocos disponíveis...
  (DEFUN selecionar (value / dx dy)
    (SETQ bloco-a-inserir (NTH (ATOI value) lista)
	  dx		  (DIMX_TILE "imagem")
	  dy		  (DIMY_TILE "imagem")
    )
    ;;(ALERT (STRCAT "Dx = " ((ITOA dx) "\nDy = " ((ITOA dy)))
    ;; ALERT acima retornou dx = 180 e dy = 180
    (SET_TILE "saida" (STRCAT "Inserir " bloco-a-inserir))
    (START_IMAGE "imagem")
    (FILL_IMAGE 0 0 dx dy 0)
    (SLIDE_IMAGE
      0
      0
      dx
      dy
      (STRCAT "c:\\curso\\slb\\slb001(" bloco-a-inserir ")")
    )
    (END_IMAGE)
    bloco-a-inserir
  )
  ;; A função abaixo será disparada se o usuário clicar no botão "Ok"
  (DEFUN executiva-aqui	(/ p1)
    (IF	bloco-a-inserir
      (IF (SETQ
	    p1 (GETPOINT "\n-> Selecione ponto de inserção do bloco : ")
	  )
        ;;*******************************************************************
	;|
	(ALERT
	  (STRCAT
	    "Você forneceu o ponto..."
	    "\nNeste trecho, a rotina deverá ser programada para"
	    "\ninserir o bloco selecionado, se encontrado..."
	    "\nIsto deverá ser feito substituindo-se este 'ALERT' por"
	    "\nexpressões AutoLISP que localizem o arquivo externo e/ou"
	    "\no bloco na tabela de blocos, inserindo-o ou com o comando"
	    "\n'INSERT' ou usando a função (ENTMAKE '((0 . \"INSERT\")....))"
	    "\nO comandos SLIDES3 é uma réplica deste, inserindo blocos...")
	)
	|;
	;;	acima, o trecho que foi substituido
	;;	abaixo, o trecho que entrou -> (COND ...)
        ;;*******************************************************************
	(COND
	  ((TBLSEARCH "BLOCK" bloco-a-inserir)
	   (COMMAND "_.INSERT" bloco-a-inserir "_NON" p1 1.0 1.0 pause)
	  )
	  ((FINDFILE
	     (STRCAT "C:\\CURSO\\DWG\\" bloco-a-inserir ".DWG")
	   )
	   (COMMAND
	     "_.INSERT"
	     (FINDFILE
	       (STRCAT "C:\\CURSO\\DWG\\" bloco-a-inserir ".DWG")
	     )
	     "_NON"
	     p1
	     1.0
	     1.0
	     pause
	   )
	  )
	  (T
	   (ALERT
	     "Bloco não está presente no desenho e não foi encontrado em C:\\CURSO\\DWG\\"
	   )
	  )
	)
	;;	fim do trecho que entrou...
	(ALERT "Ponto de inserção não foi fornecido...")
      )
      (ALERT "Bloco não foi selecionado...")
    )
  )
  ;;-----------------------------------------FIM DAS FUNCOES LOCAIS
  (IF (> (SETQ dh (LOAD_DIALOG "C:\\CURSO\\DCL\\SLIDES2.DCL")) 0)
    (IF	(NEW_DIALOG "slides2" dh)	; o nome do quadro tem que ser exatamente o
					; mesmo do arquivo .DCL, inclusive respeitando
					; minúsculas e maísculas
      (PROGN ;; Criamos uma lista com o nome dos blocos disponíveis
	     (SETQ lista '("Bloco1"	"Bloco2"     "Bloco3"
			   "Bloco4"	"Bloco5"     "Bloco6"
			   "Bloco7"	"Bloco8"     "Bloco9"
			   "Bloco10"
			  )
	     )
	     ;; Inserimos esta lista no campo 'list_box' do quadro de diálogo
	     (START_LIST "lista")	; esta chave "lista" deve ser exatamente igual
					; ao que foi escrito no arquivo .DCL
	     (MAPCAR 'ADD_LIST lista)
	     (END_LIST)
	     ;; Ok, a lista foi inserida no quadro de diálogo.
	     (ACTION_TILE "accept" "(DONE_DIALOG 1)")
	     (ACTION_TILE "cancel" "(DONE_DIALOG 0)")
	     (ACTION_TILE "lista" "(selecionar $value)")
	     (ACTION_TILE "help" "(ajuda)")
	     ;;apertar "Help" dispara a funcao 'ajuda'
	     (SETQ [email protected] (START_DIALOG))
	     ;;Aqui o quadro de diálogo é retirado
					; da tela
	     (UNLOAD_DIALOG dh)
	     ;;e aqui, o arquivo DCL é eliminado da memória
	     (COND ((= [email protected] 0) (PRINC  "\n-> Cancelado..."))
		   ;; Aqui o usuário apertou "Cancel"
		   ((= [email protected] 1) (executiva-aqui))
		   ;; Aqui o usuário apertou "Ok"
	     )
      )
      nil
    )
    (ALERT
      "Arquivo C:\\CURSO\\DCL\\SLIDES2.DCL não pôde ser carregado..."
    )
  )
  (PRINC )
)

A linguagem DCL
Exemplos de listas
Anterior
Home