Mostrando postagens com marcador Visual Lisp. Mostrar todas as postagens
Mostrando postagens com marcador Visual Lisp. Mostrar todas as postagens

Visual Lisp e DCL com a linha de comando

Bom dia!!

Ah, sim e feliz ano novo!!!

Prometo tentar retomar as postagens no blog, até porque, preciso levantar a audiência, já que meus parceiros resolveram me furar o olho. Sim estou falando com vocês.

Pra começar o ano, vamos retomar um pouco das raízes deste blog, falando um pouco de Visual Lisp.

Faço parte de um grupo de whatsapp que fala deste tema em particular - é existe um, vai entender - que outro dia estava uma discussão enorme sobre como fazer uma lisp mostrar um diálogo e neste ter um botão para clicar um ponto na tela do cad e tal.

Bem, apesar das explicações mais bem elaboradas que se podia dar, nada como um exemplo prático para mostrar uma das soluções encontradas!!!

Abaixo você verá isso, mas antes algumas considerações:

Depois que você abre um diálogo em visual lisp ( o dcl ), não pode acessar a linha de comando.

Mas por que?

Bem, digamos que o mecanismo que interpreta o Visual Lisp no AutoCAD não está preparado para isso, como acontece na API DOTNET e simplesmente dá erro fatal....

Mas o que eu quero dizer com acessar a linha de comando?

Bem, usar qualquer função do Visual Lisp que interaja com a linha de comando, uai, por exemplo: getint, getreal. getpoint, ssget, command....

Mas se mesmo assim eu precisar disso, como no exemplo, que vamos estudar?

Então a solução é fechar o diálogo (DCL) antes de acessar a linha de comando e como precisaremos voltar para o DCL após ter interagido com a linha de comando, vamos incluir um looping que fique mostrando este DCL até que queiramos parar.

A ideia fica assim:

Inicializar as variáveis
iniciar o looping
   iniciar o DCL
   mostrar o DCL e monitorar as ações nele
   se clicou num botão, decida:
       clicou OK, sai do looping, com status de OK, pois o usuário aceita os valores dos campos
       clicou CANCELAR, sai do looping com o status CANCELAR
             então restaura os valores originais
       clicou um botão diferente, então faz o que tem de fazer e faz looping outra vez
volta para o looping até que tenha de sair dele

Como algorítimo, o exemplo se resume a isso.

Durante o tempo que as postagens no grupo do whatsapp, outros problemas foram adicionados e um deles era atualizar um SLIDE ao clicar uma opção num RADIO_BUTTON do DCL.

Outro, era validar os valores que eram digitados neste DCL, por exemplo, existem dois campos (X e Y) que esperam valores numéricos, pois representam uma coordenada, sendo assim, não pode conter um valor alfanumérico.

Já que ia mostrar um SLIDE neste DCL, resolvi incluir mais um item: clicar na imagem.
No exemplo, isso não tem uma utilidade, a não ser demonstrar o conceito. Eu uso este conceito no EXPGE, na hora que você clica o mapa para escolher o fuso:


Eu gosto de separar todas as ações de cliques do DCL numa subrotina que a processa, assim, evito de escrever as ações no DCL com o "action_tile", o que me parece bem mais racional, principalmente se você escrever um DCL para cada idioma que seu aplicativo puder mostrar. Por exemplo, o EXPGE e o MLH2 mostram o diálogo em português e inglês.

Esta subrotina também pode validar o valor que pretendo modificar na tela do DCL, assim, se tentar escrever um texto qualquer no campo que espera conter um número, este pode informar um erro, ou mesmo corrigir para o valor inicial.

Isto se faz assim no exemplo:

 ( subrotinaQueProcessaAcao key valor razao posx posy / ... )

Veja, asubrotina recebe 5 parâmetros, que são passados a ela sempre que algo é clicado, alterado ou escolhido no DCL. Convém ler a ajuda do AutoCAD. Por hora, aceite isso.

Os parâmetros são:
key - nome do campo que foi clicado/alterado
valor - valor digitado no campo, quando aplicável
razao - indica qual ação o usuário fez após digitar: clocou outro campo, clicou ENTER, etc...
posx - ordenada X da posição onde o mouse clicou uma imagem
posy - ordenada Y

Vamos melhorar o algorítimo para mostrar isso e vamos mostrar uma maneira de armazenar uma lista de valores padrão do ANTES de mostrar eles no DCL e decidir o que fazer com eles se clicar OK ou CANCEL:

Inicializar as variáveis com valores padrão
iniciar o DCL
iniciar o looping
   mostrar o DCL
   preencher os campos
   definir as ações de cada campo
   monitorar as ações nele
   se clicou num botão, decida:
       clicou OK, sai do looping, com status de OK, pois o usuário aceita os valores dos campos
       clicou CANCELAR, sai do looping com o status CANCELAR
             então restaura os valores originais
       clicou um botão diferente, então faz o que tem de fazer e faz looping outra vez
volta para o looping até que tenha de sair dele

Note que inclui duas linhas, marcadas em negrito.
Tente entender porque iniciar as variáveis com valores padrão pode ser útil. Imagine que você usou o programa, modificou valores. Clicou OK. Chamou o programa outra vez, o DCL pode mostrar as últimas escolhas que você fez.

Se este for o comportamento que você espera, terá de armazenar a lista de valores padrão numa variável global. Siga o link!!!

Bem, agora que o algorítimo básico foi mostrado, vamos ver o código. Comecemos com a "cara" que fica o DCL:


Note o "Radio" era uma das coisas que pediam: ter um RADIO_BUTTON que, ao ser clicado, trocasse a "imagem" do campo ao lado, então ao clicar outra opção, outra imagem é exibida.

No exemplo, X e Y começam com valor zero. A opção inicial é "C" no campo "radio" e a escala da imagem é 1. Então comece com isso:

;valores padrão das variáveis globais
;é uma lista com pares de ("nomeDaVariavel" "valorDaVariavel")
(setq exemplo:listaKeys
       '(("r1" "1")       ;radio button 1
     ("r2" "0")       ;radio button 2
     ("r3" "0")       ;radio button 3
     ("clicapt"  )    ;button "clicapt" precisa sair do diálogo
     ("x" "0.0")      ;ordenada x sendo armazenada
     ("y" "0.0")      ;ordenada y sendo armazenada
     ("escala" "1")   ;escala da imagem no dcl
     ("btcresce")
     (
"btdiminui")
     (
"imagem")
     (
"help")   ))


Uma dica: Observe como nomeio a variável global. Não é obrigatório fazer dessa maneira, mas ajuda a manter o código livre de sobreposições de outros programas. Falo disso depois, ok?

Você pode criar uma variável para cada campo do DCL, mas me parece mais simples assim. Quando você ler o código todo irá concordar. Veja que mesmo os campos numéricos mantive com strings. Isso facilita na hora de preencher o DCL, você vai ver....

Já que estou armazenando os valores dos campos desse DCL numa lista, precisamos de uma subrotina que insira um novo valor nela, pra não ficar repetindo várias linhas de código toda vez que precisamos mudar isso, então aqui está:

;subrotina que seta o valor de uma variavel global
;nomeVariavel => string com o nome da variavel global
;valor => string string com o valor a ser definido
;exemplo: (exemplo->put-valor "x" "0.3")
;saida: a lista de variaveis globais atualizada
(defun exemplo->put-valor (nomeVariavel valor / old new)
  (
setq old               (assoc nomeVariavel exemplo:listaKeys)
    new               (list nomeVariavel valor)
    exemplo:listaKeys (subst new old exemplo:listaKeys)))


Na verdade é bem simples, trata-se de manipular a lista, colocando outro valor num campo qualquer.

Já que criei uma função para modificar a lista, vamos criar uma para "tomar" um valor qualquer:

;subrotina que devolve o valor de uma variavel global
;nomeVariavel => nome da variavel a retornar o valor
;resposta: string, valor a ser devolvido ou NIL se a variavel nao exista
;exemplo: (exemplo->get-valor "x")
;saida: "0.3"
(defun exemplo->get-valor (nomeVariavel)
  (
cadr (assoc nomeVariavel exemplo:listaKeys)))


Bem simples também.

Acredito que será mais produtivo  ver agora o programa principal, para que você entenda o que quero mostrar.

Depois vemos as ações e subrotinas complementares.

Relembrando, o programa principal consiste em:

Inicializar as variáveis com valores padrão
iniciar o DCL
iniciar o looping
   mostrar o DCL
   preencher os campos
   definir as ações de cada campo
   monitorar as ações nele
   se clicou num botão, decida:
       clicou OK, sai do looping, com status de OK, pois o usuário aceita os valores dos campos
       clicou CANCELAR, sai do looping com o status CANCELAR
             então restaura os valores originais
       clicou um botão diferente, então faz o que tem de fazer e faz looping outra vez
volta para o looping até que tenha de sair dele

Agora veja o código:

(defun c:teste (/ dcl dlg faz pt lembrar)

  (
setq dcl  (load_dialog "c:/temp/teste.dcl") ;carrega o dcl e inicializa os valores das tiles
        faz t                                  ;controla o loopin WHILE
    lembrar exemplo:listaKeys)             ;para lembrar os valores se clicou cancel

    

  ;loopinq que mostra o dialogo até clicar OK ou CANCEL
  (while faz

    ;carrega o dialogo desejado
    (new_dialog "teste" dcl )

    ;inicializa as tiles com ação e valor inicial
    (foreach k exemplo:listaKeys
      (action_tile (car k) "(exemplo->acoes $key $value $reason $x $y)" )   ;define a acao
     

      (if (cadr k) (set_tile (car k) (cadr k))))  ;preenche o valor no dialogo

    ;prepara a imagem sem ter clicado um radiobuton
    (exemplo->seta-slide nil)
    

    ;mostra o dialogo na tela e espera clicar algo
    (setq dlg (start_dialog))

    ;clicou um botao qualquer, seja cancel ou OK ou um botão que tem acao que depende da linha de comando
    ;se deprende da linha de comando, precisa fechar o dialogo, senao dá erro fatal
    (cond ((= 0 dlg) ;cancel
       (setq faz nil)
       (
alert "Cancelou! vou restaurar a lista de variaveis globais!")
       (
setq exemplo:listaKeys lembrar))

      ((
= 1 dlg) ;ok
       (setq faz nil)
       (
alert "Clicou OK, vou fechar a tela mano!!"))

      ((
= 2 dlg) ;clicou o botao para capturar um ponto na tela
       (setq pt (getpoint
              (strcat "Informe um ponto <"
                  (exemplo->get-valor "x")
                  ","
                  (exemplo->get-valor "y")
                  ">")))
       (
if pt
         (progn
           (exemplo->put-valor "x" (rtos (car pt) 2 3))
           (
exemplo->put-valor "y" (rtos (cadr pt) 2 3)))))
    )
 ;cond
  );while

  (unload_dialog dcl)

  )


Considerações:
Vou supor que você já saiba ao menos carregar o DCL (load_dialog, start_dialog, new_dialog). Siga os links, não dói, hehehe

Veja a parte de "setar" os campos do DCL. um simples FOREACH resolve. Percebe porque escolhi as variáveis numa lista já como "string"? assim não preciso converter em string um valor que pode ser real, inteiro, string, etc....

Veja que este mesmo FOREACH também define a ação de cada campo com o action_tile bem simples ( "(exemplo->acoes $key $value $reason $x $y)" )

Perceba que o nome do campo é o primeiro elemento da lista de pares nome/valor

Ah, sim, a imagem não tem um valor propriamente dito, então basta deixar vazio na lista de variáveis. Mas precisamos inicializar ela, baseado escolha inicial do RADIO_BUTTON.

Fiz isso com este pedaço do código:
(exemplo->seta-slide nil)

Esta subrotina, espera que você informe qual é a escolha, para que ele mostre a imagem correta.
Ah, convém ver a ajuda de algumas funções (start_image, fill_image, slide_image, end_image) para entender que elas precisam estar em sequencia.

;suprotina que preenche o slide correto na imagem
;exemplo:  (exemplo->seta-slide "r1")
(defun exemplo->seta-slide (radioButon / radioButons nomeSlide largura altura
                larguraReduzida alturaReduzida posX posY escala cor
)
  (
setq radioButons '(("r1" "c:\\temp\\teste(a)") ("r2" "c:\\temp\\teste(b)") ("r3" "c:\\temp\\teste(c)"))
    keyCampo    "imagem"

    ;obtem a escala, precisa estar antes de start_image
    escala      (atof (get_tile "escala")) 

    ;toma o tamanho do retangulo que mostra os slides
        largura (dimx_tile keyCampo)
        altura  (dimy_tile keyCampo)

    ;recalcula o tamanho da janela disposnivel
    larguraReduzida (fix (* largura escala))
    alturaReduzida  (fix (* altura escala))

    ;calcula o canto superior esquerdo onde inserir o slide
    posX    (fix (/ (- largura larguraReduzida)  2))
    posY    (fix (/ (- altura alturaReduzida)  2))

    ;cor da área util onde o slide ira aparecer
    cor      1 ;vermelho
    )
  

  ;encontra o slide apropriado:
  (if radioButon
    ;se informou a opção do radiobuton, pega ele
    (setq nomeSlide (cadr (assoc radioButon radioButons)))

    ;nao informou, significa que é pra procurar qual está setado  por padrao
    (foreach k radioButons
      (if (= "1" (get_tile (car k)))
    (
setq nomeSlide (cadr k)))))
    

  ;inicializa o retangulo que mostra a imagem
  (start_image keyCampo)

  

  ;pinta o background de preto:
  (fill_image 0 0 largura altura 0)

  ;pinta de vermelho a area onde o slide vai aparecer:
  (fill_image posX posY larguraReduzida alturaReduzida cor)
  

  ;desenha o slide na area reduzida
  (slide_image posX posY larguraReduzida alturaReduzida nomeSlide)

  ;finaliza
  (end_image)
  )


Veja que se não informo qual é a opção desejada, esta subrotina procura a escolha atual. Na variável global que armazena a lista de campos, tem três campos: "r1", "r2" e "r3" que são os radio_button. o escolhido é aquele que tem o valor "1"

Tá, eu enfeitei um pouco esta subrotina nesta parte de calcular uma escala, pintar de vermelho e tal. A ideia é mostrar que se pode colocar uma imagem em escala, centralizar etc...

A última parte do código é a subrotina que processa as ações dos campos do DCL. Note que como ela recebe o nome do campo, um COND é indicado para escolher qual ação tomar, em vez de colocar tudo dentro de strings emporcalhando o código do programa principal:

;acoes das tiles.
;key => string, nome do campo no DCL
;valor => string, valor passado pela ação
;razao => inteiro, razao do evento, ver a ajuda
;coordX => quando clica o image_button, informa a ordenada X em pixels
;coordY => quando clica o image_button, informa a ordenada Y em pixels

(defun exemplo->acoes (key valor razao coordX coordY / coleta tmp)
  ;para todas as acoes exceto as que tem done_dialog, coleta os valores
  (setq coleta t)
  

  ;testa qual campo disparou a acao:
  (cond (;algum dos radiobuton? muda de slide!!!!!!!!!!!!!!!!
     (member key '("r1" "r2" "r3")) (exemplo->seta-slide key))

    ;clicou o botao ajuda
    ((eq key "help") (startapp "explorer.exe" "https://tbn2net.com"))
    

    ;trocou a escala
    ((eq key "escala")
     (
set_tile "escala" (if (> (setq tmp (atof valor)) 0)
                  (
rtos tmp 2 3)
                  (
exemplo->get-valor "escala")))
     (
exemplo->seta-slide nil))

    ;apertou o botao de aumetar a escala
    ((eq key "btcresce")
     (
exemplo->acoes "escala" (rtos (* 2 (atof (get_tile "escala"))) 2 3) 1 nil nil))

    ;apertou o botao de diminuir
    ((eq key "btdiminui")
     (
exemplo->acoes "escala" (rtos (* 0.5 (atof (get_tile "escala"))) 2 3) 1 nil nil))

    ;escreveu um valor em X
    ((eq key "x")  (set_tile "x" (rtos (atof valor) 2 3)))

    ;escreveu um valor em Y
    ((eq key "y")  (set_tile "y" (rtos (atof valor) 2 3)))

    ;clicou o botao para acessar a linha de comando e pedir um ponto
    ((eq key "clicapt") (setq coleta nil) (done_dialog 2))

    ;clicou na imagem
    ((eq key "imagem")
     (
alert (strcat "Você clicou dentro da imagem, nas coordenadas "
            (itoa coordX) ","
            (itoa coordY)))))

  ;coleta os novos valores se nao foi um done_dialog:
  (if coleta
    (setq exemplo:listaKeys
       (mapcar '(lambda (k)
              (
list (car k) (get_tile (car k))))
           exemplo:listaKeys)))  )


Bem simples se você ler com calma, verá que pode incluir mais campos apenas acrescentando mais linhas ao COND.

Neste código o truque que quero mostrar é justamente aquele de clicar o botão de obter a coordenada na linha de comando, o botão com ">" no DCL.

Ele faz um DONE_DIALOG. para o botão em questão, usei o [status] igual a 2.
Lembre-se:
OK termina o diálogo com status 1
CANCEL, termina o diálogo com status 0

Então precisamos saber diferenciar quem está encerrando o DCL (diálogo)

Note que incluí uma ação para o HELP, abrindo o navegador e mostrando a minha página. Você pode fazer abrir um arquivo qualquer, com a ajuda do seu programa.

Note a ação que é executada para X e para Y. Ela converte qualquer entrada que você escreve nestes campos para um número real e depois reconverte para string e reescreve esse valor no campo. Isso faz com que o campo só tenha valor numérico.

Note que incluí um pequeno controle usando a variável "coleta". Tive de fazer isso pois preciso lembrar os valores que estão nos campos, reescrevendo a variável global. Mas isso não pode ocorrer ao clicar o botão ">" (key "clicapt") pois o done_dialog anula todos os campos e get_tile retorna nil em todos os campos, o que ia ferrar com DCL.

Bem, depois que você copiar todos os códigos, tente tirar essa verificação, só por farra!!!

Agora vamos ver o famigerado DCL:


teste: dialog {label="exemplo";
:
row {
 :column {
 :radio_column { label = "Radio";
   :
radio_button {label = "A"; key = "r1";}
   :radio_button {label = "B"; key = "r2";}
   :radio_button {label = "C"; key = "r3";}
 }


 :boxed_column {label = "Coordenadas";
   :
edit_box {label = "X" ; key="x";}
   :edit_box {label = "Y" ; key="y";}
   :button {label = ">" ; key = "clicapt";}}
}

:boxed_column {label = "Imagem";
  :
image_button {key = "imagem"; width=50; height =20;
                 fixed_width=true;fixed_height=true;}
  :row { :edit_box {label = "Escala" ; key="escala";}
         :button {label = "+" ; key = "btcresce";}
         :button {label = "-" ; key = "btdiminui";} }
    
  }}

:text {label = "Powered by Neyton";} 
ok_cancel_help;
   }


Note que para mostrar os botões OK, CANCEL e HELP usei a definição padrão deles. Sim é possível mudar isso, basta criar botões personalizados, mas isso fica pra outro post.

Vamos olhar o programa principal novamente. Olhe o que acontece depois que fazemos o START_DIALOG.

Temos um COND que escolhe uma ação, baseado no STATUS passado a ele:
status 1, OK, sai do looping e mantem as alterações da variável global
status 0, CANCEL, sai do looping e restaura os valores originais da variável global
status 2, mostra a linha de comando e pede que clique uma coordenada e depois volte a mostrar o DCL

Pronto. Estude o código. Dica: leia primeiro somente os cometários do código. Depois leia o código.

Veja, este exemplo mostra uma maneira de oferecer ao usuário uma forma mais amigável de modificar opções no programa que criamos. Isso é preferível quando temos uma grande quantidade de opções alteráveis.

Eu prefiro evitar DCL quando se trata de um ou dois campos. Prefiro dar as opções na linha de comando. Mas isso é questão de gosto....

Falta ainda:
Controle de erros
Compilar para FAS/VLX

Tá com preguiça de copiar e colar, então baixa aqui!!!

Note que salvei o exemplo em C:/temp/, então pra rodar, salve neste local ou edite os caminhos. Os slides, dcl e código estão no pacote zipado do link acima.

Da série: serviços de estagiário

Mais um dia e mais um daqueles servicinhos "jóia" de fazer.

Desta vez, temos de montar o mosaico de plantas de um projeto que recebemos com algumas centenas de arquivos DWG.

Cada arquivo, tem uma prancha no MODEL SPACE, com planta e perfil.

Sim, pelo menos está georreferenciado, onde o WCS do AutoCAD coincide com as coordenadas UTM.

O problema é que isso faria os desenhos ficarem tortos, então o cara faz o UCS PLAN para que a folha fique na horizontal. Menos mal, hehehe

Se você é daqueles que fazem o ROTATE de tudo para fazer a folha ficar na horizontal, saiba que as pessoas te ODEIAM!!!!

Dessas centenas de arquivos, estamos interessados em recortar a planta e exportar ela para outro arquivo, mantendo o georreferenciamento, para depois inserir todas elas como xREF num novo desenho e montar o mosaico do projeto todo e restituir o mesmo no Civil 3D por exemplo.

É, eu sei, podia pegar o projeto em civil já, ou mesmo em topograph ou coisa que o valha em vez de pegar o DWG final, mas sabe como são as empresas....

Aliás, BIM já deveria ser LEI/NORMA e não um nome bonito apenas....

Bom, mas recebemos um "CD" (alguém ainda usa isso????) só com esses arquivos e um "ainda bem que não está em PDF, morre PDF!!!!

Se fossem uns 10 ou até 20 desenhos, beleza, dava pra fazer na mão, leva uns 5 minutos cada um só pra para abrir, ajustar os layers, as unidades e fazer um WBLOCK. Mas como eu disse, são CENTENAS. Faz as contas....

Então podemos escrever uns códigos pra fazer isso por nós!!!

Vamos lá, eu escrevi esse que está abaixo:
;paga a lista de documentos atual do autocad
(setq docs (vla-get-documents (vlax-get-acad-object)))

;pasta onde estão os desenhos originais
(setq origem "D:\\DATA\\neyton.molle\\Documents\\LOTE 5\\")

;pasta onde serão salvos os novos desenhos
(setq destino "d:/LOTE 5/")

;lista de dwgs da pasta origem
(setq arqs (vl-directory-files origem "*.dwg"))

;arquivo que registra cada passo, será util para depurar erros nos arquivos
(setq logFile (open (strcat destino "resultado.txt") "w"))

;subrotina para gerar um WBLOCK dos elementos que queremos
(defun cria-wblock (arq)

  ;registra no arquivo de log a abertura do arquivo DWG
  (write-line (strcat "\n\nopen: " arq) logFile)

  ;abre o DWG, colocando-o na lista de documentos atual do autocad
  (setq doc (vla-add docs (strcat origem arq)))

  ;liga, descongela e destrava todos os layers deste DWG
  (write-line "\t\t\t\t\tligando layers..." logFile)
  (
vlax-for lay (vla-get-layers doc)
    (
vla-put-layeron lay :vlax-true)
    (
vla-put-Lock lay :vlax-false)
    (
vla-put-freeze lay :vlax-false))

  ;pega as selectionsets do DWG
  (setq ssets (vla-get-selectionsets doc))

  ;registra no log o inicio da busca
  (write-line "\tprocura o retangulo" logFile)

  ;muda o units para metros, para não dar problema ao inserir como XREF depois
  (vla-SetVariable doc "INSUNITS" 6 )

  ;faz zoom extents no model, para que a seleção funcione corretamente
  (vla-zoomextents  (vlax-get-acad-object))

  ;registra no log o inicio da busca pelo limite externo da área a ser selecionada
  (write-line "\texplodir polilinhas" logFile)

  ;testa a existencia de uma seleção chmada "ssPOLY"
  ;este passo não seria necessário, pois o desenho acabou de ser aberto
  ;mas para efeito de depuração do código, poderá ser útil
  (if (not (vl-catch-all-error-p
         (setq ssPOLY (vl-catch-all-apply 'vla-item (list ssets "ssPOLY")))))
    (
vla-delete ss))

  ;cria a seleção "ssPOLY"
  (setq ssPOLY (vla-add ssets "ssPOLY"))

  ;cria um filtro para a seleção, onde queremos todas as polilinhas do layer "03"
  ;essas polilinhas neste caso em particular, é a articulação das folhas, sendo assim
  ;formam o retângulo que contem os elementos que queremos selecionar e exportar
  (Setq ssdxf (vlax-make-safearray vlax-vbInteger '(0 . 1)))
  (
vlax-safearray-fill ssdxf '(0 8))

  (
Setq ssvals (vlax-make-safearray vlax-vbVariant '(0 . 1)))
  (
vlax-safearray-fill ssvals '("LWPOLYLINE" "03"))

  ;seleciona no desenho, todas as polilinhas do layer "03",
  ;conforme o filtro criado acima
  (vla-select ssPOLY acSelectionSetAll nil nil ssdxf ssvals)

  ;caso ache as polilinhas, explode elas
  (IF (> (VLA-GET-COUNT ssPOLY) 0)
    (
VLAX-FOR V ssPOLY (VLA-EXPLODE V) (VLA-DELETE V)))

  ;agora, com as polilinhas explodidas, vamos buscar as LINHAS do layer "03"
  ;então cria a seleção de nome "teste"
  (if (not (vl-catch-all-error-p
         (setq ss (vl-catch-all-apply 'vla-item (list ssets "teste")))))
    (
vla-delete ss))
  (
setq ss (vla-add ssets "teste"))

  ;cria o filtro para a seleção
  (Setq ssdxf (vlax-make-safearray vlax-vbInteger '(0 . 1)))
  (
vlax-safearray-fill ssdxf '(0 8))

  (
Setq ssvals (vlax-make-safearray vlax-vbVariant '(0 . 1)))
  (
vlax-safearray-fill ssvals '("LINE" "03"))

  ;seleciona todas as linhas do layer "03", conforme o filtro criado acima
  (vla-select ss acSelectionSetAll nil nil ssdxf ssvals)

  ;registra no log a quantidade de linhas selecionadas
  (write-line (strcat "\t\tLinhas selecionadas: "
              (itoa (vla-get-count ss))) logFile)

  (
setq lst nil)

  (
setq ja nil)

  ;em todas essas linhas selecionadas, filtre aquelas que tem o comprimento
  ;de 612 ou 592 ou 512. Estas linhas são as linhas verticais do retângulo que
  ;circunscreve a área que queremos exportar
  (vlax-for linha ss
    ;acha o inicio e fim da linha, vamos registrar essas coordenadas
    ;arredondando para 3 casas decimais
    (Setq pa (vlax-curve-getstartpoint linha)
      pa (strcat (rtos (car pa) 2 3) "," (rtos (cadr pa) 2 3))
      pb (vlax-curve-getendpoint linha)
      pb (strcat (rtos (car pb) 2 3) "," (rtos (cadr pb) 2 3)))

    ;estamos procurando as linhas cujo comprimento tem 612 ou 592,
    ;mais uma tolerancia de 0.01
    (if (OR (<= (abs (- 612.0 (vla-get-length linha))) 0.01)
        (
<= (abs (- 592.0 (vla-get-length linha))) 0.01)
        (
<= (abs (- 512.0 (vla-get-length linha))) 0.01))
      ;se encontramos uma linha com o comprimento desejado,
      ;armazenamos na lista 'lst' e na lista 'ja'
      (if (not (or (member (list  pa pb) ja ) (member (list  pb pa) ja)))
    (
setq lst (cons linha lst)
          ja  (cons (list  pa pb) ja)))))

  ;registra no log, quantas linhas filtrou
  (write-line (strcat "\t\t\tLinhas filtradas: " (itoa (length lst))) logFile)

  ;se filtrou exatamente 2, podemos proceder com a exportação
  (if (= 2 (length lst))
    (
progn

      ;registra no log a área a exportar
      (write-line "\t\t\t\tselecionar no retângulo..." logFile)

      ;pega o inicio e fim das duas linhas
      (setq pa (vlax-curve-getstartpoint (car lst))
        pb (vlax-curve-getendpoint (car lst))
        pc (vlax-curve-getstartpoint (cadr lst))
        pd (vlax-curve-getendpoint (cadr lst)))

      ;testa se as duas estão no mesmo sentido. se não estiver, inverte uma
      (if (< (distance pa pd) (distance pa pc)) (mapcar 'set  '(pc pd) (list pd pc)))

      ;arbritra uma nova UCS, fazendo ela ser igual ao WCS
      ;seria como fazer o comando "ucs" e colocar a opção "world"
      (write-line "\t\t\t\t\tucs world..." logFile)
      (
vla-put-activeucs doc (vla-add (vla-get-UserCoordinateSystems doc)
                      (
vlax-3d-point '(0 0 0))
                      (
vlax-3d-point '(1 0 0))
                      (
vlax-3d-point '(0 1 0))
                      "New_UCS"))

      ;faz zoom extents, para a seleção funcionar corretamente.
      ;a seleção so funciona em coisas que são visiveis na tela, por iso o zoom
      ; e por iso ligamos os layers
      (vla-zoomextents  (vlax-get-acad-object))

      ;registra no log as coordenadas do retângulo que vamos exportar
      (write-line (strcat "\t\t\t\t\tselecionar dentro de:"
              (apply 'strcat (mapcar '(lambda(c)
                            (
strcat "\t"
                                (rtos (car c) 2 3)
                                ","
                                (rtos (cadr c) 2 3)
                                ))
                         (
list pa pb pd pc))))
    logFile)

      ;testa a existencia de uma seleção chamada "allWin"
      (if (not (vl-catch-all-error-p
         (setq ssallWin (vl-catch-all-apply 'vla-item (list ssets "allWin")))))
    (
vla-delete ssallWin))

      ;cria a seleção "allWin"
      (setq ssallWin (vla-add ssets "allWin"))

      ;cria um poligono para selecionar os objetos que estão dentro ou que tocam o polígono
      (Setq pointsArray (vlax-make-safearray vlax-vbDouble '(0 . 11)))

      (
setq pointsArray (vlax-safearray-fill pointsArray (append pa pb pd pc)))

      ;seleciona tudo dentro do poligono
      (vla-SelectByPolygon ssallWin acSelectionSetCrossingPolygon pointsArray)

      ;registra no log
      (write-line "\t\t\t\t\twblocking..." logFile)

      ;faz o wblock dos elementos selecionados
      (vla-wblock doc (strcat  destino arq)  ssallWin)

      ;conseguimos chegar ao fim!!! registra!!!
      (write-line "\t\t\t\tfinalizado!" logFile)

      ; T é a saída da subrotina "cria-wblock", pois conseguimos processar tudo 
      t
      )

    ;para o caso de não processar tudo, registre no log e retorne NIL
    (progn 
       (write-line (strcat "\t\t\t\tnão foi possivel encontrar o retangulo em :" arq) logFile)
      nil)

    )
  )



(
setq arqErro nil)

;em todos os DWG da pasta de origem, faz
(foreach arq arqs
  ;tente rodar a subrotina "cria-wblock" nele
  (if (vl-catch-all-error-p (Setq res (vl-catch-all-apply 'cria-wblock (list arq))))

    ;se ocorrer um erro, registre
    (progn
      (write-line (strcat "erro em processar :" arq "\n" (vl-catch-all-error-message res)) logFile)
      (
setq arqErro (cons arq arqErro)))

    ;se o resultado da subrotina for NIL, aconteceu algum erro. armazene o nome do arquivo
    (if (not res) (setq arqErro (cons arq arqErro)))
    )


  ;a subrotina abriu o DWG, então feche sem salvar
  (vla-close doc :vlax-false)
  )


;feche o arquivo de log, agora você pode abrir ele com o bloco de notas e
;ver o resultado!!!
(close logFile)


Segunda ou coloco umas imagens no post.
Leia o código somente nas linhas comentadas, para entender como ele funciona.
Depois, analise o código. Pode ser que você goste!!!!

Visual Lisp - Ainda não morreu!!!!

Mais um dia, mais um serviço pro estagiário....

Dessa vez, imagine o seguinte:

Você tem um eixo, que digitalizou no Google Earth, por exemplo. Ele tem, digamos 800 km

Suponha, que você tenha clicado um vértice a cada 50 metros.

Agora, imagine que em cada 1000 metros, tem um marco de quilometragem, que você digitalizou com aqueles "pinos" do Google Earth.



Agora, suponha que queira desenhar isso tudo no AutoCAD.

Obviamente, você pode usar o READKML2, para importar:


Bom, mas não satisfeito com isso, você resolve que precisa inserir no AutoCAD, um texto em cada vértice da polilinha, com o seu KM em relação aos marcos de quilometragem.

Faz as contas, 800 km, um a cada 50 m..... 16 mil textos.

Aí, claro, tem de calcular a interpolação dos pontos.

Bom, Vamos, lá programar isso, porque fazer na mão.... esquece!!!


;lista todos os blocos com o texto do nome da estação e km
(setq ss (ssget "X" '((0 . "INSERT") (2 . "MARCO_KM"))))

;seleciona o eixo de referencia
(SETQ EIXO (CAR (ENTSEL)))

;cria uma lista com '((distancia "codigo_estacao" km_estação) .... )
(SETQ LST
  (MAPCAR '(LAMBDA (ENT)

      ;se está no formato "CODIGO - KM", adiciona à lista
      (IF (/= "ZTO'" (GET-TAG-PROP ENT "NOME"))
        ;se o bloco está ate 30 metro do eixo, é uma estação válida, então adiciona
        (IF (< (DISTANCE (DXF 10 ENT)
    ;projeção do ponto no eixo
    (SETQ PTPROX (VLAX-CURVE-GETCLOSESTPOINTTO EIXO (DXF 10 ENT)))
    )

        30)
      


   ;cria uma lista neste formato: (distancia "codigo_estacao" km_estação)
   (APPEND
                 (LIST (VLAX-CURVE-GETDISTATPOINT EIXO PTPROX))
   (
READ (STRCAT "(\"" (VL-STRING-SUBST "." ","
           (VL-STRING-SUBST "\"" " - "
      (GET-TAG-PROP ENT "NOME"))) ")"))))))
 (
DXF -1 SS)))

;remove o lixo e ordena pela primeira coluna (distancia)
(SETQ LST (VL-SORT (VL-REMOVE 'NIL LST) '(LAMBDA (A B) (< (CAR A) (CAR B)))))

;lista todos os vértices do eixo, sem duplicatas
(SETQ PTS (RMPDUP (GET-POINTS-POLIG EIXO)))

;processa todos os pontos do eixo
(FOREACH PT PTS
  ;calcula a distância até o início sobre o eixo
  (SETQ DIST (VLAX-CURVE-GETDISTATPOINT EIXO PT))

  ;acha a estação posterior ao ponto em questão
  (SETQ DEPOIS (CAR (VL-REMOVE 'NIL (MAPCAR '(LAMBDA (A) (IF (> (CAR A) DIST)  A)) LST))))

  ;acha a estação anterior ao ponto em questão
  (SETQ ANTES  (LAST (VL-REMOVE 'NIL (MAPCAR '(LAMBDA (A) (IF (< (CAR A) DIST)  A)) LST))))

  ;se tem as duas, interpola
  (IF (AND ANTES DEPOIS)
    ;se são a mesma, desenha
    (IF (EQ ANTES DEPOIS)
      (
DRAW-TEXT  (RTOS (CADDR ANTES) 2 0)  pt "KM" 0 5 "ARIAL" "TR"  )

      ;se a distância interpolada "D" em KM da estação anterior é menor que 2200,
      ;pois tem uma estação faltando, desenha, senão marca com círculo
      (IF (< (SETQ D ( * (- DIST (CAR ANTES))
    (
/ (- (CAR DEPOIS) (CAR ANTES))
       (
- (CADDR DEPOIS) (CADDR ANTES)))))
      2200)
 (
DRAW-TEXT  (RTOS (+ (CADDR ANTES) D ) 2 0)  pt "KM" 0 5 "ARIAL" "TR"  )
 (
ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 10 PT) (CONS 40 4) (CONS 8 "ERRO")))))

    ;se só tem a estação posterior
    (IF DEPOIS
      ;se a distância da estação posterior é menor que 2200, desenha, senão marca com círculo
      (IF (< (- (CAR DEPOIS) DIST) 2200)
         (
DRAW-TEXT (RTOS (- (CADDR DEPOIS) (- (CAR DEPOIS) DIST)) 2 0)  pt "KM" 0 5 "ARIAL" "TR"  )
         (
ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 10 PT) (CONS 40 4) (CONS 8 "ERRO"))))

      ;se só tem a estação anterior
      (IF ANTES
 ;se a distância da estação anterior é menor que 2200, desenha, senão marca com círculo
 (IF (< (- DIST (CAR ANTES) ) 2200)
   (
DRAW-TEXT (RTOS (+ (CADDR ANTES) (- DIST (CAR ANTES) )) 2 0) pt "KM" 0 5 "ARIAL" "TR")
   (
ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 10 PT) (CONS 40 4) (CONS 8 "ERRO"))))
      ))))



Ah, DXF, GET-TAG-PROP, RMPDUP, GET-POINTS-POLIG, DRAW-TEXT, são subrotinas que estão aqui na página. Divirta-se procurando elas!!!!

Olha o resultado:


Difícil?

O programinha tem 74 linhas, gastei uns 20 minutos para escrever, depurar e rodar.

Agora, faz as contas de quanto aquele seu estagiário precisaria para fazer o mesmo trabalho ??

Sim, me pediram mesmo pra fazer esse trabalho... hehehe