Nhờ các bạn chỉnh lisp này giúp !

[nguyenvinh5779 7]

chào các bạn ! mình có tìm duoc lisp đo diện tích nhưng hơi bất  tiện,

Nhờ các bạn biết về lisp chỉnh giúp ghi ra m2 ( chứ khong ghi ra mm)

Xin cám ơn các bạn đ ạ giúp !

area.LSP

[OngNguyenVanHan 1]

gõ lệnh Un rổi đổi đơn vị ở đấy chứ lisp này ko có chỗ đổi

[huunhantvxdts 195]

17 giờ trước, nguyenvinh5779 đã nói:

chào các bạn ! mình có tìm duoc lisp đo diện tích nhưng hơi bất  tiện,

Nhờ các bạn biết về lisp chỉnh giúp ghi ra m2 ( chứ khong ghi ra mm)

Xin cám ơn các bạn đ ạ giúp !

area.LSP

Gửi bạn nhé 

(defun c:SubArea ( / txtht ar e pl pls i str)
(vl-load-com)      
(setq txtht (cond ((getdist (strcat
               "\nEnter Text Height [Enter to accept: <"
               (rtos (setq txtht (getvar 'textsize)) 2 2)
               ">: ")))(txtht)
         ))
(setvar 'textsize txtht )
(princ "\nSelect Polyline for Area:")
(cond ((and (setq ar 0
                 pl (ssget "_:S:E" '((0 . "*POLYLINE"))))
           (progn (redraw (ssname pl 0) 3)
                  (princ "\t<<<< Select Objects to Subtract >>>>")
                  (setq plS (ssget)))
           (repeat (setq i (sslength pls))
                 (if (vlax-property-available-p
                           (setq e    (vlax-ename->vla-object
                                            (ssname
                                                  pls
                                                  (setq i    (1- i)))))
                           'Area)
                       (setq ar (+ (vla-get-area e) ar))
                       T
                       )
                 )
           (setq pt (getpoint "\nPick point for Text:"))
           (entmakex
                 (list (cons 0 "MTEXT")
                       (cons 100 "AcDbEntity")
                       (cons 100 "AcDbMText")
                       (cons 10 pt)
                       (cons 1
  (setq str  (rtos (/ (- (vla-get-area
   (vlax-ename->vla-object (ssname pl 0))) ar) 1000000)
                                              2 2)
                                   )))
                 )
           (princ (strcat "\nTotal Area " str))
           (redraw (ssname pl 0) 4)
           )
      )
     )
     (princ)
     )