Lisp tính diện tích theo layer

[NguyenNgocSon 43]

Bài toán : Tính miền diện tích giới hạn bởi 2 đường có tên là layer là 1,2.

Chức năng của lisp: + Chọn layer cần tính (pick vào đường 1,2 có layer tương ứng)

+ Lisp tính toán diện tích giới hạn bởi miền này và ghi vào text có sẵn.

( Vì trong miền giới hạn bởi đường 1, 2 có nhiều miền nhỏ nên em nghĩ nếu chon đường bao ngoải rộng thì tính sẽ nhanh )

Vì khả năng lisp còn khá hạn chế. Em post vấn đề lên mong mọi người giúp đỡ

Em xin cám ơn !

Thân !

[linhoreka 47]

Chả cần Lisp gì cả, bạn Hatch, hoặc bo vùng diện tích lại bằng lại lệnh Boundary, hoặc đơn giản là là lệnh Pline, rồi click vào Hatch, hoặc Pline, Ctrl+1 xem Properties > Geometry > Area > Chia cho tỷ lệ bạn cần = Diện tích.

Bạn giữ nguyên Hatch hay Pline ấy mà stretch edit sau này khi cần thì lại Ctrl+1 xem update lại diện tích.

Còn nếu bạn cần lisp tính diện tích thì thực ra nên là: chọn Hatch, hay Pline rồi chọn ScaleFactor (tỷ lệ) rồi chọn Text đích để copy giá trị diện tích vào, đỡ qua 2, 3 công đoạn như mình trình bày ở trên.

Good luck !

[ketxu 2.984]

Bạn thể hiện bằng bản vẽ ý tưởng của bạn đi.

[NguyenNgocSon 43]

Bạn thể hiện bằng bản vẽ ý tưởng của bạn đi.

Trước hết rất cảm ơn ketxu. Đây là file mẫu : http://www.mediafire.com/?dk3z6jww3ywbm39

[ketxu 2.984]

Mình thấy vệc này tạm thời làm thủ công + lisp đơn giản không hề chậm lắm đâu, và mọi người sẽ hiện thực hóa nó.Ta sẽ không dùng lệnh aa để đo diện tích,vì chưa có đối tượng bao,hoặc phải kích điểm rất lâu,mà dùng mắt thường để tạo ra đường biên đa giác bao ngoài trước.

1.Như bạn nói, đường biên chỉ bao gồm 2 layer, vậy trước tiên bạn layiso 2 layer này trước đã nhé.

2.Sau đó dùng lisp nối các line bao ngoài thành 1 pline kín

3.Lấy diện tích đa giác bao ngoài này bằng các lisp tính diện tích có sẵn trên diễn đàn

Các thao tác để tạo pline bao ngoài có thể gói gọn bằng lisp này, của 1 Pro người nga do 1 pro người Việt (^^) giới thiệu.Lệnh Eco.Sau khi có em bao ngoài rồi thì việc còn lại k có j phứcc tạp cả ^^

 

;
;;; External contour of objects
(defun C:ECO (/       *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     iNSpT
            )
 (defun *error* (msg)
   (princ 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)
       ) ;_ end of and
     (vla-erase tmp_blk)
   ) ;_ end of if
   (if osm
     (setvar "OSMODE" osm)
   ) ;_ end of if
   (foreach x loc (vla-put-lock x :vlax-true))
 ) ;_ end of defun
 (vl-load-com)
 (setvar "CMDECHO" 0)
 (setq osm (getvar "OSMODE"))
 (if (zerop (getvar "WORLDUCS"))
   (progn (vl-cmdf "_.UCS" "") (vl-cmdf "_.Plan" ""))
 ) ;_ end of if
 (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)
 ) ;_ end of setq
 (vla-startundomark adoc)
 (if isRus
   (princ "\n§£§í§Ò§Ö§â§Ú§ä§Ö §à§Ò§ì§Ö§Ü§ä§í §Õ§Ý§ñ §á§à§ã§ä§â§à§Ö§ß§Ú§ñ §Ü§à§ß§ä§å§â

§Ñ")
   (princ "\nSelect objects for making a contour")
 ) ;_ end of if
 (vlax-for lay lays
   (if (= (vla-get-lock lay) :vlax-true)
     (progn (vla-put-lock lay :vlax-false)
            (setq loc (cons lay loc))
     ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of vlax-for
 (if (setq sel (ssget))
   (progn
     (setq sel (ssnamex sel))
     (setq iNSpT '(0 0 0))
     (setq sel (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr sel))
               ) ;_ end of mapcar
     ) ;_ end of setq
     (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel))))
     (setq unnamed_block
            (vla-add (vla-get-blocks adoc)
                     (vlax-3d-point inspt)
                     "*U"
            ) ;_ end of vla-add
     ) ;_ end of setq
     (foreach x sel
       (setq oname (strcase (vla-get-objectname x)))
       (cond
  ((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION" "ACDBMTEXT" 

"ACDBTEXT"  )  ) ;_ end of member
              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)
              ) ;_ end of vla-InsertBlock
              (setq blk (cons x blk))
             )
             (t (setq obj (cons x obj)))
       ) ;_ end of cond
     ) ;_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))
       ) ;_ end of progn
     ) ;_ end of if
     (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)))
                    ) ;_ end of vlax-make-safearray
                    obj
                  ) ;_ end of vlax-safearray-fill
                ) ;_ end of vlax-make-variant
                unnamed_block
              ) ;_ end of vla-copyobjects
       ) ;_ end of progn
     ) ;_ end of if
     (setq obj (append obj blk))
     (if obj
       (progn
         (setq tmp_blk (vla-insertblock
                         csp
                         (vlax-3d-point inspt)
                         (vla-get-name unnamed_block)
                         1.0
                         1.0
                         1.0
                         0.0
                       ) ;_ end of vla-insertblock
         ) ;_ end of setq
         (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)))
                     ) ;_ end of max
               DS    (* 0.2 DS)                  ;1/5
               DS    (max DS 10)
               MinPt (mapcar '- MinPt (list DS DS))
               MaxPt (mapcar '+ MaxPt (list DS DS))
         ) ;_ end of setq
         (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))
                                 ) ;_ end of vl-remove-if
                         ) ;_ end of mapcar
                   hiden (vl-remove tmp_blk hiden)
             ) ;_ end of setq
             (mapcar '(lambda (x) (vla-put-visible x :vlax-false))
                     hiden
             ) ;_ end of mapcar
             (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 (entlast))
             (if
               (vl-catch-all-error-p
                 (vl-catch-all-apply
                   '(lambda ()
                      (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")
                      (while (> (getvar "CMDACTIVE") 0) (command ""))
                    ) ;_ end of lambda
                 ) ;_ end of VL-CATCH-ALL-APPLY
               ) ;_ end of VL-CATCH-ALL-ERROR-P
                (if isRus
                  (princ "\n§¯§Ö §å§Õ§Ñ§Ý§à§ã§î §á§à§ã§ä§â§à§Ú§ä§î §Ü§à§ß§ä§å§â")
                  (princ "\nIt was not possible to construct a contour")
                ) ;_ end of if
             ) ;_ end of if
             (setq ec sc)
             (while (setq ec (entnext ec))
               (setq ret (cons (vlax-ename->vla-object ec) ret))
               )
               (setq ret (vl-remove pl ret))
             (mapcar '(lambda (x) (vla-erase x) (vlax-release-object x))
                     (list pl tmp_blk)
             ) ;_ end of mapcar
             (setq pl nil
                   tmp_blk nil
             ) ;_ end of setq
             (setq
               ret (mapcar '(lambda (x / mipt)
                              (vla-getboundingbox x 'MiPt nil) 
                              (setq MiPt (vlax-safearray->list MiPt))
                              (list MiPt x)
                            ) ;_ end of lambda
                           ret
                   ) ;_ end of mapcar
             ) ;_ end of setq
             (setq ret (vl-sort ret
                                '(lambda (e1 e2)
                                   (                                       (distance MinPt (car e2))
                                   ) ;_ end of                                   ) ;_ end of lambda
                       ) ;_ end of vl-sort
             ) ;_ end of setq
             (setq pl  (nth 1 ret)
                   ret (vl-remove pl ret)
             ) ;_ end of setq
             (mapcar 'vla-erase (mapcar 'cadr ret))
             (mapcar '(lambda (x) (vla-put-visible x :vlax-true))
                     hiden
             ) ;_ end of mapcar
             (foreach x loc (vla-put-lock x :vlax-true))
             (if pl
               (progn
                 (initget "Yes No")
                 (if
                   (= (getkword (if isRus
                                  "\n§µ§Õ§Ñ§Ý§ñ§ä§î §à§Ò§ì§Ö§Ü§ä§í? [Yes/No]  : "
                                  "\nDelete objects? [Yes/No]  : "
                                ) ;_ end of if
                      ) ;_ end of getkword
                      "Yes"
                   ) ;_ end of =
                    (mapcar '(lambda (x)
                               (if (vlax-write-enabled-p x)
                                 (vla-erase x)
                               ) ;_ end of if
                             ) ;_ end of lambda
                            obj
                    ) ;_ end of mapcar
                 ) ;_ end of if
               ) ;_ end of progn
               (if isRus
                 (princ "\n§¯§Ö §å§Õ§Ñ§Ý§à§ã§î §á§à§ã§ä§â§à§Ú§ä§î §Ü§à§ß§ä§å§â")
                 (princ "\nIt was not possible to construct a contour")
               ) ;_ end of if
             ) ;_ end of if
           ) ;_ end of progn
         ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
     (vl-catch-all-apply
       '(lambda ()
          (mapcar 'vlax-release-object
                  (list unnamed_block tmp_blk csp blks lays)
          ) ;_ end of mapcar
        ) ;_ end of lambda
     ) ;_ end of VL-CATCH-ALL-APPLY
   ) ;_ end of progn
 ) ;_if not
 (foreach x loc (vla-put-lock x :vlax-true))
 (setvar "OSMODE" osm)
 (vla-endundomark adoc)
 (vlax-release-object adoc)
 (command ".area" "o" "L")
(setq dt (getvar "area"))
(command ".erase" L "") 
(writeres dt)
 (princ)
) ;_ end of defun
;;; ========== HELPER FUNCTION ==========================================
(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))
 ) ;_ end of setq
 (if (and (> (car pt) (car Lc))
          (           (> (cadr pt) (cadr Lc))
          (      ) ;_ end of and
   t
   nil
 ) ;_ end of if
) ;_ end of defun

(defun DTR (a) (* pi (/ a 180.0)))

(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)
         ) ;_ end of mapcar
       ) ;_ end of mapcar
 ) ;_setq
 (list (mapcar '(lambda (x) (apply 'min x)) tmp)
       (mapcar '(lambda (x) (apply 'max x)) tmp)
 ) ;_ end of list
) ;_defun

(defun lib:Zoom2Lst (vlist / bl tr Lst OS)
 (setq Lst (lib:pt_extents vlist)
       bl  (car Lst)
       tr  (cadr Lst)
 ) ;_ end of setq
 (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"
          ) ;_ end of command
          (setvar "OSMODE" OS)
          t
   ) ;_ end of progn
   NIL
 ) ;_ end of if
) ;_ end of defun

(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
(defun WriteRes(kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\tChon text ghi ket qua:")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))
(princ)
)

[NguyenNgocSon 43]

Thực ra thì thuật toán làm việc của bạn đã có đâu đó trên diễn đàn, srr bạn vì mình chưa có thời gian và khả năng để tìm kiếm và nghiên cứu ^^,nhưng mình thấy vệc này tạm thời làm thủ công không hề chậm như bạn nghĩ, và mọi người sẽ hiện thực hóa nó.Ta sẽ không dùng lệnh aa để đo diện tích,vì chưa có đối tượng bao,hoặc phải kích điểm rất lâu,mà dùng mắt thường để tạo ra đường biên đa giác bao ngoài trước.

1.Như bạn nói, đường biên chỉ bao gồm 2 layer, vậy trước tiên bạn layiso 2 layer này trước đã nhé.

2.Sau đó dùng lisp nối các line bao ngoài thành 1 pline kín -> lấy diện tích đa giác bao ngoài này bằng các lisp tính diện tích có sẵn trên diễn đàn

Thank bạn nhiều.

Thực tế m cũng đã nghĩ đến việc đó, và cũng làm rồi. Kể ra bài toán m nêu có rất nhiều lisp giải quyết được, nó là tập hợp của các lisp khác nhau ?

Nhưng mình muốn auto công việc đến mức tối đa nên đặt ra bài toán đó.

Cám ơn sự chỉ bảo và đóng góp của mọi người.

Hi vọng trong quá trình học lisp em sẽ dần giải quyết nó !

[ketxu 2.984]

Thank bạn nhiều.

Thực tế m cũng đã nghĩ đến việc đó, và cũng làm rồi. Kể ra bài toán m nêu có rất nhiều lisp giải quyết được, nó là tập hợp của các lisp khác nhau ?

Nhưng mình muốn auto công việc đến mức tối đa nên đặt ra bài toán đó.

Cám ơn sự chỉ bảo và đóng góp của mọi người.

Hi vọng trong quá trình học lisp em sẽ dần giải quyết nó !

Bài toán của bạn đã giải xong, bao gồm cả việc ghi kết quả,code ở bài trên, bạn lấy về dùng nhé.Dù không giải quết theo hướng bạn đưa ra nhưng mình nghĩ như thế này thì chuẩn hơn và tổng quát hơn, vì thú thực việc xác định giới hạn của các đường thẳng thuộc 2 layer vẫn rất mông lung, có khi trong bản vẽ các đường line thuộc 2 layer này lại nằm rải rác thì hỏng.Không có gì hay hơn là tự mình quyết định cho nó tính ở đâu :):).Khi dùng thì bạn quét chọn hết các đối tượng thuộc tập bạn muốn tính diện tích nhé :). CHúc bạn thành công

[phamngoctukts 714]

Bài toán của bạn đã giải xong, bao gồm cả việc ghi kết quả,code ở bài trên, bạn lấy về dùng nhé.Dù không giải quết theo hướng bạn đưa ra nhưng mình nghĩ như thế này thì chuẩn hơn và tổng quát hơn, vì thú thực việc xác định giới hạn của các đường thẳng thuộc 2 layer vẫn rất mông lung, có khi trong bản vẽ các đường line thuộc 2 layer này lại nằm rải rác thì hỏng.Không có gì hay hơn là tự mình quyết định cho nó tính ở đâu :):).Khi dùng thì bạn quét chọn hết các đối tượng thuộc tập bạn muốn tính diện tích nhé :). CHúc bạn thành công

Lisp đâu em????

[ketxu 2.984]

E post ở ngay bài reply bên trên ý ạ ^^ Reply #5

 

Eco bound

 

p/s : mấy hnay hành lạc hết Bi-a lại PS, hư hết người rồi bác ạ

[NguyenNgocSon 43]

Thực ra bải toán của em đưa ra giống như kiểu tính diện tích trong NOVA. Nếu ai đã làm novo thì sẽ hiểu đó chính là việc pick khối lượng trẻn trắc ngang !

[trieubb 5]

Mình thấy vệc này tạm thời làm thủ công + lisp đơn giản không hề chậm lắm đâu, và mọi người sẽ hiện thực hóa nó.Ta sẽ không dùng lệnh aa để đo diện tích,vì chưa có đối tượng bao,hoặc phải kích điểm rất lâu,mà dùng mắt thường để tạo ra đường biên đa giác bao ngoài trước.

1.Như bạn nói, đường biên chỉ bao gồm 2 layer, vậy trước tiên bạn layiso 2 layer này trước đã nhé.

2.Sau đó dùng lisp nối các line bao ngoài thành 1 pline kín

3.Lấy diện tích đa giác bao ngoài này bằng các lisp tính diện tích có sẵn trên diễn đàn

Các thao tác để tạo pline bao ngoài có thể gói gọn bằng lisp này, của 1 Pro người nga do 1 pro người Việt (^^) giới thiệu.Lệnh Eco.Sau khi có em bao ngoài rồi thì việc còn lại k có j phứcc tạp cả ^^

 

;;;; External contour of objects(defun C:ECO (/   	*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 	iNSpT         	)  (defun *error* (msg)    (princ 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)        ) ;_ end of and      (vla-erase tmp_blk)    ) ;_ end of if    (if osm      (setvar "OSMODE" osm)    ) ;_ end of if    (foreach x loc (vla-put-lock x :vlax-true))  ) ;_ end of defun  (vl-load-com)  (setvar "CMDECHO" 0)  (setq osm (getvar "OSMODE"))  (if (zerop (getvar "WORLDUCS"))    (progn (vl-cmdf "_.UCS" "") (vl-cmdf "_.Plan" ""))  ) ;_ end of if  (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)  ) ;_ end of setq  (vla-startundomark adoc)  (if isRus    (princ "\n§£§í§Ò§Ö§â§Ú§ä§Ö §à§Ò§ì§Ö§Ü§ä§í §Õ§Ý§ñ §á§à§ã§ä§â§à§Ö§ß§Ú§ñ §Ü§à§ß§ä§å§â§Ñ")    (princ "\nSelect objects for making a contour")  ) ;_ end of if  (vlax-for lay lays    (if (= (vla-get-lock lay) :vlax-true)      (progn (vla-put-lock lay :vlax-false)         	(setq loc (cons lay loc))      ) ;_ end of progn    ) ;_ end of if  ) ;_ end of vlax-for  (if (setq sel (ssget))    (progn      (setq sel (ssnamex sel))      (setq iNSpT '(0 0 0))      (setq sel (mapcar 'vlax-ename->vla-object                        (vl-remove-if 'listp (mapcar 'cadr sel))                ) ;_ end of mapcar      ) ;_ end of setq      (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel))))      (setq unnamed_block         	(vla-add (vla-get-blocks adoc)                      (vlax-3d-point inspt)                      "*U"         	) ;_ end of vla-add      ) ;_ end of setq      (foreach x sel        (setq oname (strcase (vla-get-objectname x)))        (cond  	((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION" "ACDBMTEXT" "ACDBTEXT"  )  ) ;_ end of member           	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)           	) ;_ end of vla-InsertBlock           	(setq blk (cons x blk))              )              (t (setq obj (cons x obj)))        ) ;_ end of cond      ) ;_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))        ) ;_ end of progn      ) ;_ end of if      (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)))                 	) ;_ end of vlax-make-safearray                 	obj               	) ;_ end of vlax-safearray-fill             	) ;_ end of vlax-make-variant             	unnamed_block           	) ;_ end of vla-copyobjects        ) ;_ end of progn      ) ;_ end of if      (setq obj (append obj blk))      (if obj        (progn          (setq tmp_blk (vla-insertblock                          csp                          (vlax-3d-point inspt)                          (vla-get-name unnamed_block)                          1.0                          1.0                          1.0                          0.0                        ) ;_ end of vla-insertblock          ) ;_ end of setq          (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)))                      ) ;_ end of max                DS    (* 0.2 DS)                  ;1/5                DS    (max DS 10)                MinPt (mapcar '- MinPt (list DS DS))                MaxPt (mapcar '+ MaxPt (list DS DS))          ) ;_ end of setq          (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))                                  ) ;_ end of vl-remove-if                          ) ;_ end of mapcar                    hiden (vl-remove tmp_blk hiden)              ) ;_ end of setq              (mapcar '(lambda (x) (vla-put-visible x :vlax-false))                      hiden              ) ;_ end of mapcar              (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 (entlast))              (if                (vl-catch-all-error-p                  (vl-catch-all-apply                    '(lambda ()                   	(vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")                   	(while (> (getvar "CMDACTIVE") 0) (command ""))                 	) ;_ end of lambda                  ) ;_ end of VL-CATCH-ALL-APPLY                ) ;_ end of VL-CATCH-ALL-ERROR-P             	(if isRus               	(princ "\n§¯§Ö §å§Õ§Ñ§Ý§à§ã§î §á§à§ã§ä§â§à§Ú§ä§î §Ü§à§ß§ä§å§â")               	(princ "\nIt was not possible to construct a contour")             	) ;_ end of if              ) ;_ end of if              (setq ec sc)              (while (setq ec (entnext ec))                (setq ret (cons (vlax-ename->vla-object ec) ret))                )                (setq ret (vl-remove pl ret))              (mapcar '(lambda (x) (vla-erase x) (vlax-release-object x))                      (list pl tmp_blk)              ) ;_ end of mapcar              (setq pl nil                    tmp_blk nil              ) ;_ end of setq              (setq                ret (mapcar '(lambda (x / mipt)                           	(vla-getboundingbox x 'MiPt nil)                                (setq MiPt (vlax-safearray->list MiPt))                           	(list MiPt x)                         	) ;_ end of lambda                            ret                    ) ;_ end of mapcar              ) ;_ end of setq              (setq ret (vl-sort ret                             	'(lambda (e1 e2)                                    (< (distance MinPt (car e1))                                   	(distance MinPt (car e2))                                    ) ;_ end of <                                  ) ;_ end of lambda                        ) ;_ end of vl-sort              ) ;_ end of setq              (setq pl  (nth 1 ret)                    ret (vl-remove pl ret)              ) ;_ end of setq              (mapcar 'vla-erase (mapcar 'cadr ret))              (mapcar '(lambda (x) (vla-put-visible x :vlax-true))                      hiden              ) ;_ end of mapcar              (foreach x loc (vla-put-lock x :vlax-true))              (if pl                (progn                  (initget "Yes No")                  (if                    (= (getkword (if isRus                               	"\n§µ§Õ§Ñ§Ý§ñ§ä§î §à§Ò§ì§Ö§Ü§ä§í? [Yes/No]  : "                               	"\nDelete objects? [Yes/No]  : "                             	) ;_ end of if                   	) ;_ end of getkword                   	"Yes"                    ) ;_ end of =                 	(mapcar '(lambda (x)                                (if (vlax-write-enabled-p x)                                  (vla-erase x)                                ) ;_ end of if                              ) ;_ end of lambda                         	obj                 	) ;_ end of mapcar                  ) ;_ end of if                ) ;_ end of progn                (if isRus                  (princ "\n§¯§Ö §å§Õ§Ñ§Ý§à§ã§î §á§à§ã§ä§â§à§Ú§ä§î §Ü§à§ß§ä§å§â")                  (princ "\nIt was not possible to construct a contour")                ) ;_ end of if              ) ;_ end of if            ) ;_ end of progn          ) ;_ end of if        ) ;_ end of progn      ) ;_ end of if      (vl-catch-all-apply        '(lambda ()       	(mapcar 'vlax-release-object               	(list unnamed_block tmp_blk csp blks lays)       	) ;_ end of mapcar     	) ;_ end of lambda      ) ;_ end of VL-CATCH-ALL-APPLY    ) ;_ end of progn  ) ;_if not  (foreach x loc (vla-put-lock x :vlax-true))  (setvar "OSMODE" osm)  (vla-endundomark adoc)  (vlax-release-object adoc)  (command ".area" "o" "L")(setq dt (getvar "area"))(command ".erase" L "") (writeres dt)  (princ)) ;_ end of defun;;; ========== HELPER FUNCTION ==========================================(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))  ) ;_ end of setq  (if (and (> (car pt) (car Lc))       	(< (car pt) (car Uc))       	(> (cadr pt) (cadr Lc))       	(< (cadr pt) (cadr Uc))      ) ;_ end of and    t    nil  ) ;_ end of if) ;_ end of defun(defun DTR (a) (* pi (/ a 180.0)))(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)          ) ;_ end of mapcar        ) ;_ end of mapcar  ) ;_setq  (list (mapcar '(lambda (x) (apply 'min x)) tmp)        (mapcar '(lambda (x) (apply 'max x)) tmp)  ) ;_ end of list) ;_defun(defun lib:Zoom2Lst (vlist / bl tr Lst OS)  (setq Lst (lib:pt_extents vlist)        bl  (car Lst)        tr  (cadr Lst)  ) ;_ end of setq  (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"       	) ;_ end of command       	(setvar "OSMODE" OS)       	t    ) ;_ end of progn    NIL  ) ;_ end of if) ;_ end of defun(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))(defun WriteRes(kq / OK e data)(setq OK nil)(while (not OK)(setq e (car (entsel "\tChon text ghi ket qua:")))(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text")))(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))(princ))

 

 

Vẫn không tính được hình này bác ạ

[bach1212 4]

 

Mình thấy vệc này tạm thời làm thủ công + lisp đơn giản không hề chậm lắm đâu, và mọi người sẽ hiện thực hóa nó.Ta sẽ không dùng lệnh aa để đo diện tích,vì chưa có đối tượng bao,hoặc phải kích điểm rất lâu,mà dùng mắt thường để tạo ra đường biên đa giác bao ngoài trước.

1.Như bạn nói, đường biên chỉ bao gồm 2 layer, vậy trước tiên bạn layiso 2 layer này trước đã nhé.

2.Sau đó dùng lisp nối các line bao ngoài thành 1 pline kín

3.Lấy diện tích đa giác bao ngoài này bằng các lisp tính diện tích có sẵn trên diễn đàn

Các thao tác để tạo pline bao ngoài có thể gói gọn bằng lisp này, của 1 Pro người nga do 1 pro người Việt (^^) giới thiệu.Lệnh Eco.Sau khi có em bao ngoài rồi thì việc còn lại k có j phứcc tạp cả ^^

 

;;;; External contour of objects(defun C:ECO (/       *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     iNSpT             )  (defun *error* (msg)    (princ 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)        ) ;_ end of and      (vla-erase tmp_blk)    ) ;_ end of if    (if osm      (setvar "OSMODE" osm)    ) ;_ end of if    (foreach x loc (vla-put-lock x :vlax-true))  ) ;_ end of defun  (vl-load-com)  (setvar "CMDECHO" 0)  (setq osm (getvar "OSMODE"))  (if (zerop (getvar "WORLDUCS"))    (progn (vl-cmdf "_.UCS" "") (vl-cmdf "_.Plan" ""))  ) ;_ end of if  (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)  ) ;_ end of setq  (vla-startundomark adoc)  (if isRus    (princ "\n§£§í§Ò§Ö§â§Ú§ä§Ö §à§Ò§ì§Ö§Ü§ä§í §Õ§Ý§ñ §á§à§ã§ä§â§à§Ö§ß§Ú§ñ §Ü§à§ß§ä§å§â§Ñ")    (princ "\nSelect objects for making a contour")  ) ;_ end of if  (vlax-for lay lays    (if (= (vla-get-lock lay) :vlax-true)      (progn (vla-put-lock lay :vlax-false)             (setq loc (cons lay loc))      ) ;_ end of progn    ) ;_ end of if  ) ;_ end of vlax-for  (if (setq sel (ssget))    (progn      (setq sel (ssnamex sel))      (setq iNSpT '(0 0 0))      (setq sel (mapcar 'vlax-ename->vla-object                        (vl-remove-if 'listp (mapcar 'cadr sel))                ) ;_ end of mapcar      ) ;_ end of setq      (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel))))      (setq unnamed_block             (vla-add (vla-get-blocks adoc)                      (vlax-3d-point inspt)                      "*U"             ) ;_ end of vla-add      ) ;_ end of setq      (foreach x sel        (setq oname (strcase (vla-get-objectname x)))        (cond	  ((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION" "ACDBMTEXT" "ACDBTEXT"  )  ) ;_ end of member               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)               ) ;_ end of vla-InsertBlock               (setq blk (cons x blk))              )              (t (setq obj (cons x obj)))        ) ;_ end of cond      ) ;_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))        ) ;_ end of progn      ) ;_ end of if      (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)))                     ) ;_ end of vlax-make-safearray                     obj                   ) ;_ end of vlax-safearray-fill                 ) ;_ end of vlax-make-variant                 unnamed_block               ) ;_ end of vla-copyobjects        ) ;_ end of progn      ) ;_ end of if      (setq obj (append obj blk))      (if obj        (progn          (setq tmp_blk (vla-insertblock                          csp                          (vlax-3d-point inspt)                          (vla-get-name unnamed_block)                          1.0                          1.0                          1.0                          0.0                        ) ;_ end of vla-insertblock          ) ;_ end of setq          (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)))                      ) ;_ end of max                DS    (* 0.2 DS)                  ;1/5                DS    (max DS 10)                MinPt (mapcar '- MinPt (list DS DS))                MaxPt (mapcar '+ MaxPt (list DS DS))          ) ;_ end of setq          (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))                                  ) ;_ end of vl-remove-if                          ) ;_ end of mapcar                    hiden (vl-remove tmp_blk hiden)              ) ;_ end of setq              (mapcar '(lambda (x) (vla-put-visible x :vlax-false))                      hiden              ) ;_ end of mapcar              (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 (entlast))              (if                (vl-catch-all-error-p                  (vl-catch-all-apply                    '(lambda ()                       (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")                       (while (> (getvar "CMDACTIVE") 0) (command ""))                     ) ;_ end of lambda                  ) ;_ end of VL-CATCH-ALL-APPLY                ) ;_ end of VL-CATCH-ALL-ERROR-P                 (if isRus                   (princ "\n§¯§Ö §å§Õ§Ñ§Ý§à§ã§î §á§à§ã§ä§â§à§Ú§ä§î §Ü§à§ß§ä§å§â")                   (princ "\nIt was not possible to construct a contour")                 ) ;_ end of if              ) ;_ end of if              (setq ec sc)              (while (setq ec (entnext ec))                (setq ret (cons (vlax-ename->vla-object ec) ret))                )                (setq ret (vl-remove pl ret))              (mapcar '(lambda (x) (vla-erase x) (vlax-release-object x))                      (list pl tmp_blk)              ) ;_ end of mapcar              (setq pl nil                    tmp_blk nil              ) ;_ end of setq              (setq                ret (mapcar '(lambda (x / mipt)                               (vla-getboundingbox x 'MiPt nil)                                (setq MiPt (vlax-safearray->list MiPt))                               (list MiPt x)                             ) ;_ end of lambda                            ret                    ) ;_ end of mapcar              ) ;_ end of setq              (setq ret (vl-sort ret                                 '(lambda (e1 e2)                                    (< (distance MinPt (car e1))                                       (distance MinPt (car e2))                                    ) ;_ end of <                                  ) ;_ end of lambda                        ) ;_ end of vl-sort              ) ;_ end of setq              (setq pl  (nth 1 ret)                    ret (vl-remove pl ret)              ) ;_ end of setq              (mapcar 'vla-erase (mapcar 'cadr ret))              (mapcar '(lambda (x) (vla-put-visible x :vlax-true))                      hiden              ) ;_ end of mapcar              (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> : "                                 ) ;_ end of if                       ) ;_ end of getkword                       "Yes"                    ) ;_ end of =                     (mapcar '(lambda (x)                                (if (vlax-write-enabled-p x)                                  (vla-erase x)                                ) ;_ end of if                              ) ;_ end of lambda                             obj                     ) ;_ end of mapcar                  ) ;_ end of if                ) ;_ end of progn                (if isRus                  (princ "\n§¯§Ö §å§Õ§Ñ§Ý§à§ã§î §á§à§ã§ä§â§à§Ú§ä§î §Ü§à§ß§ä§å§â")                  (princ "\nIt was not possible to construct a contour")                ) ;_ end of if              ) ;_ end of if            ) ;_ end of progn          ) ;_ end of if        ) ;_ end of progn      ) ;_ end of if      (vl-catch-all-apply        '(lambda ()           (mapcar 'vlax-release-object                   (list unnamed_block tmp_blk csp blks lays)           ) ;_ end of mapcar         ) ;_ end of lambda      ) ;_ end of VL-CATCH-ALL-APPLY    ) ;_ end of progn  ) ;_if not  (foreach x loc (vla-put-lock x :vlax-true))  (setvar "OSMODE" osm)  (vla-endundomark adoc)  (vlax-release-object adoc)  (command ".area" "o" "L")(setq dt (getvar "area"))(command ".erase" L "") (writeres dt)  (princ)) ;_ end of defun;;; ========== HELPER FUNCTION ==========================================(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))  ) ;_ end of setq  (if (and (> (car pt) (car Lc))           (< (car pt) (car Uc))           (> (cadr pt) (cadr Lc))           (< (cadr pt) (cadr Uc))      ) ;_ end of and    t    nil  ) ;_ end of if) ;_ end of defun(defun DTR (a) (* pi (/ a 180.0)))(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)          ) ;_ end of mapcar        ) ;_ end of mapcar  ) ;_setq  (list (mapcar '(lambda (x) (apply 'min x)) tmp)        (mapcar '(lambda (x) (apply 'max x)) tmp)  ) ;_ end of list) ;_defun(defun lib:Zoom2Lst (vlist / bl tr Lst OS)  (setq Lst (lib:pt_extents vlist)        bl  (car Lst)        tr  (cadr Lst)  ) ;_ end of setq  (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"           ) ;_ end of command           (setvar "OSMODE" OS)           t    ) ;_ end of progn    NIL  ) ;_ end of if) ;_ end of defun(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))(defun WriteRes(kq / OK e data)(setq OK nil)(while (not OK)(setq e (car (entsel "\tChon text ghi ket qua:")))(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text")))(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))(princ))

 

 

Nhờ bạn ketxu cải biến thêm lisp eco để nó tính diện tích nhiều đa giác kín 1 lúc? 

HIện tại mình thấy khi quét nhiều đa giác kín thì nó chỉ tính diện tích của 1 đa giác.