Atributos Multilinhas - Mudando sua largura

Um lispezinho básico pra variar!!!

Use este programa para redimensionar a largura de atributos multi linhas de blocos. O que, não sabia que atributos podem ser multi linha, como MTEXT? Cara, tu tem que usar, é muito bom!!!, resolve uma penca de problemas... esse negócio de ficar criando trocentos atributos para criar várias linhas no bloco, principalmente nos carimbos é tão R14.... hehehehe

Bom, vamos lá então:

---

;|MtAttLarg
Programa para definir a largura de
atributos multilinha em blocos
Autor: Neyton Luiz Dalle Molle
email: neyton@yahoo.com
Permissão de uso: Livre,
desde que mantido os créditos
|;

;carrega as funções vla*
(vl-load-com)

;variavel global para lembrar a largura
(setq MtAttLarg:largura 35)

;variavel blobal para remoção de quebras
(setq MtAttLarg:RemoveQuebra "Sim")

;programa principal
(defun c:MtAttLarg (/ ss ent vla largura att RemoveQuebra)
;inicia o controle de erros
  (tbn:error-init nil)

;pede a seleção dos blocos
  (prompt "\nSelecione os blocos")
  (setq ss (ssget   '((0 . "insert"))))
  (if (not ss) (exit))

;pede a largura do mtext
  (setq largura (getdist
          (strcat "\nQual a largura desejada? "
              "<" (rtos MtAttLarg:largura) ">"))
    largura (if largura largura MtAttLarg:largura)
    MtAttLarg:largura largura)

;pergunta se quer remover quebras
  (initget "Sim Não" 0)
  (setq RemoveQuebra (getkword (strcat
        "\nRemover quebras de linha? [Sim, Não] "
        "<" MtAttLarg:RemoveQuebra ">"))
    RemoveQuebra (if RemoveQuebra
            RemoveQuebra
            MtAttLarg:RemoveQuebra)
    MtAttLarg:RemoveQuebra RemoveQuebra)

;processa cada bloco
  (repeat (sslength ss)
    (setq ent (ssname ss 0)
      vla (vlax-ename->vla-object ent))

;caso o bloco tenha atributos,
;processa os atributos faça
    (if (= :vlax-true (vla-get-HasAttributes vla))
      (foreach att  (vlax-safearray->list
              (vlax-variant-value
            (vla-getattributes vla)))
    
;se o atributo é multilinhas, redefina a largura:
    (if (= :vlax-true (vla-get-mtextattribute att))
      (vla-put-mtextboundarywidth att largura))

;remova quebras de linha
    (if (= RemoveQuebra "Sim")
      (while (vl-string-search "\\P"
           (vla-get-textstring att))
        (vla-put-textstring
          att
          (vl-string-subst " " "\\P"
        (vla-get-textstring att)))))
    )
      )

;remove o primeiro elemento da seleção
;e vai pro próximo
    (ssdel ent ss)
    )
;restaura o controle de erros
  (tbn:error-restore)
)


Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, tbn:error-restore

---

Para funcionar, você precisa salvar o código acima e também aquele indicado no link acima num mesmo arquivo *.lsp e pronto!!!

Você poderá usar o programa acima para ajeitar a largura dos blocos criados pelo CSONDAGEM, por exemplo. Ainda não testou este programa? Baixa ele já e testa!! Ele serve para criar blocos nos profileviews, indicando as sondagens feitas, veja uma imagem:

É isso, qualquer coisa, entre em contato!!