Nhờ chỉnh lisp xuất diện tích

[vanhuyou 26]

Em chào các bác, em có tìm được 1 lisp xuất diện tích ra text nhưng đơn vị là mm2. Nhờ các bác giúp em chỉnh lại lisp xuất ra đơn vị là m2, và số lẻ sau dấu thập phân là 3.

Cám ơn các bác.

Insert area multi closed pline-AREARON.lsp

[thanhduan2407 277]

Nó đang là m2 rồi. Nó cho nhập cả sau dấu phẩy bao nhiêu số mà.
Bạn dùng lisp này tính cho nhanh.
 

(defun C:TDTV (/ DTICH DTICH1 LSTPLINE SSPLINE TAMVUNG)
;;;TINH DIEN TICH VUNG
  (vl-load-com)
  (setq	Caochu (LM:GetXWithDefault_New
		 getdist "\nNh\U+1EADp chi\U+1EC1u cao ch\U+1EEF: " '*Caochu* 0.25 nil nil)
  )
  (setq	Sole (LM:GetXWithDefault_New
		 getint "\nNh\U+1EADp s\U+1ED1 th\U+1EADp ph\U+00E2n sau d\U+1EA5u ph\U+1EA9y: " '*Sole* 3 nil nil)
  )
  (setq	Donvi (LM:GetXWithDefault_New
		getkword "\nCh\U+1ECDn \U+0111\U+01A1n v\U+1ECB hi\U+1EC3n th\U+1ECB [Hecta / Meter]" '*Donvi* "H" '("H M") nil)
  )
  (setq ssPline (ssget '((0 . "*POLYLINE"))))
  (if ssPline
    (progn
      (setq LstPLine (acet-ss-to-list ssPline))
      (foreach ePl LstPLine
	(if (or	(equal (vlax-curve-getStartPoint ePl) (vlax-curve-getEndPoint ePl) 1e-8)
		(equal (vlax-curve-isClosed (vlax-ename->vla-object ePl)) T)
	    )
	  (progn
	    (setq Dtich (vlax-get-property (vlax-ename->vla-object ePl) 'Area))
	    (cond
	      ((= Donvi "H")
	       (setq Dtich1 (/ Dtich 10000.0))
	      )
	      ((= Donvi "M")
	       (setq Dtich1 Dtich)
	      )
	    )
	    (setq Tamvung (_cen ePl))
	    (MakeText Tamvung
		      (strcat (rtos Dtich1 2 Sole))
		      Caochu
		      0
		      "MC"
		      nil
		      nil
		      nil
	    )
	  )
	)
      )
    )
  )
  (princ)
)
(defun _cen (v / p1 p2 p u)
  (vla-getboundingbox (setq v (vlax-ename->vla-object v)) 'p1 'p2)
  (setq	p (mapcar '*
		  (mapcar '+
			  (vlax-safearray->list p1)
			  (vlax-safearray->list p2)
		  )
		  '(0.5 0.5 0.5)
	  )
  )
  (setq	u (entmakex (list '(0 . "LINE")
			  (cons 10 p)
			  (cons 11 (polar p (/ pi 2) 1))
		    )
	  )
  )
  (setq p (vlax-invoke v 'IntersectWith (vlax-ename->vla-object u) 2))
  (entdel u)
  (if (>= (length p) 4)
    (list (car p) (/ (+ (cadr p) (nth 4 p)) 2) (caddr p))
    p
  )
)
(defun MakeText	(point string Height Ang justify Layer Style Color / Lst) ; Ang: Radial
  (setq	Lst	(list '(0 . "TEXT")
		      (cons 10 point)
		      (cons 40 Height)
		      (cons 8
			    (if	Layer
			      Layer
			      (getvar "CLAYER")
			    )
		      )
		      (cons 1 string)
		      (if Ang
			(cons 50 Ang)
		      )
		      (cons 7
			    (if	Style
			      Style
			      (getvar "Textstyle")
			    )
		      )
		      (cons 62
			    (if	Color
			      Color
			      256
			    )
		      )
		)
	justify	(strcase justify)
  )
  (cond
    ((= justify "C")
     (setq Lst (append Lst (list (cons 72 1) (cons 11 point))))
    )
    ((= justify "L")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 73 0) (cons 10 point)))
     )
    )
    ((= justify "R")
     (setq Lst (append Lst (list (cons 72 2) (cons 11 point))))
    )
    ((= justify "M")
     (setq Lst (append Lst (list (cons 72 4) (cons 11 point))))
    )
    ((= justify "TL")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))
     )
    )
    ((= justify "TC")
     (setq
       Lst
	(append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))
     )
    )
    ((= justify "TR")
     (setq
       Lst
	(append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))
     )
    )
    ((= justify "ML")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))
     )
    )
    ((= justify "MC")
     (setq
       Lst
	(append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))
     )
    )
    ((= justify "MR")
     (setq
       Lst
	(append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))
     )
    )
    ((= justify "BL")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))
     )
    )
    ((= justify "BC")
     (setq
       Lst
	(append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))
     )
    )
    ((= justify "BR")
     (setq
       Lst
	(append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))
     )
    )
  )
  (entmakex Lst)
)
(defun LM:GetXWithDefault_New (_function _prompt _symbol _default _initget _args / _toString)
  (vl-load-com)
  ;; © Lee Mac 2010

  (setq	_toString
	 (lambda (x)
	   (cond
	     ((eq getangle _function) (angtos x))
	     ((eq 'REAL (type x)) (rtos x))
	     ((eq 'INT (type x)) (itoa x))
	     ((vl-princ-to-string x))
	   )
	 )
  )

  (if _initget
    (apply 'initget _initget)
  )

  (set _symbol
       (
	(lambda	(input)
	  (if (or (not input) (eq "" input))
	    (eval _symbol)
	    input
	  )
	)
	 (apply	'_function
		(append	_args
			(list
			  (strcat _prompt
				  "<"
				  (_toString
				    (set _symbol
					 (cond
					   ((eval _symbol))
					   (_default)
					 )
				    )
				  )
				  "> : "
			  )
			)
		)
	 )
       )
  )
)