transfomar meus blocos na hora de inserir em m, cm e mm

Dúvidas sobre VB para AutoCAD...

Moderador: Moderadores

Responder
Avatar do usuário
recca
Papel
Papel
Mensagens: 6
Registrado em: Qui 24 Mar 2005 12:00:00 am

transfomar meus blocos na hora de inserir em m, cm e mm

Mensagem por recca »

Alguem tem esta rotina em visual basica que eu possa inserir no meu menu personalizado.....
obrigado
Avatar do usuário
FELIXJM
Bronze 3/3
Bronze 3/3
Mensagens: 327
Registrado em: Ter 05 Abr 2005 12:00:00 am

Mensagem por FELIXJM »

Como é o codigo da linha de seu menu personalizado?

OK.
Felix Melo - Niteroi - RJ
Avatar do usuário
nuelss
Bronze 3/3
Bronze 3/3
Mensagens: 386
Registrado em: Qui 05 Ago 2004 12:00:00 am
Localização: São Simão - SP

Mensagem por nuelss »

:)

Olá Recca

Segue abaixo um trecho de um código de um programinha que eu fiz há algum tempo atráz ... Ele tinha por defaut a escala em METROS, e caso e usuario desejasse, na hora da inserção ele digitava apenas m, cm ou mm antes da inserção ... essa opção passava então a ser defaut ...

Obs: nesta rotina, algumas variaveis são globais e foram definidas em outro trecho da rotina (ou do programa), estas linhas são apenas para vc adaptar para as suas necessidades, caso vc queira fazer em autolisp, ao invés de visual ...

[lsp](defun finblk ()
(if (null funipv)
(setq funipv funi)
)
(if (null fatscpv)
(setq fatscpv (rtos fatsc))
)
(if
(= (findfile ftif) nil)
(progn
(setq fortmensag "Este bloco não existe, por favor entre em contato" fortmensag1 "com a xxxxxxxx para corrigir este problema !!!") (fortmessag)
)
(progn
(setq fl t)
(while fl ;| MAIS PRECISAMENTE, COMEÇA AKI ...;|
(cond
((equal funipv "m")
(setq fspr "Ponto de inserção ou [Escala de trabalho provisoria <m>/cm/mm]:")
)
((equal funipv "cm")
(setq fspr "Ponto de inserção ou [Escala de trabalho provisoria m/<cm>/mm]:")
)
((equal funipv "mm")
(setq fspr "Ponto de inserção ou [Escala de trabalho provisoria m/cm/<mm>]:")
)
)
(initget "M CM MM")
(setq npt (getpoint (strcat "\n" fspr)))
(cond
((= npt "M")
(setq funipv "m" fatscpv "1")
)
((= npt "CM")
(setq funipv "cm" fatscpv "100")
)
((= npt "MM")
(setq funipv "mm" fatscpv "1000")
)
(t (setq fl nil))
)
)
(if npt
(progn
(setvar "lastpoint" npt)
(if (null (tblsearch "layer" "FortCOD"))
(entmake
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 "FortCOD")
(cons 70 0)
(cons 62 -6)
(cons 6 "CONTINUOUS")
)
)
)
(prompt "\nAngulo de rotação <0>:")
(vl-cmdf "._insert" ftif npt fatscpv fatscpv pause) (fh)
(setvar "insname" ".")
)
)
)
)
)[/lsp]


Flw ...
"É a verdade o que assombra, o descaso que condena,
a estupidez o que destrói eu vejo tudo que se foi e que
não existe mais" (Metal Contra as Nuvens - Legião Urbana)

Abraço,
Emanuel 8)
Avatar do usuário
nuelss
Bronze 3/3
Bronze 3/3
Mensagens: 386
Registrado em: Qui 05 Ago 2004 12:00:00 am
Localização: São Simão - SP

Mensagem por nuelss »

:oops:

Fechei o comentario errado ... segue novamente ...

[lsp](defun finblk ()
(if (null funipv)
(setq funipv funi)
)
(if (null fatscpv)
(setq fatscpv (rtos fatsc))
)
(if
(= (findfile ftif) nil)
(progn
(setq fortmensag "Este bloco não existe, por favor entre em contato" fortmensag1 "com a xxxxxxxx para corrigir este problema !!!") (fortmessag)
)
(progn
(setq fl t)
(while fl ;| MAIS PRECISAMENTE, COMEÇA AKI ... |;
(cond
((equal funipv "m")
(setq fspr "Ponto de inserção ou [Escala de trabalho provisoria <m>/cm/mm]:")
)
((equal funipv "cm")
(setq fspr "Ponto de inserção ou [Escala de trabalho provisoria m/<cm>/mm]:")
)
((equal funipv "mm")
(setq fspr "Ponto de inserção ou [Escala de trabalho provisoria m/cm/<mm>]:")
)
)
(initget "M CM MM")
(setq npt (getpoint (strcat "\n" fspr)))
(cond
((= npt "M")
(setq funipv "m" fatscpv "1")
)
((= npt "CM")
(setq funipv "cm" fatscpv "100")
)
((= npt "MM")
(setq funipv "mm" fatscpv "1000")
)
(t (setq fl nil))
)
)
(if npt
(progn
(setvar "lastpoint" npt)
(if (null (tblsearch "layer" "FortCOD"))
(entmake
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 "FortCOD")
(cons 70 0)
(cons 62 -6)
(cons 6 "CONTINUOUS")
)
)
)
(prompt "\nAngulo de rotação <0>:")
(vl-cmdf "._insert" ftif npt fatscpv fatscpv pause) (fh)
(setvar "insname" ".")
)
)
)
)
)[/lsp]


Flw ...
"É a verdade o que assombra, o descaso que condena,
a estupidez o que destrói eu vejo tudo que se foi e que
não existe mais" (Metal Contra as Nuvens - Legião Urbana)

Abraço,
Emanuel 8)
Responder