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