Line Type com DCL


Vou postar uma rotina que fiz uns tempos atrás, não tem lá muita utilidade, mas serve para demonstrar como usar o SLIDER de um DCL e como usar alguns métodos de activex...
ver...

Salve o código abaixo em "ltsc.lsp":
(defun c:ltsc  (/ ss ent dcl actsld actref ref lst n
;carrega as vls.... : 
  (vl-load-com
  (
setq 
;subrotina que processa a seleção: 
        actsld (lambda (val /
                  (
setq n 0
                 (
set_tile "prc" (strcat val "%")) 
                  (
repeat (sslength ss
                   (
setq ent (vlax-ename->vla-object 
                               (ssname ss n))) 
                   ;altera a ltscale: 
                   (vla-put-LinetypeScale ent 
                     (* 0.01 (atoi val) ref)) 
                    ;atualiza a entidade: 
                   (vla-update ent
                   (
setq n (1+ n)))) 
;subrotina da ação do edit_box: 
        actref (lambda (val)  (setq ref (atof  val)) 
                 (
actsld (get_tile "sld"))) 
;ltscale de ref erencia inicia em 50% deste valor: 
        ref    2.0

  (
if (setq ss (ssget)) ;se for selecionado algo  
    (progn 
 ;convem ver onde será salva a dcl: 
      (setq dcl (load_dialog "ltscale.dcl"
             lst nil ;ltscale atuais, será preenchido abaixo  
            n   0
;salva as escala atuais, 
;caso pressione o cancel, elas serão restauradas  
      (repeat (sslength ss
        (
setq lst (cons (vla-get-LinetypeScale 
                          (vlax-ename->vla-object (ssname ss n))) 
                        lst
              n   (1+ n))) 
      (
setq lst (reverse lst)) 
;carrega o dialogo: 
      (new_dialog "ltscale" dcl
;inicializa as ações e valores das tiles: 
      (set_tile "ref" (rtos ref 2)) 
      (
action_tile "sld" "(actsld $value)"
      (
action_tile "ref" "(actref $value)"
;inicializa o valor do slider: 
      (actsld (set_tile "sld" "50")) 
; inicia o dialogo  
      (if (= (start_dialog) 0);cancel pressionado:  
;restaura as escala originais: 
        (repeat (sslength ss
          (
setq ent (ssname ss 0)) 
          (
vla-put-LinetypeScale 
            (vlax-ename->vla-object ent
            (
car lst)) 
          (
ssdel ent ss
          (
setq lst (cdr lst)))) 
;descarrega o dcl: 
       (unload_dialog dcl
      )))


e isto com o nome "ltscale.dcl":

ltscale dialog {label "ltscale"
:
edit_box{key="ref"label "ref";
:slider {key "sld" min_value"0" max_value=100small_increment=1;big_increment=10;
:text {key="prc";
ok_cancel
}

para usar, certifique-se de que a rotina e o dcl estão numa pasta da "support file search path" do autocad

7 comentários:

  1. Tá dando o erro:
    Command: ltsc
    ; error: no function definition: SS

    ResponderExcluir
  2. ok, já está arrumado

    sobrou um espaço no ssget

    ResponderExcluir
  3. Anônimo5/5/07 11:54

    Tá dando erro:
    Command: ltsc
    Select objects: 1 found
    Select objects:
    ; error: bad argument type: numberp: nil
    Command:


    coloquei no modo de animação e a rotina parou em "(rtos r ef 2)".
    o watch acusa nil para "r" e "ef"
    por sinal, não achei onde se definem estas variáveis.

    aqui é o lugar mais adequado pra falar contigo?
    a propósito, sabe de alguma coisa sobre o site autolisp?
    vlw!

    ResponderExcluir
  4. Anônimo5/5/07 22:35

    retire o espaço entre "r" e "ef", ficará assim:
    (rtos ref 2)

    por algum motivo ele foi parar ali... hehehe
    obrigado pelo interesse!!

    ResponderExcluir
  5. nada acontece.

    testei com line, polyline..
    o dcl aparece
    altero os valores mas a entidade fica igual.

    era pra mudar a escala?

    obs: só pra avisar mesmo... qnd copio o código pro vl, ele vem com espaços, quebrando as palavras... isso deve acontecer pra outras pessoas e pode ser objeto de erros.
    portanto, se vierem reclamar dos teus programas, como eu antes, vale a pena avisar se não é esse o problema.

    o blog tem sistema de busca interna?
    vlw!

    ResponderExcluir
  6. aff mais um erro, mas agora é garantido, hehehe

    para ver, faça uma linha com linetyne dashed e testa...

    ResponderExcluir
  7. hmmmm
    bem interessante!!

    Só agora me dei conta do que é o "lt" de "ltsc"...

    vlw!

    ResponderExcluir