Lisp para quatitativo
Created according to your sample not using lee mac script.
Code asks you to select object on the layer where rooms borders (walls) are created and extracts its layer name.
It collects all closed polyline inside that layer and for each polyline in selection extracts its area perimeter(length) and coordinates. Inside polygon defined by this coordinates it search for a text (mtext) object inside same layer as selected polyline. Than it creates table from point you pick. Scale table according to your needs, I didn't put table styling inside code.
(defun c:LuciLopes ( / *error* take pointlist2d JH:list-to-table lay room_list room_name rooms_ss i spaceobject eo area len pts sst)
(defun *error* (msg)
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
(princ (strcat "\nOops an Error : ( " msg " ) occurred."))
)
(princ)
)
(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
(defun pointlist2d (lst / ret) (while lst (setq ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
;; JH:list-to-table --> Jonathan Handojo
;; Creates a table from a list of lists of strings
;; space - ModelSpace or Paperspace vla object
;; lst - list of lists where each list is a list of strings
;; => if you wish to insert a block in the cell, prefix using "<block>" followed by the block name
;; => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1"
;; pt - Insertion point of table (2 or 3 reals)
;; tblstyle - Table style to use
(defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable)
(setq ncols (apply 'max (mapcar 'length lst))
vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10)
)
(vla-put-RegenerateTableSuppressed vtable :vlax-true)
(vla-put-StyleName vtable tblstyle)
(repeat (setq i (length lst))
(setq rows (nth (setq i (1- i)) lst))
(vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0)))
(repeat (setq j (length rows))
(setq lens
(cons
(+
(abs
(apply '-
(mapcar 'car
(textbox
(list
(cons 1 (setq txt (nth (setq j (1- j)) rows)))
(cons 40 (vlax-invoke vtable 'GetCellTextHeight i j))
(cons 7 (vlax-invoke vtable 'GetCellTextStyle i j))
)
)
)
)
)
(vlax-invoke vtable 'GetCellTextHeight i j)
)
lens
)
)
(if (eq (strcase (substr txt 1 7)) "<BLOCK>")
(progn
(setq blk (substr txt 8))
(if (and
(wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
(vlax-method-applicable-p vtable 'setblocktablerecordid32)
)
(vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)))
(vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true)
)
)
(vla-SetText vtable i j txt)
)
)
(setq totlen (cons lens totlen) lens nil)
)
(repeat ncols
(vla-SetColumnWidth vtable (setq ncols (1- ncols))
(apply 'max
(vl-remove nil
(mapcar
'(lambda (x)
(nth ncols x)
)
totlen
)
)
)
)
)
(vla-put-RegenerateTableSuppressed vtable :vlax-false)
vtable
)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq spaceobject(if (eq (getvar 'cvport) 1)(vla-get-paperspace doc)(vla-get-modelspace doc)))
(setq lay (cdr(assoc 8 (entget(car(entsel "\nSelect closed lwpolyline on layer whos entity areas needs to be extracted >"))))))
(setq rooms_ss (ssget "_X" (list (cons 0 "lwpolyline")(cons 8 lay) (cons 70 1))))
(cond
((and rooms_ss)
(setq i -1)
(setq room_list (list))
(setq room_list (append room_list (list(list "TABELA DE ÁREA"))))
(setq room_list (append room_list (list(list "CÔMODO" "ÁREA" "PERIMETRO"))))
(while (< (setq i (1+ i)) (sslength rooms_ss))
(setq eo (vlax-ename->vla-object (ssname rooms_ss i)))
(setq area (rtos (vlax-get eo 'Area)2 2) len (rtos(vlax-get eo 'Length)2 2))
(setq pts (pointlist2d (vlax-get eo 'coordinates)))
(setq sst (ssget "wp" pts (list (cons 8 lay) (cons 0 "*TEXT"))))
(setq room_name (cdr (assoc 1 (entget (ssname sst 0)))))
(setq room_list (append room_list (list(list room_name area len))))
)
(setq pt (getpoint "\nSelect table insertion point >"))
(JH:list-to-table spaceobject room_list pt "standard")
(princ "\nDone!")
)
)
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@LuciLopes wrote:
eu testei em um projeto menor e deu certo, mas em um projeto maior com mais informações deu errado
Copiei seu teste para ter 800 quartos e o código funciona bem. Antes de escolher o ponto de inserção da tabela, amplie para que todos os elementos fiquem visíveis e só então escolha o ponto. Quem pode ficar de pé se não houver nenhuma inscrição na sala. Eu tenho que testar. Principalmente. também funciona com 800 salas, basta dar um tempo porque é um código bastante exigente quando tem muitos elementos e gerar uma tabela não é fácil, espero que o google traduza bem.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Okay, o problema não é no "TESTE" e sim em outro projeto que testei que tinha muitos elementos tipo: cotas, mtext, dtext, hatch. Eu acho que pelo comando identificar os MTEXT contidos na POLILYNE em TODO o projeto pode ser que dê realmente errado, preferia fazer um por um para ser opcional, ou ele fazer isso com elementos (MTEXT e POLILYNE) do mesmo LAYER. tomara que tenha me expressado bem.
If you can assure that inside room boundary polylines there is only one text or mtext for room description, and on the same layer, code should work OK. For the areas and table creation you can have separate layer you can hide or erase when not needed. Also you can copy just that layer with boundaries and descriptions to new temporary drawing for easier checking. There you can check if some description text is missing.
Number of other elements inside the drawing doesn't matter. Just zoom whole drawing before you pick table insertion point. I will test the code later today, currently at work.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@LuciLopes os ### indicam que precisa regenerar a TELA
FIELD inserido pro programação tem esta necessidade
Você achou uma postagem útil? Então fique à vontade para curtir essas postagens!
Sua pergunta obteve uma resposta que resolveu a duvida? Então clique no botão Aceitar Solução.
Fábio Santana
Architect | CAD/BIM Manager
Corrected code for case there is no description text inside room boundary polyline.
Also you can create your own table style and change "standard" to its name inside
(JH:list-to-table spaceobject room_list pt "standard")
(defun c:LuciLopes ( / *error* take pointlist2d JH:list-to-table lay room_list room_name rooms_ss i spaceobject eo area len pts sst)
(defun *error* (msg)
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
(princ (strcat "\nOops an Error : ( " msg " ) occurred."))
)
(princ)
)
(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
(defun pointlist2d (lst / ret) (while lst (setq ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
;; JH:list-to-table --> Jonathan Handojo
;; Creates a table from a list of lists of strings
;; space - ModelSpace or Paperspace vla object
;; lst - list of lists where each list is a list of strings
;; => if you wish to insert a block in the cell, prefix using "<block>" followed by the block name
;; => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1"
;; pt - Insertion point of table (2 or 3 reals)
;; tblstyle - Table style to use
(defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable)
(setq ncols (apply 'max (mapcar 'length lst))
vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10)
)
(vla-put-RegenerateTableSuppressed vtable :vlax-true)
(vla-put-StyleName vtable tblstyle)
(repeat (setq i (length lst))
(setq rows (nth (setq i (1- i)) lst))
(vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0)))
(repeat (setq j (length rows))
(setq lens
(cons
(+
(abs
(apply '-
(mapcar 'car
(textbox
(list
(cons 1 (setq txt (nth (setq j (1- j)) rows)))
(cons 40 (vlax-invoke vtable 'GetCellTextHeight i j))
(cons 7 (vlax-invoke vtable 'GetCellTextStyle i j))
)
)
)
)
)
(vlax-invoke vtable 'GetCellTextHeight i j)
)
lens
)
)
(if (eq (strcase (substr txt 1 7)) "<BLOCK>")
(progn
(setq blk (substr txt 8))
(if (and
(wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
(vlax-method-applicable-p vtable 'setblocktablerecordid32)
)
(vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)))
(vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true)
)
)
(vla-SetText vtable i j txt)
)
)
(setq totlen (cons lens totlen) lens nil)
)
(repeat ncols
(vla-SetColumnWidth vtable (setq ncols (1- ncols))
(apply 'max
(vl-remove nil
(mapcar
'(lambda (x)
(nth ncols x)
)
totlen
)
)
)
)
)
(vla-put-RegenerateTableSuppressed vtable :vlax-false)
vtable
)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq spaceobject(if (eq (getvar 'cvport) 1)(vla-get-paperspace doc)(vla-get-modelspace doc)))
(setq lay (cdr(assoc 8 (entget(car(entsel "\nSelect closed lwpolyline on layer whos entity areas needs to be extracted >"))))))
(setq rooms_ss (ssget "_X" (list (cons 0 "lwpolyline")(cons 8 lay) (cons 70 1))))
(cond
((and rooms_ss)
(setq i -1)
(setq room_list (list))
(setq room_list (append room_list (list(list "TABELA DE ÁREA"))))
(setq room_list (append room_list (list(list "CÔMODO" "ÁREA" "PERIMETRO"))))
(while (< (setq i (1+ i)) (sslength rooms_ss))
(setq eo (vlax-ename->vla-object (ssname rooms_ss i)))
(setq area (rtos (vlax-get eo 'Area)2 2) len (rtos(vlax-get eo 'Length)2 2))
(setq pts (pointlist2d (vlax-get eo 'coordinates)))
(setq sst (ssget "wp" pts (list (cons 8 lay) (cons 0 "*TEXT"))))
(if (and sst)(setq room_name (cdr (assoc 1 (entget (ssname sst 0)))))(setq room_name " "))
(setq room_list (append room_list (list(list room_name area len))))
)
(setq pt (getpoint "\nZoom whole drawing and select table insertion point >"))
(JH:list-to-table spaceobject room_list pt "standard")
(princ "\nDone!")
)
)
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
