NguyenNgocSon 43 Báo cáo bài đăng Đã đăng Tháng 1 15, 2011 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 ! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
linhoreka 47 Báo cáo bài đăng Đã đăng Tháng 1 15, 2011 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 ! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
ketxu 2.984 Báo cáo bài đăng Đã đăng Tháng 1 15, 2011 Bạn thể hiện bằng bản vẽ ý tưởng của bạn đi. 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
NguyenNgocSon 43 Báo cáo bài đăng Đã đăng Tháng 1 15, 2011 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 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
ketxu 2.984 Báo cáo bài đăng Đã đăng Tháng 1 15, 2011 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) ) 2 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
NguyenNgocSon 43 Báo cáo bài đăng Đã đăng Tháng 1 15, 2011 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ó ! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
ketxu 2.984 Báo cáo bài đăng Đã đăng Tháng 1 15, 2011 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 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
phamngoctukts 714 Báo cáo bài đăng Đã đăng Tháng 1 15, 2011 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???? 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
ketxu 2.984 Báo cáo bài đăng Đã đăng Tháng 1 15, 2011 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 ạ 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
NguyenNgocSon 43 Báo cáo bài đăng Đã đăng Tháng 1 15, 2011 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 ! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
trieubb 5 Báo cáo bài đăng Đã đăng Tháng 9 20, 2012 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 ạ Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
bach1212 4 Báo cáo bài đăng Đã đăng Tháng 1 2, 2015 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. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác