Lisp para preencher estaqueamento no carimbo

Sabe quando você tem as sectionviews em trocentas folhas no model space? Aí vem aquele camarada e diz: Cada folha precisa ter quais estacas estão na folha!!!! E você se vê digitando manualmente cada um dos carimbos, e você tem lá seus 150 carimbos. É, demora pra caramba!! Então que tal fazer com uma lispezinha básica, veja:

;|
CarimboSv, programa para preencher o estaquemamento nos carimbos
autor: Neyton Luiz Dalle Molle
Engenheiro Civil
contato: neyton@yahoo.com
https://tbn2net.com
https://tbn2.blogspot.com
;licença de uso: free
;garantias: nenhuma!!! use por sua propria conta e risco!!!
|;


;variaveis globais para "lembrar" algumas opções
(setq
;nome do bloco a ser filtrado
      CarimboSv:nomeBloco  "A1"
;nome do atributo a modificar
      CarimboSv:nomeAtt    "SUBTÍTULO_2_DO_DESENHO"
;template do texto a aplicar no atributo
      CarimboSv:template   "KM {INICIO} À KM {FIM}")

(
defun c:CarimboSv (/ tmp ss ent vla att alin txt pai s2 getStation)
  ;inicializar o controle de erros
  (tbn:error-init nil)

  ;perguntar na linha de comando pelos valores
  (setq tmp                 (getstring
                  (strcat "\nQual o nome do bloco da folha? <"
                      CarimboSv:nomeBloco
                      ">")
                  t)

    CarimboSv:nomeBloco (strcase
                  (if (= "" tmp)
                CarimboSv:nomeBloco tmp))

    tmp                (getstring
                 (strcat "\nQual o nome do atributo? <"
                     CarimboSv:nomeAtt
                     ">")
                 t)
    

    CarimboSv:nomeAtt  (strcase
                 (if (= "" tmp)
                   CarimboSv:nomeAtt tmp))
;subrotina para obter o "dono" ou "pai" de um objeto
    pai                (lambda (v)
                 (
vlax-get-property v "parent"))
    

;subrotina para criar a estaca como string
    getStation         (lambda (estaca componente template)
                 (
vl-string-subst
                   (vlax-invoke-method
                 alin
                 "GetStationStringWithEquations"
                 estaca)
                   componente
                   template
)))

;pede a seleção dos blocos
;nao filtrar aqui. blocos dinamicos tendem a mudar de nome para
;*Uxxx
  (prompt "\nSelecione os blocos")
  (
setq    ss (ssget   '(( 0 . "insert"))))

; repita para todos os blocos
  (repeat (sslength ss)

;pega o primeiro da lista
    (setq ent (ssname ss 0)
      vla (vlax-ename->vla-object ent))

;se tem o nome correto (blocos dinamicos mudam para *U...
    (if (= CarimboSv:nomeBloco (STRCASE (vla-get-effectivename vla)))
      (
progn

;faz zoom no bloco
    (vla-getboundingbox vla 'minp 'maxp)
    (
vla-zoomwindow (vlax-get-acad-object) minp maxp)

;seleciona as sectionviews dentro da folha
    (setq s2 (ssget "C" (vlax-safearray->list minp)
            (
vlax-safearray->list maxp)
            ' ((0 . "AECC_GRAPH_SECTION_VIEW")))
          alin     (pai (pai (pai (vlax-ename->vla-object
                    (ssname s2 0)))))
          primeiro 1e10
          ultimo   -1e10)
    

;calcula a primeira e a ultima seção
    (repeat (sslength s2)
      (
setq e   (ssname s2 0)
        tmp (vlax-get-property
              (pai (vlax-ename->vla-object e)) "station"))
      (
if (< tmp primeiro) (setq primeiro tmp))
      (
if (> tmp ultimo) (setq ultimo tmp))
      (
ssdel e s2))

;formata a string com o template
    (setq txt (getStation primeiro "{INICIO}" CarimboSv:template)
          txt (getStation ultimo  "{FIM}" txt))

;atribui o novo texto a todos os
;atributos com o nome selecionado
    (foreach att (vlax-safearray->list
            (vlax-variant-value
              (vla-GetAttributes vla)))
      (
if (= CarimboSv:nomeAtt
         (strcase (vla-get-tagstring att)))
        (
vla-put-textstring att txt)))))

;retira o primeiro bloco da lista e recomeça
;o looping
    (ssdel ent ss))

;devolve o controle de erros ao autocad
  (tbn:error-restore))

(
prompt
"
Preenche estacas no carimbo carregado!!
suporte: neyton@yahoo.com
visite: https://tbn2net.com
e também: https://tbn2.blogspot.com
Digite: CarimboSv para usar
"
)
(
princ)



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

É isso. Você será questionado pelo nome do bloco, o nome do atributo e o template a usar. Depois será pedida a seleção dos blocos. Note que se você mudar os valores padrão que a lisp usa para os nomes e template, o programa "lembra" na próxima utilização. Se você sempre usa outros nomes, edite o início da lisp, se souber o que está fazendo Sim, você precisará copiar o código do controle de erro aqui. Sim é preciso colocar o (vl-load-com) no início.

Dia do engenheiro


Meus parabéns a todos os profissionais dessa maravilhosa profissão!!!


Hoje é dia do Engenheiro, do Arquiteto e do Agrimensor!!!



Como não podia deixar de ser, fica como presente aquele desconto!!!


Ao adquirir uma licença de qualquer programa, ganha 25% de desconto até o dia 25/12/2013!!!


Mas espere!!! Não ligue ainda!!!!


Se falar que é engenheiro, arquiteto ou agrimensor, basta informar seu registro do CREA para DOBRAR o desconto!!! Isso mesmo!!!


DESCONTO DOBRADO!!!!!


Participe do grupo sobre Civil 3D no facebook

Visite a minha página de programas


Visite o blog do neyton