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
