ADN Club > AutoLisp / VisualLISP и DCL
Макрос для измерения длины, высоты и площади блоков на чертеже
(1/1)
Peacemaker_kiss:
Идея родилась в связи с тем, что используем блоки, которые несут в себе информацию о фасадах зданий, и автоматизация расчета геометрии оказалась очень полезным подспорьем
Огромная благодарность Александру Ривилису за определения точных границ задачи и VVA за фрагмент кода с форума dwg.ru
Приятным бонусом кода является то, что полученная информация разносится по таблицам, а также производится суммирование длин и площадей всех требуемых блоков, также с занесением в таблицу; учитывается масштаб блоков
--- Код - Auto/Visual Lisp [Выбрать] ---(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)(setq pt (trans pt 0 1))(setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE") SSZ (getvar "SCREENSIZE") X_Pix (car SSZ) Y_Pix (cadr SSZ) X_Len (* (/ X_Pix Y_Pix) Y_Len) Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len)) Uc (polar Lc 0.0 X_Len) Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len)) Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)))(if (and (> (car pt) (car Lc))(< (car pt) (car Uc)) (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc))) T nil))(defun DTR (a)(* pi (/ a 180.0)))(defun RTD (a)(/ (* a 180.0) pi)); ! ***********************************************************;; ! lib:Zoom2Lst;; ! **********************************************************;; ! Function : Zoom границ списка точек;; ! Arguments: 'vlist' — Список точек в МСК!!!!;; ! Зуммирует экран, чтобы все точки были видны;; ! Returns : t — было зуммирование nil — нет;; ! **********************************************************(defun lib:Zoom2Lst( vlist / bl tr Lst OS)(setq Lst (lib:pt_extents vlist) bl (car Lst) tr (cadr Lst))(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))(progn (setq OS (getvar "OSMODE"))(setvar "OSMODE" 0) (command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1) "_.Zoom" "0.95x") (setvar "OSMODE" OS) T) NIL));| ! ***************************************************************************;; ! lib:pt_extents;; ! ***************************************************************************;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек;; ! Argument : 'vlist' — Список точек;; ! Returns : Список точек (ЛевНижн ПравВерхн);; ! ***************************************************************************|;(defun lib:pt_extents (vlist / tmp)(setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x))(mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist)) '(0 1 2))));_setq (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun;http://www.caduser.ru/forum/index.php...&TID=30797;External contour of objects (defun c:sv_tabl ( / alltext _textfind _textfor kscale _block _name_fas minpoint_l maxpoint_l minpoint_h maxpoint_h diff_l diff_h _sum _sum_sq ) (vl-load-com) (setq _sum 0.0 ) (setq _sum_sq 0.0 ) (setq alltext (ssget "_X" (list (cons 1 "*00 }") (cons 0 "Mtext")))) (setq _textfind (vlax-ename->vla-object (ssname alltext 0))) (setq _textfor (vla-get-TextString _textfind)) (if (wcmatch _textfor "*100 }") (setq kscale 0.1) (setq kscale 0.2)) (setq _acad (vlax-get-acad-object)) (setq active_doc (vla-get-ActiveDocument _acad)) (setq m_space (vla-get-ModelSpace active_doc)) (setq _blockselect (ssget "_X" (list (cons 2 "фасад*") (cons 0 "Insert")))) (setq counter 0) (while (< counter (sslength _blockselect)) (setq _block (vlax-ename->vla-object (ssname _blockselect counter))) (setq _name_fas (vla-get-name _block)) (vla-getboundingbox _block 'minpoint 'maxpoint) (setq minpoint_l (nth 0 (vlax-safearray->list minpoint))) (setq maxpoint_l (nth 0 (vlax-safearray->list maxpoint))) (setq minpoint_h (nth 1 (vlax-safearray->list minpoint))) (setq maxpoint_h (nth 1 (vlax-safearray->list maxpoint))) (setq diff_l (* kscale (- maxpoint_l minpoint_l))) (setq diff_h (* kscale (- maxpoint_h minpoint_h))) (setq l (rtos diff_l 2 1)) (princ (strcat "Длина "_name_fas":" l "м") ) (terpri) (defun _part ( / *error* blk obj MinPt MaxPt hiden pt pl unnamed_block isRus tmp_blk adoc blks lays lay oname sel csp loc sc ec ret DS osm) (defun *error* (msg)(mapcar '(lambda (x) (vla-put-Visible x :vlax-true)) hiden)(vla-endundomark adoc)(if (and tmp_blk (not (vlax-erased-p tmp_blk))(vlax-write-enabled-p tmp_blk) )(vla-Erase tmp_blk))(if osm (setvar "OSMODE" osm))(foreach x loc (vla-put-lock x :vlax-true)))(vl-load-com)(setvar "CMDECHO" 0)(setq osm (getvar "OSMODE"))(if (zerop (getvar "WORLDUCS"))(progn(vl-cmdf "_.UCS" "")(vl-cmdf "_.Plan" "")))(setq isRus (= (getvar "SysCodePage") "ANSI_1251"))(setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) blks (vla-get-blocks adoc) lays (vla-get-layers adoc)) (vla-startundomark adoc)(if isRus (princ (strcat "\nВыберите объекты для построения контура,"_name_fas":"))(princ (strcat "\nSelect objects for making a contour,"_name_fas":")))(if (setq sel (ssget))(progn (setq sel (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sel))))) (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel)))) (setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point '(0. 0. 0.)) "*U")) (foreach x sel (setq oname (strcase (vla-get-objectname x)) lay (vla-item lays (vla-get-layer x))) (if (= (vla-get-lock lay) :vlax-true) (progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc)))) (cond ((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION")) nil) ((= oname "ACDBBLOCKREFERENCE") (vla-InsertBlock unnamed_block (vla-get-insertionpoint x)(vla-get-name x) (vla-get-xscalefactor x)(vla-get-yscalefactor x) (vla-get-zscalefactor x)(vla-get-rotation x)) (setq blk (cons x blk))) (t (setq obj (cons x obj)))));_foreach (setq lay (vla-item lays (getvar "CLAYER"))) (if (= (vla-get-lock lay) :vlax-true)(progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc)))) (if obj (progn (vla-copyobjects (vla-get-activedocument (vlax-get-acad-object)) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length obj)))) obj)) unnamed_block))) (setq obj (append obj blk)) (if obj (progn (setq tmp_blk (vla-insertblock csp (vlax-3d-point '(0. 0. 0.))(vla-get-name unnamed_block) 1.0 1.0 1.0 0.0)) (vla-GetBoundingBox tmp_blk 'MinPt 'MaxPt) ;_Границы блока (setq MinPt (vlax-safearray->list MinPt) MaxPt (vlax-safearray->list MaxPt) DS (max (distance MinPt (list (car MinPt)(cadr MaxPt))) (distance MinPt (list (car MaxPt)(cadr MinPt)))) DS (* 0.2 DS) ;1/5 DS (max DS 10) MinPt (mapcar '- MinPt (list DS DS)) MaxPt (mapcar '+ MaxPt (list DS DS)))(lib:Zoom2Lst (list MinPt MaxPt))(setq sset (ssget "_C" MinPt MaxPt))(if sset (progn (setvar "OSMODE" 0) (setq hiden (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))) hiden (vl-remove tmp_blk hiden)) (mapcar '(lambda(x)(vla-put-Visible x :vlax-false)) hiden) (setq pt (mapcar '+ MinPt (list (* 0.5 DS)(* 0.5 DS)))) (vl-cmdf "_.RECTANG" (trans MinPt 0 1)(trans MaxPt 0 1)) (setq pl (vlax-ename->vla-object(entlast))) (setq sc (1-(vla-get-count csp))) (if (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY '(lambda () (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "") (while (> (getvar "CMDACTIVE") 0)(command ""))))) (if isRus (princ "\nНе удалось построить контур")(princ "\nIt was not possible to construct a contour"))) (setq ec (vla-get-count csp)) (while (< sc ec)(setq ret (append ret (list (vla-item csp sc))) sc(1+ sc))) (setq ret (vl-remove pl ret)) (mapcar '(lambda (x)(vla-Erase x)(vlax-release-object x))(list pl tmp_blk))(setq pl nil tmp_blk nil) (setq ret (mapcar '(lambda ( x / mipt)(vla-GetBoundingBox x 'MiPt nil) ;_Границы блока (setq MiPt (vlax-safearray->list MiPt))(list MiPt x)) ret)) (setq ret (vl-sort ret '(lambda (e1 e2)(< (distance MinPt (car e1))(distance MinPt (car e2)))))) (setq pl (nth 1 ret) ret (vl-remove pl ret))(mapcar 'vla-erase (mapcar 'cadr ret)) (mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden) (foreach x loc (vla-put-lock x :vlax-true)) (if pl (progn (initget "Yes No") (if (= (getkword (if isRus "\nУдалять объекты? [Yes/No] <No> : " "\nDelete objects? [Yes/No] <No> : ")) "Yes") (mapcar '(lambda (x) (if (vlax-write-enabled-p x)(vla-Erase x))) obj))) (if isRus (princ "\nНе удалось построить контур")(princ "\nIt was not possible to construct a contour"))))))) (VL-CATCH-ALL-APPLY '(lambda ()(mapcar 'vlax-release-object (list unnamed_block tmp_blk csp blks lays))))));_if not (foreach x loc (vla-put-lock x :vlax-true))(setvar "OSMODE" osm) (vla-endundomark adoc)(vlax-release-object adoc)(princ)(setq sq_a (* 0.01 (vlax-get-property (vlax-ename->vla-object(entlast)) 'area))) (princ (strcat "Площадь:"(rtos sq_a 2 1)" м2" ))(terpri) (vla-erase (vlax-ename->vla-object(entlast)))) (_part) (setq _table (ssget "_X" (list (cons 1 (strcat "Характеристика здания ("_name_fas") " )) (cons 0 "ACAD_TABLE")))) (setq _t (vlax-ename->vla-object (ssname _table 0)))(vla-settext _t 3 1 l ) (vla-settext _t 1 1 (rtos diff_h 2 1)) (vla-settext _t 2 1 (rtos sq_a 2 1 )) (setq _sum (+ _sum diff_l)) (setq _sum_sq (+ _sum_sq sq_a)) (setq counter (+ counter 1))) (princ (strcat "\nСуммарная длина фасадов:" (rtos _sum 2 1) "м")) (princ (strcat "\nСуммарная площадь фасадов:" (rtos _sum_sq 2 1) "м2")) (terpri) (setq a (rtos _sum 2 1)) (setq b (rtos _sum_sq 2 1)) (setq _tablex (ssget "_X" (list (cons 1 "Характеристика зданий") (cons 0 "ACAD_TABLE")))) (setq _t (vlax-ename->vla-object (ssname _tablex 0))) (vla-settext _t 2 1 a) (vla-settext _t 1 1 b) )Для наглядности выкладываю файл с примером
Александр Ривилис:
У меня только одно замечание. По терминологии. В AutoCAD у блока нет ни длины, ни высоты, ни площади. Есть масштабные коэффициенты по X,Y,Z. Есть габаритный контейнер, в который блок (а точнее вставка блока) вписывается.
Навигация
Перейти к полной версии