Ouça uma das minhas músicas preferidas: , ou o canto de um passarinho: /spam>>

  ♩ ♪ ♫ Música do Dia  ♩  ♪♫

quarta-feira, 15 de agosto de 2012

Autolisp para salvar textos do AutoCAD para arquivos



; Salva o conteúdo dos textos (text ou mtext) selecionados em um arquivo.

(defun c:text2arq()

(z1)

(setq arqz (open "c:\\dados.txt" "w"))
(setq n 1)
(setq color 4)
(while (= n 1)
(setq ent (entsel))
(if ent (progn
(command "change" ent "" "p" "c" color "")
(setq nome (nth 0 ent))
(setq ent (entget nome))
(setq ent (assoc 1 ent))
(setq z (cdr ent))
(print z arqz)
(z2)
)
(setq n 0)
)
)
(alert "Fim")
(close arqz)
(z3)
)
(defun z1()
(setvar "useri1" 1)
)
(defun z2()
(setvar "useri1" 2)
)
(defun z3()
(setq k1 (getvar "useri1"))
(if (= k1 2)
(progn
(while (/= k1 1)
(command "u")
(setq k1 (getvar "useri1"))
)
))
)



Autolisp para alinhar texto em relação à uma linha


; Alinha o texto selecionado em relação à uma linha

(defun c:atexto()
(print)
(prompt "Selecione a linha. ")
(setq obj (entsel))
(setq obj  (car obj))
(setq obj (entget obj))


(setq p1 (assoc 10 obj))
(setq p2 (assoc 11 obj))

(setq x1 (nth 1 p1))
(setq y1 (nth 2 p1))

(setq x2 (nth 1 p2))
(setq y2 (nth 2 p2))

(if (= (- X1 X2) 0)
(setq ang (/ pi 2))
(setq ang (atan (/ (- y1 y2) (- x1 x2))))
)
(setq ang (/ (* 180 ang) pi))

(setq obj (entsel "Selecione o texto. "))

(command "change" obj "" "" "" "" "" ang "")

)


Autolisp para criar vistas (viewports no layout) em escala



; Rotina para criar vistas (viewports no layout) em escala
; Iniciar no "Model"
; p1 e p2 -> vértices do retângulo que inclui o desenho a ser representado
; model em metros e layout em milímetros

(defun c:cv ()
  (setq escala (getreal "Escala da Vista que será criada no Layout: "))
  (setq fs (/ 1000 escala))
  (setq p1 (getpoint "Ponto Inferior esquerdo..."))
  (setq p2 (getpoint "Ponto Superior Direito..."))
  (setvar "tilemode" 0)
  (setq x1 (nth 0 p1))
  (setq y1 (nth 1 p1))
  (setq x2 (nth 0 p2))
  (setq y2 (nth 1 p2))

  (setq p3 (getpoint "Ponto Inferior Esquerdo da Vista que será criada..."))

  (setq x3 (nth 0 p3))
  (setq y3 (nth 1 p3))

  (setq dx (- x2 x1))
  (setq dy (- y2 y1))

  (setq p4 (list (+ x3 (* fs dx)) (+ y3 (* fs dy))))


  (setq p5 (list (+ x3 (* fs dx) 30) (+ y3 (* fs dy) 30)))
  (command "zoom" p3 p5)

  (command "mview" p3 p4)

  (prompt "Dê um duplo vista que foi criada e digite 0 ")

)
(defun c:0()
(command "zoom" p1 p2)
(setq p1 nil p2 nil)
(command "mview" "lock" "on" "l" "")
)



Autolisp para verificar se existem objetos com cores diferentes de 1 a 8


; Verifica se existem objetos com cores diferentes de 1 a 8
; Muda cores diferentes para a cor vermelha
; Não funciona se a cor do objeto estiver definida pela layer

(defun c:VerCor()

(setq en 0 k 0)

(setq o (ssget))

(while en

(setq en (ssname o k))
(setq k (+ k 1))

(setq objeto en)

(if en (progn

(setq en (entget en))

(setq dt (getvar "color"))

(setq en (assoc 62 en))
(setq corDoObjeto(cdr en))

(if (> corDoObjeto 8) (progn

(command "change" objeto "" "p" "c" "1" "")

))
))

)

)


Autolisp para verificar se existem objetos com cores diferentes de 1 a 8


; Verifica se existem objetos com cores diferentes de 1 a 8
; Muda cores diferentes para a cor vermelha
; Não funciona se a cor do objeto estiver definida pela layer

(defun c:VerCor()

(setq en 0 k 0)

(setq o (ssget))

(while en

(setq en (ssname o k))
(setq k (+ k 1))

(setq objeto en)

(if en (progn

(setq en (entget en))

(setq dt (getvar "color"))

(setq en (assoc 62 en))
(setq corDoObjeto(cdr en))

(if (> corDoObjeto 8) (progn

(command "change" objeto "" "p" "c" "1" "")

))
))

)

)


Autolisp para verificar se existem objetos com cores diferentes de 1 a 8


; Verifica se existem objetos com cores diferentes de 1 a 8
; Muda cores diferentes para a cor vermelha
; Não funciona se a cor do objeto estiver definida pela layer

(defun c:VerCor()

(setq en 0 k 0)

(setq o (ssget))

(while en

(setq en (ssname o k))
(setq k (+ k 1))

(setq objeto en)

(if en (progn

(setq en (entget en))

(setq dt (getvar "color"))

(setq en (assoc 62 en))
(setq corDoObjeto(cdr en))

(if (> corDoObjeto 8) (progn

(command "change" objeto "" "p" "c" "1" "")

))
))

)

)


Autolisp para verificar se existem objetos com cores diferentes de 1 a 8


; Verifica se existem objetos com cores diferentes de 1 a 8
; Muda cores diferentes para a cor vermelha
; Não funciona se a cor do objeto estiver definida pela layer

(defun c:VerCor()

(setq en 0 k 0)

(setq o (ssget))

(while en

(setq en (ssname o k))
(setq k (+ k 1))

(setq objeto en)

(if en (progn

(setq en (entget en))

(setq dt (getvar "color"))

(setq en (assoc 62 en))
(setq corDoObjeto(cdr en))

(if (> corDoObjeto 8) (progn

(command "change" objeto "" "p" "c" "1" "")

))
))

)

)


Autolisp: Exemplo de uso de (grread)



; Para desenhar linha pressionando qualquer tecla (só movendo o cursor e pressionando a tecla "espaço", por exemplo)
; Inicie o desenho com uma linha (dois pontos) e depois continue desenhando apenas clicando ou pressionando qualquer tecla.
; Pressione "Esc" para abortar
; Digite "desenhar" para iniciar e "cdesenho" para prosseguir depois de ter abortado

(defun c:desenhar()
(setq p1 (getpoint "Ponto inicial..."))
(setq p2 (getpoint "Segundo ponto..."))
(command "line" p1 p2 "")
(while p1
(setq p2 (grread (setq code (grread))))
(setvar "pickbox" 5)
(command "line" "" (nth 1 p2) "" )
(setvar "pickbox" 4)
)
)
(defun c:cdesenho()
(while 1
(setq p2 (grread (setq code (grread))))
(command "line" "" (nth 1 p2) "" )
)
)



Autolisp para Multiplicar uma constante pelo texto selecionado



; Multiplica uma constante pelo texto selecionado

(defun c:constex()

(setq k (getreal "Constante:  "))

(setq o (entsel "Selecione o texto a ser alterado "))
(setq n (read (cdr (assoc 1 (entget (car o))))))

(setq prod (rtos (* n k) 2 2))

(command "change" o "" "" "" "" "" "" prod)

)


terça-feira, 14 de agosto de 2012

Autolisp para cotar linha (comprimento 3D)


; Cotar linha (comprimento da linha 3D) com texto

(defun c:cotarlin()
(command "dist" pause pause)
(setq d (getvar "distance"))
(setq Comprimento (strcat "Comprimento: " (rtos d 2 2) "m"))
(command "text" "mid" pause "" pause Comprimento)
)


Autolisp: Selecionando objetos pela cor


; Seleciona todos os objetos com a cor branca e muda para vermelha

(DEFUN C:SelCor()

(setq ss1 (ssget  '((62 . 7))))

(command "change" ss1 "" "p" "c" "1" "")

)


segunda-feira, 13 de agosto de 2012

Autolisp para desfazer ações até determinado ponto

; Desfaz ações até objeto marcado

(defun c:cdesfazer()
(command "change" pause "" "P" "c" 191 "")
(setq k 0)

(while (= k 0)
(setq objeto (ssget "l"))
(setq en (ssname objeto 0))
(setq en (entget en))
(setq en (assoc 62 en))
(setq corDoObjeto(cdr en))

(if (= corDoObjeto 191)
(progn (setq k 1))
(progn (command "erase" objeto "")
 ; ou use (command "undo" "")
)
)

)
)


Rotina para criar layers específicos para cada objeto


; Cria layers específicos para cada objeto existente no desenho.

(defun c:Objlay()
  (setq obj (ssget "X" '((0 . "HATCH"))) )
  (command "layer" "n" "hachura" "")
  (command "change" obj "" "P" "LA" "HACHURA" "")

  (setq obj (ssget "X" '((0 . "DIMENSION"))) )
  (command "layer" "n" "COTAS" "")
  (command "change" obj "" "P" "LA" "COTAS" "")
 
  (setq obj (ssget "X" '((0 . "TEXT"))) )
  (command "layer" "n" "TEXTO" "")
  (command "change" obj "" "P" "LA" "TEXTO" "")
 
  (setq obj (ssget "X" '((0 . "MTEXT"))) )
  (command "layer" "n" "TEXTO" "")
  (command "change" obj "" "P" "LA" "TEXTO" "")

  (setq obj (ssget "X" '((0 . "LEADER"))) )
  (command "layer" "n" "TEXTO" "")
  (command "change" obj "" "P" "LA" "TEXTO" "")

  ; inserir novos objetos.
)

sábado, 11 de agosto de 2012

Autolisp para calcular a área e dimensões (L x H) de um retângulo a partir de dois pontos


; Calcula a área e dimensões (L x H) de um retângulo a partir de dois pontos (Cantos)
; Escreve os valores no cento do retângulo

(defun c:2pa()
(setq Pie (getpoint "Canto 1  "))
(setq Psd (getpoint "Canto 2   "))

(setq xie (nth 0 Pie))
(setq yie (nth 1 Pie))

(setq xsd (nth 0 Psd))
(setq ysd (nth 1 Psd))

(setq Pid (list xsd yie ))
(setq Pse (list xie ysd ))

(command "area" "NON" Pie "NON" Pid "NON" Psd "NON" Pse "")

(setq area (getvar "area"))
(command "dist" "NON" Pie "NON" Pid)
(setq d1 (* (getvar "distance") 100))
(command "dist" "NON" Pie "NON" Pse)
(setq d2 (* (getvar "distance") 100))

(setq pm (list (/ (+ (nth 0 Pie) (nth 0 Psd)) 2) (/ (+ (nth 1 Pie) (nth 1 Psd)) 2)))
(setq X (rtos (/ d1 100) 2 2))
(setq Y (rtos (/ d2 100) 2 2))
(setq CalcDim (strcat "Área = " (rtos area 2 2) " - Dimensões: " X "x" Y " m"))

(command "text" pm "0.50" "" CalcDim)
)


Autolisp para salvar modificações sem criar arquivo de backup .BAK


; Salva modificações sem criar arquivo de backup .BAK
; Útil, se o arquivo é muito grande e já existe backup em outro lugar.

(defun c:SSB()
  (setvar "isavebak" 0)
  (command "qsave")
  (setvar "isavebak" 1)
)

sexta-feira, 10 de agosto de 2012

Autolisp para copiar dados de um arquivo txt e colocar em atributos


;; Copia dados de um arquivo txt e coloca em atributos
;; k define onde o arquivo começa a ser lido
;; x armazena a linha lida

(defun c:arq2att()
(setq k (getreal "Defina a linha do início da leitura (Zero: primeira linha)"))
(setq o (entsel "Selecione Atributo "))
(setq arq (open "c:\\dados.txt" "r"))

(while o

(setq x (read-line arq))

(if (= k 1) (setq x (read-line arq)))

(if x
(command "change" o "" "" "" "" "" "" x "" "")
)

(setq o (entsel "Selecione Atributo "))

)
(close arq)
)


quinta-feira, 9 de agosto de 2012

Rotina simples Autolisp para diminuir a quantidade de textos ilegíveis no levantamento

;; Seleciona todos os textos com altura menor que 4 e muda suas cores para vermelho (menor espessura de linha)

(defun c:textpSel()
(setq ot (ssget "X" '((0 . "text") (-4 . "<") (40 . 4))))
(setq omt (ssget "X" '((0 . "mtext") (-4 . "<") (40 . 4))))
(command "change" ot "" "p" "c" "1" "")
(command "change" omt "" "p" "c" "1" "")
)

domingo, 15 de julho de 2012

Rotina Autohotkey para iniciar um programa direto da "Caixa de Diálogo Executar"


Pegue o caminho do executável. Por exemplo, o caminho do IrfanView: C:\Arquivos de programas\IrfanView\i_view32.exe


Crie uma arquivo chamado "iv.ahk"

Abra o arquivo "iv.ahk" com um editor de texto e insira o código abaixo:


run "C:\Arquivos de programas\IrfanView\i_view32.exe"


Salve o arquivo e compile.

Coloque o arquivo compilado "iv.exe" na pasta "C:\WINDOWS"

Vá em "Iniciar", escolha "Executar" e digite "iv" para iniciar o Irfan View.



sábado, 14 de julho de 2012

O Pequeno Universo de Conway em JavaScript

 Ao lado (ou canto superior direito deste blog): o "jogo da vida de Conway" em JavaScript (quadradinhos seguindo regras locais bastante simples e gerando padrões complexos). Para Richard Dawkins uma ótima analogia de formas complexas emergindo de um mundo governado por regras muito simples e locais. Stephen Hawkings e Mlodinow observam "Lei Aparentes" (leis físicas complexas emergindo de uma realidade onde só existem duas regras: quadrados vivem ou morrem).

 Se o estado de cada quadrado começa ao acaso (começo caótico), vê-se uma explosão de vida, depois a morte se alastra e sobra muito espaço para experimentar (clicar nos espaços vermelhos).

No topo do Blog, um "Mundo de Conway em linha". Este mundo linha privilegia os estados que tendem à direita (0 com 1 à direita revive, 1 com 1 à direita sobrevive, 1 ou 0 em outras situações morre ou permanece morto). Clicando nos quadrinhos pode-se tentar matar o que parece pequenos vermes que sempre regeneram a cabeça e o corpo (e até se duplicam).


Sobre o "Jogo da Vida" de Conway


sexta-feira, 6 de julho de 2012

Como criar um form simples com captcha usando PHP


Na maioria dos exemplos na internet é necessário colocar arquivos com as fontes no servidor (por exemplo, arquivos TTF). Este usa um número gerado aleatoriamente. Aparentemente ele é menos seguro, mas certamente muito mais fácil de entender.


How do I create a simple contact form with captcha using PHP? -  Clique aqui para ver


segunda-feira, 2 de julho de 2012

quarta-feira, 27 de junho de 2012

Recomendo: Spybot



Spybot Search and Destroy. Porém, recomendo baixar do site do desenvolvedor para evitar as armadilhas dos sites de download de programas.


quarta-feira, 21 de dezembro de 2011

Macro para criar cópias de segurança automaticamente ao sair do Word


' Macro para sempre manter uma cópia de segurança


' Colocar este código em normal / módulo1

Function FazerCopiaS()
'
' Macro1 Macro
' Macro gravada 15/10/2011 por Cliente
'
    Set fs = CreateObject("Scripting.FileSystemObject")
   
    CaminhoDocumento = fs.buildpath(ActiveDocument.Path, ActiveDocument.Name)
    CaminhoCopiaS = fs.buildpath("D:\SuaPasta\Minhas Cópias de Segurança", ActiveDocument.Name)
   
    fs.CopyFile CaminhoDocumento, CaminhoCopiaS
   
End Function
       
  
' Colocar este código em ThisDocument (salva ao sair do Word: mudar para _Save e ver se funciona)

Private Sub Document_Close()

FazerCopiaS

End Sub

Macro VBA para colar especial no Word

' Macro para colar somente texto.
' Por que o gravador de macro do winword não registra esta ação com precisão.

Sub PasteUnfText()
    On Error GoTo oops
    Selection.PasteSpecial _
    DataType:=wdPasteText, _
    Placement:=wdInLine
    End
oops:
Beep
End Sub


Fonte: http://www.gmayor.com/word_vba_examples.htm


domingo, 10 de julho de 2011

Exemplo de rotina autohotkey para os viciados em computador

; Exemplo de rotina autohotkey para os viciados em computador.
; Script para controlar o tempo em frente ao computador
; http://www.autohotkey.com/docs/Tutorial-Portuguese.html

#SingleInstance force

msgSair = Pressione ctrl + alt + X parar controle.

InputBox, Minutos, Auto Desligamento, Minutos para desligar...

if ErrorLevel
MsgBox, CANCEL was pressed.
else
{

TempoTotal := Minutos

if (Minutos=0)
{
exit
}
else
{

loop
{

Alerta0 = Se não for fazer nada de importante é melhor desligar esta tranqueira agora mesmo!

Alerta1 = em frente a essa tranqueira pense numa estratégia para sair daí o mais rápido possível!

Alerta2 = acho que o que tinha de importante já deve ter sido feito. Pense no mundo lá fora!
Alerta3 = Você ainda está aí? Que tal ir ler um livro.
Alerta4 = Realmente é importante o que está fazendo. Por que não vai dar uma volta lá fora...
Alerta5 = Insira outros alertas
Alerta5 = Insira outros alertas
Alerta6 = Insira outros alertas
Alerta7 = Insira outros alertas
Alerta8 = Insira outros alertas

TrayTip , Este computador vai desligar em, %Minutos% minutos para proteger a sua saúde `n`n %msgSair%, 1

sleep, 5000

TempoDecorrido := TempoTotal - Minutos

minutos := minutos - 1

if (TempoDecorrido=0)
{
TrayTip , Alerta! , %Alerta0% , 1
}
else if (TempoDecorrido=15)
{
TrayTip , Alerta! , %TempoDecorrido% minutos %Alerta1%, 1
}
else if (TempoDecorrido=30)
{
TrayTip , Alerta! , %TempoDecorrido% minutos %Alerta2%, 1
}
else if (TempoDecorrido=45)
{
TrayTip , Alerta! , %TempoDecorrido% minutos %Alerta3%, 1
}
else if (TempoDecorrido=50)
{
TrayTip , Alerta! , %TempoDecorrido% minutos %Alerta4%, 1
}
else if (TempoDecorrido=55)
{
TrayTip , Alerta! , %TempoDecorrido% minutos %Alerta5%, 1
}
else if (TempoDecorrido=58)
{
TrayTip , Alerta! , %TempoDecorrido% minutos %Alerta6%, 1
}
else if (TempoDecorrido=59)
{
TrayTip , Alerta! , %TempoDecorrido% minutos %Alerta7%, 1
}
else if (TempoDecorrido=60)
{
TrayTip , Alerta! , %TempoDecorrido% minutos %Alerta8%, 1
}

sleep, 58000

if minutos < 1
break

if minutos >= 1
continue
}

Shutdown, 1
send, F

}
}

^!X::ExitApp

; Criador *codes***@gmail.com - *codes***@yahoo.com.br

Macro para Excel - Elimina linhas repetidas

Sub EliminarLinhasRepetidas()

' Macro para Excel

' Elimina linhas repetidas.

' As linhas devem estar classificadas.

' Vantagem: bem mais rápida do que a anterior

' Criador: *codes***@gmail.com - *codes***@yahoo.com.br

contador = 0

valor = ActiveCell.Value

ActiveCell.Offset(1, 0).Range("A1").Select

While ActiveCell.Value <> ""

If ActiveCell.Value = valor Then

Selection.Delete Shift:=xlUp

contador = contador + 1

Else

valor = ActiveCell.Value

ActiveCell.Offset(1, 0).Range("A1").Select

End If

Wend

MsgBox ("Linhas Eliminadas = " & contador)


End Sub

Rotina Autohotkey - Uma idéia de rotina para apagar linhas de qualquer arquivo de texto

; Rotina Autohotkey - http://www.autohotkey.com/download/
; Uma idéia de rotina para apagar linhas de qualquer arquivo de texto com linhas ordenadas alfabeticamente
; Devantagens: a janela com o texto tem que estar aberta e é muito lenta para textos grandes.
; Atalho: control + win + alt + L

^#!L::

Contador := 1

Send, {CTRLDOWN}{END}{CTRLUP}
Send, {ENTER}
Send, MarcadorFinalizarPrograma
Send, {CTRLDOWN}{HOME}{CTRLUP}

loop

{

Contador := Contador + 1

Send, {SHIFTDOWN}{END}{SHIFTUP}

Send, {CTRLDOWN}c{CTRLUP}

Texto1 = %clipboard%

if (Texto1 = MarcadorFinalizarPrograma)
{
break
}

Send, {HOME}

Send, {DOWN}

Send, {SHIFTDOWN}{END}{SHIFTUP}

Send, {CTRLDOWN}c{CTRLUP}

Texto2 = %clipboard%

if (Texto1 = Texto2)
{
Send, {DEL}
sleep, 300
Send, {UP}
}

if Contador > 100000
break
}

return

; Criador: *codes***@gmail.com - *codes***@yahoo.com.br

sexta-feira, 1 de julho de 2011

Exemplo de Macro em VBA para apagar linha indesejada Word

' Apaga todas as linhas que contiverem a palavra definida pela variável ‘txtLinha’

Sub LimparCatalogo()
'
' LimparCatalogo Macro
' Macro gravada 18/6/2011 por Cliente
'

txtLinha = "@gmail.com"

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = txtLinha
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

While Selection.Find.Execute = True


Selection.Find.Execute
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

Wend

End Sub

quarta-feira, 2 de março de 2011

Delay no VBA

: Macro VBA
; Dá um delay de cinco segundos e continua executando o código

Sub Intervalo()

Dim StartTime As Date

StartTime = Now

Do While DateDiff("s", StartTime, Now) <> 5

Loop

MsgBox "Foi dado um Delay de cinco segundos."

End Sub

domingo, 6 de fevereiro de 2011

Rotina Autolisp para salvar em arquivo locais de mapas georeferenciados


;; Rotina para salvar locais visitados
;; Deve ser criada uma pasta chamada 'VG' em C:
;; Carregue a rotina usando o comando 'appload' ou configure para carregar automaticamente.
;; Use a linha de comando SV
;; Insira a definição do local
;; As informações sobre o local serão salvos no arquivo 'definição.src'
;; Use o comando SCR para inserir o local em qualquer outro mapa georeferenciado
;; Use as linha de comando '1' para rescrever o nome e '2' para localizá-lo com um círculo

(defun c:sv()


(setq Local (getstring T "Descrição: "))
(setq Caminho (strcat "C:\\VG\\" Local ".scr"))
(setq arq (open Caminho "w"))

(setq p1 (getpoint "Ponto "))

(setq x1 (rtos (nth 0 p1) 2 2))
(setq y1 (rtos (nth 1 p1) 2 2))
(setq z1 (rtos (nth 2 p1) 2 2))

(setq xyz (strcat x1 "," y1 "," z1))

(setq AS (chr 34))


(setq ComandoZoom (strcat "(command " AS "zoom" AS " " AS "c" AS " " AS xyz AS " " AS "10" AS ")"))
(setq ComandoTexto (strcat "(command " AS "text" AS " " AS xyz AS " pause pause " AS Local AS ")"))
(setq ComandoCircle (strcat "(command " AS "circle" AS " " AS xyz AS " pause" ")"))


(setq ComandoZoomText (strcat "(defun c:1()" ComandoZoom ComandoTexto "(" "prin1" " " AS "Local Atual: " Local "" AS ") (prin1))"))

(setq CommandCircle (strcat "(defun c:2()" ComandoCircle "(" "prin1" " " AS "Local Atual: " Local "" AS ") (prin1))"))

(write-line ComandoZoomText arq)

(write-line CommandCircle arq)


(close arq)


(command "text" p1 pause pause Local)


)

;; Criador: *codes***@gmail.com - *codes***@yahoo.com.br

sexta-feira, 4 de fevereiro de 2011

sábado, 24 de julho de 2010

Seleção - Inovação Tecnológica

Inovação Tecnológica - Resumo Junho 2010

Cientistas criam buraco negro artificial

Alquimia subterrânea transforma mina de carvão em mina de hidrogênio

Físicos explicam aerodinâmica da Jabulani, a bola da Copa

Vela solar começa a ser testada por sonda japonesa

Rádio cognitivo aprende a compartilhar frequências

Cientistas primeiros anticorpos artificiais

Laser de pulsos escuros produz disparos de escuridão

Efeitos da gravidade extrema são revelados pelo oxigênio

Tela sensível ao toque é construída com grafeno

Cientistas tentam recriar som da "Partícula de Deus"

Cientistas criam pulmão eletrônico dentro de um chip

Motor browniano funciona um século depois de idealizado

Cientistas criam fibras que produzem e detectam sons

Imagens médicas são criadas com técnica mais rápida que a luz

Asfalto de Interlagos pode chegar às ruas graças ao bagaço de cana

Matemáticos desenvolvem fórmula para prever engarrafamentos

Hubble captura espetacular berçário de estrelas

Tempestade gigantesca derrubou meio bilhão de árvores na Amazônia

Armadura líquida à prova de balas é testada com sucesso

Computação quântica: criado um canhão de fótons entrelaçados

Pernas biônicas devolvem andar a paraplégicos

Físicos afirmam ter criado material mais magnético do mundo

Arquitetura que cola: obra exigiu nova técnica de construção civil

Robôs de andar elegante e eficiente estão a caminho

Fibra óptica molecular é feita com proteína da fotossíntese

Adware tifoide, a nova ameaça da Internet em locais públicos

sábado, 1 de maio de 2010

Relógio que anuncia a hora com o canto de um passarinho

Este é um script que criei utilizando o Autohotkey (programa para criar rotinas no windows).
Trata-se apenas de um relógio que de 30 em 30 minutos anuncia as horas ao som de um passarinho.



Aqui está o link para baixar o Autohotkey.

Aqui está o link para o Código no Fórum do Autohotkey.

Aqui está o link para você baixar os Sons dos Passarinhos e Códigos.

Eu criei um setup com o Winrar para instalar automaticamente o relógio. Se quiser, você pode usá-lo para instalar o relógio sem precisar do Autohotkey.
Os coleirinhos da imagem, eu encontrei Aqui.

quarta-feira, 30 de setembro de 2009

AutoLisp para Trabalhar com Viewports

Como usar as Rotinas Lisp?

; Lisp para trabalhar com Viewports
; Dê dois cliques no layout para selecioná-lo. Digite:
; VV para verificar a escala
; VR para desenhar um retângulo no model correspondendo ao contorno do viewport

(defun c:vr()
(setq comando "rectangle")
(corpo)
)
(defun c:vv()
(setq comando nil)
(corpo)
)
(defun corpo()

(setq descr (vports))

(setq x1 (nth 0 (nth 1 (nth 0 descr))))
(setq x2 (nth 0 (nth 2 (nth 0 descr))))
(setq y1 (nth 1 (nth 1 (nth 0 descr))))
(setq y2 (nth 1 (nth 2 (nth 0 descr))))
(setq AlturaPS (- y2 y1))
(setq larguraPS (- x2 x1))

(setq hMS (getvar "viewsize"))

(setq escala (/ hMS AlturaPS))



(if comando
(PROGN

(setq osmodeIni (getvar "osmode"))
(setvar "osmode" 0)

(setq pms (getvar "viewctr"))
(setq xms (nth 0 pms))
(setq yms (nth 1 pms))

(setq xr1 (- xms (* (/ larguraPS 2) escala)))
(setq xr2 (+ xms (* (/ larguraPS 2) escala)))
(setq yr1 (- yms (* (/ AlturaPS 2) escala)))
(setq yr2 (+ yms (* (/ AlturaPS 2) escala)))

(setvar "tilemode" 1)
(command comando (list xr1 yr1) (list xr2 yr2))

(setvar "osmode" osmodeIni)

)
)

(print)
(prompt "-> Escala = 1:")
(prompt (rtos (* 1 escala) 2 2))
(prompt " - Se unidades usadas no model e layout são iguais!")
(print)
)

domingo, 31 de maio de 2009

Muda o tamanho de um objeto e executa o comando mover

Continuando com as Rotinas Lisps (Como usar as Rotinas Lisp?)
Mais um exemplo:

;; Muda o tamanho de um objeto e executa o comando mover (você então pode escolher um ponto base e depois mover o objeto para outra posição, útil quando você tem que alterar a altura de vários objetos e evitar que eles se superponham aos objetos vizinhos.)

(defun c:CotareMOver ()

(setq p1 (getpoint "P1 ___"))

(setq o (entsel "Objeto "))

(command "scale" o "" p1 "2")

(command "move" o "")

)

;; Criador: *codes***@gmail.com - *codes***@yahoo.com.br


Escreve a cota do ponto clicado

Continuando com as Rotinas Lisps (Como usar as Rotinas Lisp?)
Mais um exemplo:

;; Escreve a cota do ponto clicado

(defun c:Cotar ()

(setq p1 (getpoint "P1"))

(setq z (rtos (nth 2 p1) 2 2))

(setvar "osmode" 0)

(command "text" p1 ".8" "0" z)

(setvar "osmode" 9)

)

Copia cotas de um arquivo e escreve no desenho

Continuando com as Rotinas Lisps (Como usar as Rotinas Lisp?)
Mais um exemplo:

;; Copia cotas de um arquivo a coloca no desenho e ainda permite que você mova o texto de forma que ele não fique sobreposto a algum objeto já existente

(defun c:ObterCotas()

(setq arq (open "C:\\Nilson\\testcotas.txt" "r"))

(setq cota 0)

(while cota

(setq p1 (getpoint "Ponto "))

(setq cota (read-line arq))

(setq cota (strcat "(" cota ")"))

(command "text" p1 "1" "" cota)

(command "move" "l" "" pause pause)

)

(close arq)

)