Lisp do obliczania powierzchni

danielowy456@gmail.com · 26 Maja 2017

Witam,

Ostatnimi czasy znalazłem lispa który wylicza mi pole danego obszaru po jednym kliknięciu i zestawia wyniki w tabeli. Niestety jest jeden mankament w ty programiku. Nie ignoruje bloków i otworów w ścianach (autocad architecture). Od jakiegoś czasu próbowałem rozwikłać problem ale niestety nie rozumiem poradników programowania. Myślałem nad dwoma rozwiązaniami:

1. By program uwzględniał tylko daną warstwę i ignorował wszystkie inne.

2. liczył pole na danej wysokości osi z (np. 2300mm).

Poniżej załączam cały kod plus zdjęcie z przykładowego rysunku. Byłbym wdzięczny za jakiekolwiek wskazówki. Pozdrawiam.

;;---------------------=={ Area Label }==---------------------;;
;; ;;
;; Allows the user to label picked areas or objects and ;;
;; either display the area in an ACAD Table (if available), ;;
;; optionally using fields to link area numbers and objects; ;;
;; or write it to file. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Version 1.9 - 29-10-2011 ;;
;;------------------------------------------------------------;;

(defun c:AT nil (AreaLabel t)) ;; Areas to Table
(defun c:AF nil (AreaLabel nil)) ;; Areas to File

;;------------------------------------------------------------;;

(defun AreaLabel ( flag / *error* _startundo _endundo _centroid _text _open _select _getobjectid _isannotative
acdoc acspc ap ar as cf cm el fd fl fo n of om p1 pf pt sf st t1 t2 tb th ts tx ucsxang ucszdir )

;;------------------------------------------------------------;;
;; Adjustments ;;
;;------------------------------------------------------------;;

(setq h1 "Area Table" ;; Heading
t1 "Number" ;; Number Title
t2 "Area" ;; Area Title
pf "" ;; Number Prefix (optional, "" if none)
sf "" ;; Number Suffix (optional, "" if none)
ap "" ;; Area Prefix (optional, "" if none)
as "" ;; Area Suffix (optional, "" if none)
cf 1.0 ;; Area Conversion Factor (e.g. 1e-6 = mm2->m2)
fd t ;; Use fields to link numbers/objects to table (t=yes, nil=no)
fo "%lu6%qf1" ;; Area field formatting
)

;;------------------------------------------------------------;;

(defun *error* ( msg )
(if cm (setvar 'CMDECHO cm))
(if el (progn (entdel el) (setq el nil)))
(if acdoc (_EndUndo acdoc))
(if (and of (eq 'FILE (type of))) (close of))
(if (and Shell (not (vlax-object-released-p Shell))) (vlax-release-object Shell))
(if (null (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\n--> Error: " msg))
)
(princ)
)

;;------------------------------------------------------------;;

(defun _StartUndo ( doc ) (_EndUndo doc)
(vla-StartUndoMark doc)
)

;;------------------------------------------------------------;;

(defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
)

;;------------------------------------------------------------;;

(defun _centroid ( space objs / reg cen )
(setq reg (car (vlax-invoke space 'addregion objs))
cen (vlax-get reg 'centroid)
)
(vla-delete reg) (trans cen 1 0)
)

;;------------------------------------------------------------;;

(defun _text ( space point string height rotation / text )
(setq text (vla-addtext space string (vlax-3D-point point) height))
(vla-put-alignment text acalignmentmiddlecenter)
(vla-put-textalignmentpoint text (vlax-3D-point point))
(vla-put-rotation text rotation)
text
)

;;------------------------------------------------------------;;

(defun _Open ( target / Shell result )
(if (setq Shell (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
(progn
(setq result
(and (or (eq 'INT (type target)) (setq target (findfile target)))
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vlax-invoke (list Shell 'Open target))
)
)
)
)
(vlax-release-object Shell)
)
)
result
)

;;------------------------------------------------------------;;

(defun _Select ( msg pred func init / e ) (setq pred (eval pred))
(while
(progn (setvar 'ERRNO 0) (apply 'initget init) (setq e (func msg))
(cond
( (= 7 (getvar 'ERRNO))
(princ "\nMissed, try again.")
)
( (eq 'STR (type e))
nil
)
( (vl-consp e)
(if (and pred (not (pred (setq e (car e)))))
(princ "\nInvalid Object Selected.")
)
)
)
)
)
e
)

;;------------------------------------------------------------;;

(defun _GetObjectID ( doc obj )
(if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
(itoa (vla-get-Objectid obj))
)
)

;;------------------------------------------------------------;;

(defun _isAnnotative ( style / object annotx )
(and
(setq object (tblobjname "STYLE" style))
(setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative")))))
(= 1 (cdr (assoc 1070 (reverse annotx))))
)
)

;;------------------------------------------------------------;;

(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))

ucszdir (trans '(0. 0. 1.) 1 0 t)
ucsxang (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 ucszdir))
)
(_StartUndo acdoc)
(setq cm (getvar 'CMDECHO))
(setvar 'CMDECHO 0)
(setq om (eq "1" (cond ((getenv "LMAC_AreaLabel")) ((setenv "LMAC_AreaLabel" "0")))))

(setq ts
(/ (getvar 'TEXTSIZE)
(if (_isAnnotative (getvar 'TEXTSTYLE))
(cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 )) 1.0
)
)
)

(cond
( (not (vlax-method-applicable-p acspc 'addtable))

(princ "\n--> Table Objects not Available in this Version.")
)
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))

(princ "\n--> Current Layer Locked.")
)
( (not
(setq *al:num
(cond
(
(getint
(strcat "\nSpecify Starting Number <"
(itoa (setq *al:num (1+ (cond ( *al:num ) ( 0 ))))) ">: "
)
)
)
( *al:num )
)
)
)
)
( flag

(setq th
(* 2.
(if
(zerop
(setq th
(vla-gettextheight
(setq st
(vla-item
(vla-item
(vla-get-dictionaries acdoc) "ACAD_TABLESTYLE"
)
(getvar 'CTABLESTYLE)
)
)
acdatarow
)
)
)
ts
(/ th
(if (_isAnnotative (vla-gettextstyle st acdatarow))
(cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 )) 1.0
)
)
)
)
)

(if
(cond
(
(progn (initget "Add")
(vl-consp (setq pt (getpoint "\nPick Point for Table <Add to Existing>: ")))
)
(setq tb
(vla-addtable acspc
(vlax-3D-point (trans pt 1 0)) 2 2 th (* 0.8 th (max (strlen t1) (strlen t2)))
)
)
(vla-put-direction tb (vlax-3D-point (getvar 'UCSXDIR)))
(vla-settext tb 0 0 h1)
(vla-settext tb 1 0 t1)
(vla-settext tb 1 1 t2)

(while
(progn
(if om
(setq p1
(_Select (strcat "\nSelect Object [Pick] <Exit>: ")
'(lambda ( x )
(and
(vlax-property-available-p (vlax-ename->vla-object x) 'area)
(not (eq "HATCH" (cdr (assoc 0 (entget x)))))
(or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x))
)
)
entsel '("Pick")
)
)
(progn (initget "Object") (setq p1 (getpoint "\nPick Area [Object] <Exit>: ")))
)
(cond
( (null p1)

(vla-delete tb)
)
( (eq "Pick" p1)

(setq om nil) t
)
( (eq "Object" p1)

(setq om t)
)
( (eq 'ENAME (type p1))

(setq tx
(cons
(_text acspc
(_centroid acspc (list (setq p1 (vlax-ename->vla-object p1))))
(strcat pf (itoa *al:num) sf)
ts
ucsxang
)
tx
)
)
(vla-insertrows tb (setq n 2) th 1)
(vla-settext tb n 1
(if fd
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(_GetObjectID acdoc p1) ">%).Area \\f \"" fo "\">%"
)
(strcat ap (rtos (* cf (vla-get-area p1)) 2) as)
)
)
(vla-settext tb n 0
(if fd
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(_GetObjectID acdoc (car tx)) ">%).TextString>%"
)
(strcat pf (itoa *al:num) sf)
)
)
nil
)
( (vl-consp p1)

(setq el (entlast))
(vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")

(if (not (equal el (setq el (entlast))))
(progn
(setq tx
(cons
(_text acspc
(_centroid acspc (list (vlax-ename->vla-object el)))
(strcat pf (itoa *al:num) sf)
ts
ucsxang
)
tx
)
)
(vla-insertrows tb (setq n 2) th 1)
(vla-settext tb n 1 (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as))
(vla-settext tb n 0
(if fd
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(_GetObjectID acdoc (car tx)) ">%).TextString>%"
)
(strcat pf (itoa *al:num) sf)
)
)
(redraw el 3)
nil
)
(vla-delete tb)
)
)
)
)
)
(not (vlax-erased-p tb))
)
(
(and
(setq tb
(_Select "\nSelect Table to Add to: "
'(lambda ( x ) (eq "ACAD_TABLE" (cdr (assoc 0 (entget x))))) entsel nil
)
)
(< 1 (vla-get-columns (setq tb (vlax-ename->vla-object tb))))
)
(setq n (1- (vla-get-rows tb)) *al:num (1- *al:num))
)
)
(progn
(while
(if om
(setq p1
(_Select (strcat "\nSelect Object [" (if tx "Undo/" "") "Pick] <Exit>: ")
'(lambda ( x )
(and
(vlax-property-available-p (vlax-ename->vla-object x) 'area)
(not (eq "HATCH" (cdr (assoc 0 (entget x)))))
(or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x))
)
)
entsel (list (if tx "Undo Pick" "Pick"))
)
)
(progn (initget (if tx "Undo Object" "Object"))
(setq p1 (getpoint (strcat "\nPick Area [" (if tx "Undo/" "") "Object] <Exit>: ")))
)
)
(cond
( (and tx (eq "Undo" p1))

(if el (progn (entdel el) (setq el nil)))
(vla-deleterows tb n 1)
(vla-delete (car tx))
(setq n (1- n) tx (cdr tx) *al:num (1- *al:num))
)
( (eq "Undo" p1)

(princ "\n--> Nothing to Undo.")
)
( (eq "Object" p1)

(if el (progn (entdel el) (setq el nil)))
(setq om t)
)
( (eq "Pick" p1)

(setq om nil)
)
( (and om (eq 'ENAME (type p1)))

(setq tx
(cons
(_text acspc
(_centroid acspc (list (setq p1 (vlax-ename->vla-object p1))))
(strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
ts
ucsxang
)
tx
)
)
(vla-insertrows tb (setq n (1+ n)) th 1)
(vla-settext tb n 1
(if fd
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(_GetObjectID acdoc p1) ">%).Area \\f \"" fo "\">%"
)
(strcat ap (rtos (* cf (vla-get-area p1)) 2) as)
)
)
(vla-settext tb n 0
(if fd
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(_GetObjectID acdoc (car tx)) ">%).TextString>%"
)
(strcat pf (itoa *al:num) sf)
)
)
)
( (vl-consp p1)

(if el (progn (entdel el) (setq el nil)))
(setq el (entlast))
(vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")

(if (not (equal el (setq el (entlast))))
(progn
(setq tx
(cons
(_text acspc
(_centroid acspc (list (vlax-ename->vla-object el)))
(strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
ts
ucsxang
)
tx
)
)
(vla-insertrows tb (setq n (1+ n)) th 1)
(vla-settext tb n 1 (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as))
(vla-settext tb n 0
(if fd
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(_GetObjectID acdoc (car tx)) ">%).TextString>%"
)
(strcat pf (itoa *al:num) sf)
)
)
(redraw el 3)
)
(princ "\n--> Error Retrieving Area.")
)
)
)
)
(if el (progn (entdel el) (setq el nil)))
)
)
)
(
(and
(setq fl (getfiled "Create Output File" (cond ( *file* ) ( "" )) "txt;csv;xls" 1))
(setq of (open fl "w"))
)
(setq *file* (vl-filename-directory fl)
de (cdr (assoc (strcase (vl-filename-extension fl) t) '((".txt" . "\t") (".csv" . ",") (".xls" . "\t"))))
*al:num (1- *al:num)
)
(write-line h1 of)
(write-line (strcat t1 de t2) of)

(while
(if om
(setq p1
(_Select (strcat "\nSelect Object [Pick] <Exit>: ")
'(lambda ( x )
(and
(vlax-property-available-p (vlax-ename->vla-object x) 'area)
(not (eq "HATCH" (cdr (assoc 0 (entget x)))))
(or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x))
)
)
entsel '("Pick")
)
)
(progn (initget "Object") (setq p1 (getpoint (strcat "\nPick Area [Object] <Exit>: "))))
)
(cond
( (eq "Object" p1)

(if el (progn (entdel el) (setq el nil)))
(setq om t)
)
( (eq "Pick" p1)

(setq om nil)
)
( (eq 'ENAME (type p1))

(_text acspc
(_centroid acspc (list (setq p1 (vlax-ename->vla-object p1))))
(strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
ts
ucsxang
)
(write-line (strcat pf (itoa *al:num) sf de ap (rtos (* cf (vla-get-area p1)) 2) as) of)
)
( (vl-consp p1)

(if el (progn (entdel el) (setq el nil)))
(setq el (entlast))
(vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")

(if (not (equal el (setq el (entlast))))
(progn
(_text acspc
(_centroid acspc (list (vlax-ename->vla-object el)))
(strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
ts
ucsxang
)
(write-line (strcat pf (itoa *al:num) sf de ap (rtos (* cf (vlax-curve-getarea el)) 2) as) of)
(redraw el 3)
)
(princ "\n--> Error Retrieving Area.")
)
)
)
)
(if el (progn (entdel el) (setq el nil)))
(setq of (close of))
(_Open (findfile fl))
)
)
(setenv "LMAC_AreaLabel" (if om "1" "0"))
(setvar 'CMDECHO cm)
(_EndUndo acdoc)
(princ)
)

;;------------------------------------------------------------;;

(vl-load-com)
(princ)
(princ "\n:: AreaLabel.lsp | Version 1.9 | © Lee Mac 2011 www.lee-mac.com ::")
(princ "\n:: Commands: \"AT\" for ACAD Table, \"AF\" for File ::")
(princ)

;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;

dmatusz3 · 29 Maja 2017

Popatrzymy na ten skrypt, jeśli da się go w miarę prosto przerobić to zrobimy to.

Natomiast mamy nakładkę do przedmiarowania, która być może funkcjonalnie będzie Panu odpowiadać - ZWMetric.

Poniżej jedna z funkcji.

Parikon · 30 Maja 2017

Można także w bardzo łatwy sposób wyliczać powierzchnie poprzez korzystanie z właściwości obiektu jakim jest obiekt typu ZwSoft.ZwCAD.DatabaseServices.Hatch

Obliczanie powierchrzni w ZwCAD 2017

Parikon · 30 Maja 2017

Sumowanie powierzchni też jest proste

Sumowanie powierzchni w ZwCAD 2107

danielowy456@gmail.com · 9 Lipca 2017

Witam

Chciałbym przeprosić, że nie odpisywałem tak długo ale miałem szalony tydzień.

Parikon. Niestety kreskowanie w moim przypadku nie zda się na nic bo w pomieszczeniach mam duż tekstów i bloków. Poza tym tak jak w lispie załączonym w powyższym poście chciałbym obliczyć powierzchnie jednym kliknięciem i jednocześnie tworzyć tabelę z wynikami.

dmatusz3. Wielkie dzięki za link. Niestety nie mogę przetestować programu. Nie włącza się automatycznie, dodatkowo próbowałem załadować ręcznie tak jak lisp. Niestety nie widzi mi pliku, ale aplikacja wygląda naprawdę imponująco.

Dziękuje za odzew, będę walczy dalej, może uda mi się coś ugrać,

Pozdrawiam

Parikon · 10 Lipca 2017

Podaje tylko jak można to zrobić szybko i sprawnie mając do dyspozycji czysty program. Co nie oznacza, że napisanie programu robiącego to jeszcze lepiej nie ma sensu.

Argument o dużej ilości bloków czy obiektów jest mało przekonujący gdy mamy do dyspozycji warstwy i sumowane powierzchnie są w obrębie jednej warstwy, którą możemy wyodrębnić i zliczyć całość lub każdy obszar z osobna. Na koniec ukryć.

Dodatkowo mamy jeszcze w ZwCAD tabele, w których możemy kopiować zbierane dane z okna właściwości i zliczać jak w formularzu excela czy libre office.

danielowy456@gmail.com · 10 Lipca 2017

Dzięki za szybką odpowiedź,

Zdaje sobię sprawę, że można wyizolować warstwy. Niestety chcąc wyłączyć wszystkie 50 warstw które mam na rysunku, aż przycina mi komputer. Aktualnie liczę to na dwa sposoby:

1. Jeżeli to jest kwadrat o rysuję prostokąt (dwa kliknięcia i po sprawie) i we właściwościach od razu pokazuje po obszar.

2. Mam przypisany skrót dodatkowy pod jedno kliknięcie na obliczanie pola wcześniej wyznaczonego poprzez kliknięcia.

Oba rozwiązania są dosyć szybkie, ale muszę wprowadzać dane ręcznie.

Lisp który załączyłem liczy wszystko poprzez jedno kliknięcie i zestawia w tabeli (plik lub w rysunku) niestety nie omija bloków i wcięć w ścianie. Więc zakładam jakby ignorowało to bądź liczyło na określonej osi z problem byłby rozwiązany.

Szkoda, że zwmetric nie działa na autocadzie (przynajmniej na tym na którym go testowałem).

Pozdrawiam

Zaloguj się

Lisp do obliczania powierzchni

Rekomendowane odpowiedzi

danielowy456@gmail.com

dmatusz3

Parikon

Parikon

danielowy456@gmail.com

Parikon

danielowy456@gmail.com

Dołącz do dyskusji

Przeglądaj

Cała aktywność

Pobierz program CAD