Loteamento Explodido? Lamentável, mas tem jeito!!!

Hoje recebi um pedido de um cliente para testar o CADMEMO no projeto dele. Só que o desenho era CAD puro e os lotes não eram polilinhas fechadas, nem ao menos os nomes dos lotes eram blocos. Condições estas para o CADMEMO funcionar.

Bem, isso é problema? Sim, de certa forma. Se fosse converter tudo em PARCEL no Civil 3D, ainda teria de renomear os parcels gerados....

A maneira mais rápida que consegui pensar pra isso é escrever um pequeno lisp para interpretar o projeto e criar as polilinhas e os blocos.

O código fonte segue abaixo. Veja que usei o comando BPOLY para obter uma polilinha fechada e inseri o bloco necessário no centroide da polilinha.

Para obter este centroide, usei uma REGION temporária.

Para rodar é bem simples, tenha os blocos:
LOTE - bloco que informará o nome do lote, tem os atributos NOME, AREA, DESC
QUADRA - bloco que informará o nome da quadra, tem o atributo NOME

Agora, carregue com o APPLOAD.

Ao chamar o comando na linha de comando, serão pedidas as informações de nome do layer, bloco etc, caso você queira reconfigurar os parâmetros do lisp.

Bom, sem mais delongas, segue o código:

---

;lembrar valores padrão:
(setq txtl2pl:blocolote "LOTE"
      txtl2pl:layernomelote "DIM"
      txtl2pl:layerlote     "LOTE"
      txtl2pl:escala        0.3
      txtl2pl:areatpl       "A={}m²"
      txtl2pl:raioerro      3
      txtl2pl:layererro    "_erro"
      txtl2pl:filtro       "L.*"
      txtl2pl:attnome      "NOME"
      txtl2pl:attarea      "AREA"
      txtl2pl:attdesc      "DESC"
      txtl2pl:desc         "c3dmemo")

;programa que desenha polilinha e bloco com atributos
(defun c:txtl2pl (/ ss ent pl bloco vla thisdrawing rg
          objArray rg Centroid att tag model tmp)
  ;controle de erros:
  (tbn:error-init nil)
  
  ;inicia ponteiros para o desenho atual e model space
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))
    model       (vla-get-modelspace thisdrawing))

  ;reconfigura os valores padrão:
  (setq tmp  (car (entsel (strcat
     "\nClique um texto para obter o layer do nome do"
     " lote ou clique enter para aceitar <"
     txtl2pl:layernomelote ">"))))

  (if tmp (setq txtl2pl:layernomelote (cdr (assoc 8 (entget tmp)))))

  (setq tmp (getstring (strcat
     "\nInforme o nome do bloco"
     " a inserir ou clique enter para aceitar <"
     txtl2pl:blocolote ">")))

  (if (/= "" tmp) (setq txtl2pl:blocolote tmp))

  (setq tmp (getstring  (strcat  "\nInforme o atributo do"
    " nome do lote, ou enter para aceitar <" txtl2pl:attnome ">")))

  (if (/= "" tmp) (setq txtl2pl:attnome tmp))

  (setq tmp (getstring (strcat  "\nInforme o atributo da"
    " area do lote, ou enter para aceitar <" txtl2pl:attarea ">")))

  (if (/= "" tmp) (setq txtl2pl:attarea tmp))

  (setq tmp (getstring (strcat "\nInforme o atributo da descrição"
    " do lote, ou enter para aceitar <" txtl2pl:attdesc ">")))

  (if (/= "" tmp) (setq txtl2pl:attdesc tmp))

  (setq tmp (getstring (strcat "\nInforme uma descrição a aplicar,"
    " ou enter para aceitar <" txtl2pl:desc ">")))

  (if (/= "" tmp) (setq txtl2pl:desc tmp))

  (setq tmp (getstring (strcat "\nInforme o layer da polilinha de"
    " lote, ou enter para aceitar <" txtl2pl:layerlote ">")))

  (if (/= "" tmp) (setq txtl2pl:layerlote tmp))

  (setq tmp (getstring (strcat "\nInforme o filtro de texto do"
   " nome do lote, ou enter para aceitar <" txtl2pl:filtro ">")))

  (if (/= "" tmp) (setq txtl2pl:filtro tmp))

 
  ;inicia a seleção dos textos a processar:
  (prompt (strcat
    "\nSelecione os textos do layer <" txtl2pl:layernomelote ">"))
  (setq ss  (ssget (list '(0 . "TEXT")
             (cons 8 txtl2pl:layernomelote)
             (cons 1 txtl2pl:filtro))))

  ;garante que exista o layer da polilinha e dos
  ;círculos de erro se ocorrerem:
  (vla-add (vla-get-layers thisdrawing) txtl2pl:layerlote)
  (vla-add (vla-get-layers thisdrawing) txtl2pl:layererro)

  ;repita em todos os textos:
  (repeat (sslength ss)

    ;pega o promeiro da lista
    (setq ent (ssname ss 0)
      pt  (cdr (assoc 10 (entget ent)))
      vla (vlax-ename->vla-object ent))

    ;remove ele da lista
    (ssdel ent ss)

    ;zoom no texto, para o bpoly funcionar corretamente
    (vla-zoomcenter (vlax-get-acad-object)
      (vlax-3d-point pt) (getvar "viewsize"))

    ;tenta o bpoly
    (if (vl-catch-all-error-p
     (setq pl (vl-catch-all-apply 'bpoly (list pt))))
      ;se falhar, marca com um círculo
      (vla-put-layer (vla-addCircle model (vlax-3d-point pt)
               txtl2pl:raioerro) txtl2pl:layererro)

      ;se funcionar, insere o bloco do nome
      ;do lote no centroide da polilinha
      (progn
    ;obtem a polilinha
    (setq pl       (vlax-ename->vla-object pl)
          objArray (vlax-make-safearray vlax-vbObject '(0 . 0)))

    ;seta o seu layer
    (vla-put-layer pl txtl2pl:layerlote)

    ;cria uma region temporaria na polilinha,
    ;para obter o centroide
    (vlax-safearray-fill objArray (list pl))
 
        (setq rg       (car (vlax-safearray->list
                  (vlax-variant-value
                (vla-addregion model objArray))))
          Centroid (vlax-safearray->list
             (vlax-variant-value (vla-get-Centroid rg)))
          Centroid (list (car Centroid) (cadr Centroid) 0.0)

          ;insere o bloco
          bloco    (vla-insertblock (vla-get-modelspace thisdrawing)
             (vlax-3d-point Centroid)
             txtl2pl:blocolote txtl2pl:escala
             txtl2pl:escala
             txtl2pl:escala (vla-get-rotation vla)))

    (vla-put-layer bloco txtl2pl:layerlote)

    ;apaga a region
    (vla-delete rg)

    ;preenche os atributos do bloco
    (foreach att (vlax-safearray->list
               (vlax-variant-value
             (vla-GetAttributes bloco)))
      (setq tag (vla-get-tagstring att))
      (cond ((eq (strcase tag) (strcase txtl2pl:attnome))
         (vla-put-textstring att (vla-get-textstring vla)))
        ((eq (strcase tag) (strcase txtl2pl:attdesc))
         (vla-put-textstring att txtl2pl:desc))
        ((eq (strcase tag) (strcase txtl2pl:attarea))
         (vla-put-textstring att
           (vl-string-subst
             (rtos (vla-get-area pl) 2 2)
             "{}" txtl2pl:areatpl )))))))
    )

  (tbn:error-restore)
  )


(defun tbn:error-init (sys / tmp ss cmd)
  (setq tbn:olderr     *error*
    *error*        (lambda (s)      
             (if (/= s "Function cancelled")
               (prompt "\nBomb!! Error: "))
             (eval tbn:error_exe)
             (tbn:error-restore))
    tbn:error_exe  (cadr sys)
        sys            (car sys)
    tbn:sysvars    nil 
        ss             (ssgetfirst))

  (vla-StartUndoMark
    (vla-get-ActiveDocument (vlax-get-acad-object)))


  (repeat (/ (length sys) 2)
    (setq tmp         (car sys)
          tbn:sysvars (cons (list tmp (getvar tmp))
                tbn:sysvars)
          tmp         (setvar tmp (cadr sys))
          sys         (cddr sys)))
  (sssetfirst (car ss) (cadr ss)))


(defun tbn:error-restore (/ cmd x)
  (foreach x tbn:sysvars (setvar (car x) (cadr x)))
  (redraw)
  (setq *error* tbn:olderr)
  (vla-EndUndoMark
    (vla-get-ActiveDocument (vlax-get-acad-object)))
  (princ))

---

Veja o dwg de exemplo