Limpar Groups Vazios

Você usa o GROUP? se usa o Posicao (da manfra), com ceteza, mesmo que não saiba... bom acontece que ao apagar as entidades de um GROUP, este não é apagado, fica lá... se você usar o comando GROUP, verá que o GROUP continua lá, aé você pode "explodir" o group, pelo editor de groups do cad (que convenhamos, é muito tosco..), mas e se você tiver milhares deles? pior ainda, pois fica difícil achar um group qualquer... então fiz este programinha

mostra aí!!

;limpa grupos vazios
(defun c:limpagrupos(/ x n)
  (tbn:error-init (list (list "cmdecho" 0) t))
  (Setq n 0)
  (vlax-for x (vla-get-Groups thisdrawing)
    (if (= 0 (vla-get-count x)) (progn (setq n (1+ n)) (vla-delete x))))
  (prompt (strcat "\n" (itoa n) " grupo(s) vazio(s) apagado(s)"))  
  (tbn:error-restore))


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

Dimensions de cabeça pra baixo

Atendendo a pedidos, aí vai a rotina para desvirar dimensions que estejam de cabeça pra baixo
Não está totalmente testada, mas já está funcionando... pelo menos aqui... se o seu UCS estiver rotacionado e a rotina não estiver produzindo efeito, experimente digitar PLAN na linha de comando, escolher CURRENT, e usar a rotina novamente

mais...

(defun c:rotdim (/ ss ent xdir)
  (tbn:error-init  (list (list "cmdecho" 0) T))
  (setq ss   (ssget '((0 . "DIMENSION")))
        xdir (angle (trans '(0 0) 0 1) (trans '(1 0) 0 1)))
  (repeat (if ss (sslength ss) 0)
    (setq ent (ssname ss 0))
    (remake-ent ent 51 xdir)
    (ssdel ent ss))
  (tbn:error-restore t))

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

Desvirar textos de cabeça para baixo

Uma rotininha que já existe no civil 3d para as "labels" que eu imitei para funcionar com textos... É assim: você desenha os textos e tal, mas no layout, devido ao formato do desenho, rotaciona a viewport e os textos ficam de cabeça pra baixo (ou de ponta-cabeça, dependendo de onde tu mora, tchê!!!)... na mão ia demorar um bocado, mas assim é covardia:

Deixa eu ver!!!

(defun c:rottxt  (/ ss rot ent)
;controle de erros:
  (tbn:error-init (list (list "cmdecho" 0) t))
;seleciona textos:
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  (repeat (if ss (sslength ss) 0)
    (setq ent (ssname ss 0)
          rot (dxf 50 ent);rotação em radianos
          rot (if (= "MTEXT" (dxf 0 ent));rotação em UCS
                (angle (trans '(0 0) 1 0)
                       (trans (polar '(0 0) rot 1) 1 0))
                rot));text tem rotação em WCS
;| se a rotação encontrada é
   diferenta daquela que o texto tem:|;
    (if (/= rot (rot-of-ucs rot))
      (progn
;assim é mais facil obter o ponto do centro do texto:
        (setq box (textbox2 ent))
;rotaciona em 180º:
        (vla-rotate
          (vlax-ename->vla-object ent)
          (vlax-3d-point (media (car box) (caddr box)))
          pi)))
;contador na barra inferior:
    (grtext -2 (itoa (sslength ss)))
    (ssdel ent ss))
;restaura sem erros:
  (tbn:error-restore t))

Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, rot-of-ucs, textbox2, media, tbn:error-restore

Atenção, ela não muda a rotação para 0, mas sim vê se o texto ficou de cabeça pra baixo, se ficar, rotaciona em 180 graus!!

Rot-of-ucs

Esta rotina abaixo estou usando para rotacionar textos que estão de "cabeça para baixo", ela faz o seguinte: ao receber um determinado ângulo em radianos, testa se ele faria um TEXT ficar de cabeça para baixo... mesmo se você tiver um UCS diferente do WCS, se estiver, soma 180º a ele, vejam:

---

(defun rot-of-ucs (rot / rucs)
  (setq rucs (angle '(0 0) ;ucs
         (trans
           (polar (trans '(0 0) 1 0) rot 1) ;vetor wcs
           0 1 ;WCS -> UCS
           )))
  (if (and (>= rucs (/ pi 2)) (< rucs (* 3 (/ pi 2))))
    (+ rot pi)
    rot))

Civil 3d

Hoje, finalmente vou postar alguma coisa para o civil 3d!!! é o seguinte: quando vamos definir uma superfície, temos pontos, linhas, etc, certo? algumas dessas linhas são de certo modo "obrigatórias" pois ela definem algumas características da triangulação da mesma.... exemplo: linhas que representam estradas, taludes... quem usa o software "Posição" da Manfra sabe do que eu estou falando... no civil 3d também podemos ter tais linhas, mas elas precisam necessariamente estar em 3d...

mais...

Mas nem sempre estão... depois de descarregar os dados da estação total e inserirmos os pontos no civil 3d, vamos "ligando os pontos" (sim, tenho algo pra isso já...) para formar o desenho... por um mutivo qualquer, desenhamos tudo com PLINE, que não é 3d, mas sim 2d (mesmo que ela tem o elevation diferente de 0), o que impossibilita de usar como "breakline" da superfície, já que todos os vértices dela estão na mesma elevação... o que fazer? redesenhar elas com 3dpoly...

Obs: esta é a minha experiência com este programa, se alguem souber de uma forma melhor, estou interessadíssimo em saber!!!!

bom, o que o programinha abaixo faz isso, ele analiza as coordenadas X,Y da pline, procura pontos do CIVIL 3D que tenham as coordenadas X,Y requeridas e usa a coordenada Z deste ponto para construir a 3dpoly... possibilitando assim o uso destas como breakline, bom vamos lá, a primeira coisa é obter a "collection" dos pontos do civil:

---

(setq acadapp  (vlax-get-acad-object)
                 aec-app  (vla-GetInterfaceObject acadapp "AeccXUiLand.AeccApplication")
                 aec-adoc (vla-get-activedocument aec-app)
                 aec-db   (vla-get-database aec-adoc)
                 aec-pts  (vlax-get-property aec-db "points"))

---

Isso aí acima é coloco numa subrotina, que fará parte de um projeto de rotina VLX, ok? por isso não tem defun nem nada... outra hora eu explico isso...

agora vamos a rotina:

---

(defun c:2dto3d  (/ ss lst lsc ent pts flag a erro)
  (tbn:error-init (list (list "cmdecho" 0) t))
  (setq ss   (ssget '((0 . "LWPOLYLINE")))
        lst  nil
        lsc  nil
        flag (initget "S N" 0)
        flag (getkword
               "\nApagar as entidades convertidas? [Sim, Não] ")
        flag (= "S"
                (if flag
                  flag
                  "S")))
  (vlax-map-collection
    aec-pts ;********vide o código acima************
    '(lambda (x)
       (setq lst (cons (list (vlax-get-property x "Easting")
                             (vlax-get-property x "Northing"))
                       lst))))
  (vlax-map-collection
    aec-pts
    '(lambda (x)
       (setq lsc (cons (list (vlax-get-property x "Elevation")) lsc))))
  (repeat (if ss
            (sslength ss)
            0)
    (setq ent  (ssname ss 0)
          erro nil
          pts  (apply 'append
                      (mapcar
                        '(lambda (pt / tmp)
                           (foreach a  lst
                             (if (equal a pt 0.5)
                               (setq tmp a)))
                           (if tmp
                             (append pt (nth (vl-position tmp lst) lsc))
                             (setq erro (cons pt erro))))
                        (get-points-polig ent))))

    (if erro
      (progn
        (remake-ent ent 62 1)
        (foreach a  erro
          (entmake (list '(0 . "CIRCLE")
                         '(8 . "ERRO_3d_Poly")
                         (cons 10 a)
                         '(40 . 1)))))
      (progn
        (setq linha
               (vla-Add3Dpoly
                 (get-activespace)
                 (vlax-safearray-fill
                   (vlax-make-safearray
                     vlax-vbdouble
                     (cons 0 (1- (length pts))))
                   pts)))
        (vla-put-layer linha (dxf 8 ent))
        (vla-put-color linha 2)
        (if flag
          (entdel ent))))
    (grtext -2 (itoa (sslength ss)))
    (ssdel ent ss))
  (tbn:error-restore ))

---

é isso... o programa vai pedir se você desenha apagar as linhas antigas e tentará desenhar novas linhas 3d pelas coordenadas obtidas, se a linha for desenhada, ela aparecerá no mesmo layer que estava a linha original, mas estará em AMARELO, ja para as linhas que ela não conseguir desenhar, a linha original terá sua cor alterada para VERMELHO e ainda terá o(s) vértice(s) coordenadas não encontradas nos pontos do civil marcados com um CÍRCULO no layer "ERRO_3d_Poly" para que você possa analizar o que fazer (inserir um ponto, mudar o vértice...)

O jardineiro é Jesus e as arveres somos nozes...

Não podia deixar passar essa!!!! ilário!!!

Hoje mexendo com umas rotinas que eu tenho aqui, me apareceu uns elementos novos no DCL que não estavam na lista do LSP2HTML, que eu creio, ninguém deva ter usado ainda, são eles: dialog_line, dialog_foreground, graphics_background, graphics_foreground, black, white, red, yellow, green, cyan, blue, magenta

Se alguém souber de mais algum, por favor, entre em contato!!!

Hoje um amigo meu me pediu algo que transformasse MINSERT BLOCK em bloco normal, pois ele não conseguia explodir o MINSERT, bom, uns tempos atras tinha uma discussão no forum autolisp sobre proteção de arquivos dwg e uma das opções de proteção que deram lá essa de transformar o desenho em MINSERT... mas logo vimos que era uma proteção ruim, pois algumas poucas linhas de código bastavam para quebrar a proteção...

mais...

Entção, a rotina era esta abaixo:

---

(defun c:mins2ins (/ ent elist)
  (vl-load-com)
  (if (setq ent (car (entsel
      "\nSelecione o bloco a desbloquear...")))
     (progn
       (setq elist (entget ent))
       (foreach x '(44 45 70 71)
         (setq elist
             (vl-remove (assoc x elist) elist)))
       (entmake elist)
       (entdel ent)))
  (princ))

---

E estranho, volta e meia me aparecem desenhos com blocos MINSERT... até entendo sua utilidade, mas criar um MINSERT de apenas uma linha por uma coluna??? faça-me o favor, por que isso??

Posição, Sftopo, pontos e polilinhas

Sabe aquelas polilinhas que você desenha conectando pontos de levantamento topográfico? então... já reparou que se você receber mais dados de campo e racalcular as poligonais de fechamento e reinserir todos os pontos no desenho, apagando os anteriores, as vezes dependendo da nova distribuição do erro, os pontos "saem" um pouquinho do lugar? não chega a ser um problema se a distância do ponto até o vértice da polilinha for pequeno, mas pode parecer meio "chutado" o desenho, não é? pelo menos eu acho... isso ocorre se você está usando um tal de SFTOPO para calcular os pontos... mas creio que no Posição ou no Topograph isso também ocorra... para amenizar um pouco isso, fiz esta rotina:

ver...

(defun c:arrumapline  (/ ss f ent q vla d)
  (tbn:error-init (list (list "cmdecho" 0) t))
  (setq ss (ssget '((0 . "LINE,*POLYLINE")))
        d  (getdist "\nEntre com a distancia <0.1>")
        d  (if d
             d
             0.1)
        f  (lambda (pt / lpt s2)
             (setq lpt (get-lpt 20 d (trans pt 0 1)))
             (command "zoom" "c" (trans pt 0 1) "")
             (if (setq s2 (ssget "CP" lpt '((0 . "POINT"))))
               (cadar (vl-sort
                        (mapcar
                          '(lambda (x)
                             (list (distance pt (dxf 10 x)) (dxf 10 x)))
                          (dxf -1 s2))
                        '(lambda (e1 e2)
                           (< (car e1) (car e2))))))))
  (repeat (if ss (sslength ss) 0)
    (setq ent (ssname ss 0))
    (if (= "LINE" (dxf 0 ent))
      (progn
        (if (setq pt (f (dxf 10 ent)))
          (remake-ent ent 10 pt))
        (if (setq pt (f (dxf 11 ent)))
          (remake-ent ent 11 pt)))
      (progn
        (setq n   1
              vla (vlax-ename->vla-object ent)
              q  (= (dxf 0 ent) "LWPOLYLINE"))
        (repeat (1- (length (get-points-polig ent)))
          (if (setq pt (f (3d-of-vla (vla-get-coordinate vla n))))
            (vla-put-coordinate
              vla
              n
              (if (= (dxf 0 ent) "LWPOLYLINE")
                (vlax-2d-point pt)
                (vlax-3d-point pt))))
          (setq n (1+ n)))
        (vlax-release-object vla)))
    (ssdel ent ss))
  (tbn:error-restore ))

Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, get-lpt, dxf, remake-ent, get-points-polig, 3d-of-vla, vlax-2d-point, tbn:error-restore

Ela faz o seguinte: pede a seleção de linhas que ela irá dar "grip_stretchs" nos vértices até o ponto (entidades POINT) mais próximo, levando em conta que o ponto deve estar a uma distância máxima aceitável...

ToString

Uma função complementar a "vl-princ-to-string", "itoa", "rtos":

---

(defun tostring  (v / tp spc tmp)
  (SETQ tp (type v))
  (cond ((= tp 'STR) (strcat "\"" v "\""))
        ((= tp 'REAL) (rtos v 2 16))
        ((= tp 'INT) (itoa v))
        ((null v) "nil")
        ((listp v)
         (setq spc "")
         (setq tmp "")
         (foreach x  v
           (setq tmp
              (strcat tmp
                      spc
                      (if (listp x)
                        (if (listp (cdr x))
                          (tostring x)
                          (strcat "("
                                  (tostring (car x))
                                  " . "
                                  (tostring (cdr x))
                                  ")"))
                        (strcat (tostring x))))
                 spc " "))
         (strcat "(" tmp ")"))
        (t (vl-princ-to-string v))))

---

Uso: (tostring qualquer_coisa)
isso irá transformar qualquer coisa que seja passado a ela em string, num formato que possa ser usado pela função "write-line", preservando a forma como aparece a no vlide
pode ser qualquer coisa, lista, numero, texto...

Taludes

pega aqui!!

 (defun c:dtal  (/ cr pe d ds pts compt dist getent lay tmp)
  (tbn:error-init (list
;lista de variaveis a serem configuradas:
                    (list "cmdecho" 0)
;função a executar em caso de erro:
                    '(high-ligth (list cr pe) nil)))
;função que pede a seleção de uma linha:
;ela aceita "não selecionar" para terminar a rotina
  (setq getent
         (lambda (s)
           (while
             (progn
               (prompt
                 (strcat
                   "\nValem: LINE, SPLINE, LWPOLILINE\nSelecione "
                   s " do talude"))
               (if (setq tmp
                     (ssget ":S"
                       '((0 . "LINE,LWPOLYLINE,SPLINE"))))
                 (not (setq tmp (ssname tmp 0)))
                 (/= 52 (getvar "errno")))))
           (if tmp (high-ligth tmp t)) tmp)
;seleciona a crista:
        cr     (getent "a crista")
;selecionou a crista?, então seleciona o "pé"
        pe     (if cr
                 (getent "o pé")
                 (exit))
;numero de divisoes a fazer:
        ds     (* 2 (fix (get-length-of cr)))
;recupera o valor padrao do layer:
        lay    (getcfg "Appdata/desenha_talude/layer")
;valida o nome do layer:
        lay    (if (validate-layname lay) lay "talude")
;prompt interativo de configuração dos parametros:
;sim, eu podia usar um dcl, mas as vezes mais atrapalha q ajuda
        tmp    (while
                 (progn
                   (initget "L" 0)
                   (setq d
                     (getint
                       (strcat
                         "\n\nLayer: " lay
                         "\nQuantas divisões fazer? [Layer] <"
                         (itoa ds) ">")))
                   (if (= "L" d)
                     (if (/= ""
                        (setq tmp
                          (getstring
                            (strcat "\nQual o nome do layer? <"
                                    lay ">"))))
                       (not (if (validate-layname tmp)
                              (setq lay tmp)
                              (prompt "\nNome inválido")))))
                   (= 'str (type d))))
        d      (if d d ds);numero de divisoes efetivas a fazer
        dist   (/ (get-length-of cr) d);distancia entre divisoes
        tmp    0 ;contador
        tmp    (repeat d ;lista dos pontos onde terá linha
                 (setq pts
                   (append pts
                      (list (vlax-curve-getPointAtDist cr tmp)))
                       tmp (+ tmp dist)))
        pts    (append pts (list (vlax-curve-getendpoint cr)))
        d      nil ;alterna entre nil e T
;calcula e desenha as linhas:
        d      (mapcar
                '(lambda (p1 / p2)
                  (if
                   (setq p2
                     (vlax-curve-getclosestpointtoprojection
                       pe p1 '(0 0 1) nil))
                   (vlax-ename->vla-object
                     (entmakex (list '(0 . "LINE")
                     (cons 10 p1)
                     (cons 11
                       (if (setq d (not d))
                         p2
                         (media p1 p2)))
                     (cons 8 lay))))))
                 pts))
;grava o layer usado... dificilmente mudará, então use
;como padrão
  (setcfg "Appdata/desenha_talude/layer" lay)
;cria um GROUP com as linhas:
  (vla-AppendItems
    (vla-add (vla-get-Groups
;|thisdrawing:|;(vla-get-activedocument(vlax-get-acad-object)))
;|nome do GROUP|;  (dxf 5 (car d)))
;cria a SAFEARRAY de entidades:
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbObject
        (cons 0 (1- (length d))))
      d))
;se chegou ate aqui, nao deu erro, entao remove o
;destaque das linhas de pé e de crista:
  (high-ligth (list cr pe) nil)
;sai sem erro:
  (tbn:error-restore ))

Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, high-ligth, get-length-of, validate-layname, media, dxf, tbn:error-restore

---

Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, high-ligth, get-length-of, validate-layname, media, dxf, tbn:error-restore

Se você tem a sua e quiser compartilhar comigo, poste ela nos comentários, assim todos poderão ter uma "segunda opinião", hehehe!!!!

Pranchas

Como você faz para inserir um formato no desenho? você tem os blocos de A0 ao A4 já desenhados, certo? e insere eles normalmente como blocos... ok, eu também... mas e quando você precisa dum formato de dimensões fora do padrão? as veze acontece, não é? e aí? explode um formato parecido, etc...

mais...

(defun c:prancha  (/    dx   dy   pt   dt   conv ndh  sobr nde  ndd
                   dxd  n    ndv  flag l1   l2   x    y    d    qtd
                   dq   lays this)
  (tbn:error-init (list (list "cmdecho" 0) t))
  (setq pt (getpoint "\nPonto de inserção ?")
        dx (initget "A0 A1 A2 A3 A4" 0)
        dx (getcorner pt
"\nClique o Canto superior Direito ou [A0, A1, A2, A3, A4] ")
        dx (if dx dx "A1")
        dt 1.5
        dq 50.0)
;escolhe as medidas da prancha:
  (if (= (type dx) 'str)
    (mapcar
      'set
      '(dx dy)
      (nth (vl-position dx '("A0" "A1" "A2" "A3" "A4"))
           '((1188 840) (840 594) (594 420) (420 297) (210 297))))
    (mapcar '(lambda (k a b) (set k (fix (abs (- a b)))))
            '(dx dy)
            dx  pt))
;calcula o nome da prancha:
  (setq str (strcat "F" (itoa dx) "x" (itoa dy)))
;se o bloco ainda nao existe:
  (if (not (tblsearch "block" str))
;cria:
    (progn
;1º cria os layers e os estilos caso nao existam
      (setq lays (vla-get-layers thisdrawing))
      (if (not (tblsearch "layer" "MG-EXTERNA"))
        (vla-put-color (vla-add lays "MG-EXTERNA") 4))
      (if (not (tblsearch "layer" "MG-INTERNA"))
        (vla-put-color (vla-add lays "MG-INTERNA") 9))
      (if (not (tblsearch "LTYPE" "HIDDEN2"))
        (vla-load (vla-get-linetypes thisdrawing) "HIDDEN2" "acad"))
      (if (not (tblsearch "layer" "MG-TRACEJADO"))
        (vla-put-linetype (vla-add lays "MG-TRACEJADO") "HIDDEN2"))
;inicia a construção do bloco:
      (entmake (list '(0 . "BLOCK") (cons 2 str) '(8 . "0")
                     '(10 0.0 0.0 0.0) '(70 . 2)))
;desenha o nome do bloco na margem esquerda:
      (draw-text str (list dt (* dt 3))
        "MG-EXTERNA" (/ pi 2) 2 "ISOCP" "tl")
;desenha a margem externa, linha fina
      (draw-pline2
        (list '(0 0) (list dx 0) (list dx dy) (list 0 dy))
        "MG-EXTERNA" t)
;desenha a margem interna com offsets 25 a esquerda e 10 no resto:
      (draw-pline2 (list '(25 10) (list (- dx 10) 10)
                         (list (- dx 10) (- dy 10))
                         (list 25 (- dy 10)))
        "MG-INTERNA" t)
;desenha a linha de corte, offset da margem externa:
      (draw-pline2 (list (list (- dt) (- dt))
                         (list (+ dt dx) (- dt))
                         (list (+ dt dx) (+ dt dy))
                         (list (- dt) (+ dy dt)))
        "MG-TRACEJADO" t)
; a pedidos, desenha uma numeração nas margens:
; se vc quiser desabilitar isso, elimine <----------------daqui
      (setq qtd (fix (/ (- dx 35) dq))
            d   (/ (- dx 35.0) qtd)
            n   0)
      (repeat qtd
        (setq x (+ 25 (* (+ n 0.5) d))
              n (1+ n))
;textos da margem superior:
        (draw-text (itoa n) (list x 7.5) "MG-EXTERNA"
          0 4 "ISOCP" "mc")
;textos da margem inferior:
        (draw-text (itoa n) (list x (- dy 7.5))
          "MG-EXTERNA" 0 4 "ISOCP" "mc")
;linhas das margens direita e esquerda:
        (setq x (+ 25 (* n d)))
        (if (/= n qtd)
          (progn
            (draw-line (list x 10) (list x (+ 5 dt)) "MG-EXTERNA")
            (draw-line (list x (- dy 10))
                       (list x (- dy 5))
                       "MG-EXTERNA"))))
;agora textos e linhas nas margens superior e inferior:
      (setq qtd (fix (/ (- dy 20.0) dq))
            d   (/ (- dy 20.0) qtd)
            n   0)
      (repeat qtd
        (setq y   (+ 10 (* (- qtd 0.5) d))
              qtd (1- qtd)
              n   (1+ n))
;textos na margem inferior:
        (draw-text (i2b26 n) (list 22.5 y)
          "MG-EXTERNA" 0 4 "ISOCP" "mc")
;textos na margem superior:
        (draw-text (i2b26 n) (list (- dx 7.5) y)
          "MG-EXTERNA" 0 4  "ISOCP" "mc")
;linhas:
        (setq y (+ 10 (* qtd d)))
        (if (/= 0 qtd)
          (progn
            (draw-line (list 20 y) (list 25 y) "MG-EXTERNA")
            (draw-line (list (- dx 10) y)
                       (list (- dx 5) y)
                       "MG-EXTERNA"))))
; se vc quiser desabilitar isso, elimine <---------------ate aqui

;agora as marcas de dobra... sim tem isso tambem!!!
;o processo de cálculo das marcas de dobra é beta.... blz?
;não vou me ater muito nele....
      (setq ndh  (fix (/ (- dx 25) 185)) ;nº de divisoes inteiras
            sobr (rem (- dx 25) 185)     ;sobra medida?
            nde  (if (zerop (rem ndh 2.0)) ;se for par
                   (if (> sobr 1)       ;sobra medida?
                     (if (> sobr 92.5)  ;sobra > 185/2?
                       ndh              ;a sobra é a divisao impar
                       (1- ndh))        ;divide
                     (if   ;nao sobra? uma vai para a direita
                       (= 2 ndh)        ;so deu 2?
                        1               ;1 a esquerda 2 a direita
                        (- ndh 2)))
                   (if                  ;impar?
                     (> sobr 1)         ;tem sobra?
                      (- ndh 2)         ;separa pra lado direito
                      ndh))
            sobr (- dx 25 (* 185 nde))
            ndd  (- ndh nde)
            ndd  (if (= (zerop (rem ndd 2)) (zerop (rem nde 2)))
                   ndd
                   (1+ ndd))
            dxd  (if ndd
                   (/ (- dx (* nde 185) 25) (1+ ndd)))
            n    1
            flag (not (equal 0.0 dxd 0.001)))
;as divisoes que começam pela esquerda da prancha:
      (if (> nde 0)
        (repeat (if flag
                  nde
                  (1- nde))
          (setq x (- dx (* n 185))
                n (1+ n))
          (draw-line (list x 0) (list x 5) "MG-TRACEJADO")
          (draw-line (list x dy) (list x (- dy 5)) "MG-TRACEJADO")))
;divisoes que começam pelo lado direito da prancha
      (setq n 1)
      (if flag
        (repeat ndd
          (setq x (+ 25 (* n dxd))
                n (1+ n))
          (draw-line (list x 0) (list x 5) "MG-TRACEJADO")
          (draw-line (list x dy) (list x (- dy 5)) "MG-TRACEJADO")))
      
;divisoes de dobras verticais, multiplos do A4(h=297)
      (setq y 297)
      (while (< y dy)
        (draw-line (list 0 y) (list 25 y) "MG-TRACEJADO")
        (draw-line (list (- dx 10) y) (list dx y) "MG-TRACEJADO")
        (setq y (+ y 297)))
;e fim:
      (entmake '((0 . "ENDBLK")))))
; AGORA insere a prancha como bloco:
  (draw-insert str (trans pt 1 0) "MG-INTERNA"
    (angle (trans '(0 0) 1 0) (trans '(1 0) 1 0)) 1  nil)
  (tbn:error-restore ))

---

Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, draw-text, draw-pline2, draw-line, i2b26, draw-insert, tbn:error-restore