Juntar 2 rotinas MUITO BOAS!!! =)

Mais um da série desafios...

Moderador: Moderadores

Responder
Luciano G.
Novato
Novato
Mensagens: 1
Registrado em: Dom 09 Mar 2014 5:24:32 pm

Juntar 2 rotinas MUITO BOAS!!! =)

Mensagem por Luciano G. » Dom 09 Mar 2014 5:40:38 pm

SUPER ROTINA DE LIMPEZA! ME AJUDEM À JUNTÁ-LAS??? =)

Olá amigos! Será que algum de vocês consegue juntar essas duas rotinas pragente? São ótimas rotinas de limpeza PARA BLOCOS, mas só seriam PERFEITAS se estivessem juntas, para limpar uma pasta inteira de blocos!!!

A 1ª, BATCHJOB, te pede pra selecionar uma pasta do Windows e abre todos os arquivos DWG, um a um, passando tudo para o layer 0, dando PURGE, ZOOM EXTENTS e salvando o desenho (Mas não muda o layer das entidades dentro de "BLOCOS" e precisa deixar o CAD executando sem mudar a janela! Fazer o quê, né?

A 2ª resolveria o problema da 1ª! A "FIXBLOCK" te pede para selecionar uma área do desenho (sugiro Ctrl+A, para automatizar) e passa todas as entidades DOS BLOCOS na área selecionada para o Layer 0 (mas ainda não limpa os "blocos dentro de blocos", infelizmente! ...),=)

Estou usando a BATCHJOB para limpar uma pasta com mais de 4.000 arquivos, e por mais que dê uns errinhos, pq os arquivos são grandes, só levo pouco tempo para reiniciar o processo. MAS NÃO ADIANTA NADA SE OS BLOCOS CONTINUAREM CHEIOS DE LAYERS, NÉ?! ^^

Coloco as LISPs abaixo, pra que quiser analisar, e posso enviar o arquivo para quem quiser.

ESPERO QUE ALGUÉM CONSIGA ME AJUDAR!!!

Essa opção de executar uma LISP em "todos os DWGs de uma pasta" é INCRÍVEL!!! Espero que possam aproveitar o texto para outras programações e corrigir o problema de pararem a rotina, de vez em quando, para nos perguntar se queremos apagar todos os filtros de layers.... =/ .... É MEIO LÓGICO QUE QUEREMOS, NÉ??? Pra que serve filtros de layers em um arquivo só com o layer 0??? >:o

Esse erro impossibilita de ir dormir e deixar os arquivos sendo limpados...),= Infelizmente.... ^^ Mas continuo feliz com o que tenho e espero que possam aproveitar as lisps E MELHORÁ-LAS!!!

DESCULPEM O TEXTO MEGA e vejam as lisps abaixo. Bração!!!
(INFELIZMENTE A FORMATAÇÃO DO SITE ATRAPALHA A DA LISP, MAS POSSO PASSAR POR E-MAIL O TEXTO CORRETO E ANEXÁ-LAS PRA QUEM PEDIR =)


;;; Main program, command: batchjob
;;; By Abdul Huck
(defun c:BatchJob (/ dwgs file dwgName scrFile folderName)
(setq folderName
(browsefolder "Select folder to perform batch job: ")
)
(setq dwgs (vl-directory-files folderName "*.dwg"))
(setq scrFile (open (strcat folderName "\\batchJob.scr") "w"))
(write-line ";;; © Abdul Huck, abdulhuck@rediffmail.com \n;;;" scrFile)
(write-line "SDI 1" scrFile)
(foreach file dwgs
(setq dwgName (strcat "\"" folderName "\\" file "\""))
(write-line ".Open" scrFile)
(write-line dwgName scrFile)
(write-line
".chprop all la 0 c bylayer lw bylayer "
scrFile
)
(write-line "-purge a * n" scrFile)
(write-line ".zoom e" scrFile)
(write-line ".Qsave" scrFile)
)
(close scrFile)
(command ".script" (strcat folderName "\\batchJob.scr"))
(princ)
)
;;; Function to browse folder
;;; This code was originally posted by kpblc2000 in AUGI AutoLisp Forum
;;;
(defun browsefolder (title / shlobj folder fldobj)
(vl-load-com)
(setq
shlobj (vla-getinterfaceobject
(vlax-get-acad-object)
"Shell.Application"
)
folder (vlax-invoke-method shlobj 'browseforfolder 0 title 0)
)
(vlax-release-object shlobj)
(if folder
(progn
(setq
fldobj (vlax-get-property folder 'self)
folderName (vlax-get-property fldobj 'path)
)
(vlax-release-object folder)
(vlax-release-object fldobj)
folderName
)
)
)
(princ "\nBatchJob is loaded, Type BatchJob to run.")
(princ)




;FIXBLOCK.LSP [4/16/96]
;
; Copyright 1996 Manu-Soft Computer Services
;
; freeware by:
; Owen Wengerd
; Manu-Soft Computer Services
; CompuServe: 71324,3252
; owenw@nvi.nvi.net
;
; Load function, then enter FIXBLOCK to redefine selected blocks
; so that all entities are on layer '0'.
;


(defun c:fixblock (/ ss cnt b donelist bredef)
(defun bredef (b / e el)
(setq e (tblobjname "BLOCK" b))
(while e
(setq el (entget e))
(setq el (subst '(8 . "0") (assoc 8 el) el))
(setq el (if (assoc 62 el) (subst '(62 . 0) (assoc 62 el) el) (append el '((62 . 0)))))
(entmake el)
(setq e (entnext e))
)
(if (/= "ENDBLK" (cdr (assoc 0 el))) (entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))
)
(if (> (logand (cdr (assoc 70 (tblsearch "layer" "0"))) 1) 0)
(princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
(if (setq ss (ssget '((0 . "INSERT"))))
(progn
(setq cnt (sslength ss))
(while (>= (setq cnt (1- cnt)) 0)
(if (not (member (setq b (cdr (assoc 2 (entget (ssname ss cnt))))) donelist))
(progn
(bredef b)
(setq donelist (cons b donelist))
)
)
)
(princ (strcat "\n" (itoa (sslength ss)) " blocks redefined\n"))
)
(princ "\nNo blocks selected!\n")
)
)
(princ)
)
;End-of-file


ESPERO QUE ALGUÉM CONSIGA JUNTAR! Não parece ser difícil, mas eu não entendo NADA de programação...),=)

Avatar do usuário
marcos
Administrador
Administrador
Mensagens: 610
Registrado em: Sex 28 Nov 2003 11:00:00 pm
Localização: Itu / SP
Contato:

Re: Juntar 2 rotinas MUITO BOAS!!! =)

Mensagem por marcos » Qui 20 Mar 2014 10:38:51 am

tentei rodas as duas rotinas mas tá dando erro aqui no meu autocad 2014.... elas estão funcionando normalmente pra vc?
Marcos Mendes de Almeida
mmalbr@gmail.com

Responder