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