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!!!!