如果你坚持，看：
- (defun C:AreaPer ( / ar coHt coDec coTP eN hT2 i lStrA lStrP lTa p pr pMin pMax osm sel sL strA strP tD ti tO uL ) ; dec hT
- (princ "\n C:AreaPer : V : 17 . 04 . 2014 ;")
- (or (vl-Load-Com))
- (setVar "CmdEcho" 0)
- (setVar "OrthoMode" 0)
- (princ "\n Select Objects : [ Arc, Circle, LwPolyline, PolyLine, ] ;")
- (if (setq sel (ssGet '((0 . "Arc,Circle,LwPolyline,PolyLine,SplineX")) ) )
- (progn
- (if (not (numberP hT)) (setq hT 1.)) ; Real
- (if (not (numberP dec)) (setq dec 3)) ; Integer
-
- (setq coHt (getString (strcat "\n Font Height : < Enter = " (RtoS hT 2 3) " > : "))
- coDec (getString (strcat "\n Precission : < Enter = " (ItoA dec) " > : "))
- coTP (getString (strcat "\n Text Position : Any = Center ; < Enter = Right > : "))
- osm (getVar "osMode") uL (getVar "insUnits")
- strA "Area" lStrA (cons 8 strA) strP "Perimeter" lStrP (cons 8 strP) i -1)
- (if (/= coHt "") (setq hT (AtoF coHt)) )
- (if (/= coDec "") (setq dec (fix (AtoF coDec))) )
- ; 0 = Unspecified (No units) , 1=Inches , 4=mm , 5= cm ; 6=m ; 7=km.
- (setq ti (car (_VL-Times)) hT2 (* hT 2.) ) ;_ end of setq
-
- (cond ((= uL 0) (setq sL 1.00 tO "Unitless"))
- ((= uL 1) (setq sL 2.54e-2 tO "Inch"))
- ((= uL 2) (setq sL 0.3048 tO "Feet"))
- ((= uL 3) (setq sL 1609.344 tO "Miles"))
- ((= uL 4) (setq sL 1e-3 tO "mm"))
- ((= uL 5) (setq sL 1e-2 tO "cm"))
- ((= uL 6) (setq sL 1.00 tO "m"))
- ((= uL 7) (setq sL 1e+3 tO "Km"))
- (T (setq sL 1.00 tO "Any"))
- ) ;_ end of c
- (alert (strCat "DWG Length Units is :\n\n " (ItoA uL) " = " tO " ;\n\n Factor = " (RtoS sL 2 9) " !"))
- (setVar "osMode" 0)
- (vl-cmdF "_.Layer" "n" "Area,Perimeter" "c" 1 "Area" "c" 5 "Perimeter" "")
- (command "_.Style" "Arial" "Arial" "0" "1" "0" "N" "N") ;_ end of c
- (acet-ui-Progress "Processing : " (ssLength sel))
- (repeat (ssLength sel)
- (setq i (1+ i) eN (vlax-eName->Vla-Object (ssName sel i)) )
- (if (vlax-Property-Available-P eN "Area")
- (progn
- (setq ar (* (vla-Get-Area eN) sL sL) tip (substr (vla-Get-ObjectName eN) 5)
- pr (* (cond ((vlax-Property-Available-P eN "Length") (vla-Get-Length eN))
- ((vlax-Property-Available-P eN "Circumference") (vla-Get-Circumference eN))
- ((vlax-Property-Available-P eN "ArcLength") (vla-Get-ArcLength eN))
- ;;; ((vlax-Property-Available-P eN "Perimeter") (vla-Get-Perimeter eN))
- (T 0)
- ) sL)
- ) ;
- (prinC (strCat "\n " (ItoA i) " : " tip " : Area = " (RtoS ar 2 dec) " m² ; Perimeter = " (RtoS pr 2 dec) " m ;"))
- (vla-GetBoundingBox eN 'pMin 'pMax)
- (setq pMin (vlax-SafeArray->List pMin) pMax (vlax-SafeArray->List pMax)
- lTa (cons 1 (strcat "A = " (RtoS ar 2 dec) " m²")) )
-
- (if (= coTP "")
- (setq tD (textBox (list lTa (cons 40 hT) '(50 . 0) '(7 . "Arial")) ) ; (caar td)
- p (list (- (car pMax) (caadr td)) (+ (cadr pMin) hT2)) )
- (setq p (mapcar '/ (mapcar '+ pMin pMax) '(2. 2. 2.)) )
- ) ; if
-
- (entMake (list '(0 . "Text") (cons 40 hT) '(50 . 0) lStrA '(7 . "Arial") '(72 . 4) '(10 0 0 0) lTa (cons 11 (mapcar '+ p (list 0 hT2 0))) ) )
- (entMake (list '(0 . "Text") (cons 40 hT) '(50 . 0) lStrp '(7 . "Arial") '(72 . 4) '(10 0 0 0) (cons 1 (strcat "P = " (RtoS pr 2 dec) " m")) (cons 11 p) ) )
-
- )) ; if
- (acet-ui-Progress -1)
- ) ; r
- (acet-ui-Progress)
-
- (setVar "osMode" osm)
- )) ; if
- ;;; (setVar "cLayer" "0")
- (princ (strCat "\n Objects : " (ItoA i) " ; Time : " (RtoS (/ (- (car (_VL-Times)) ti) 1000.) 2 2) " s ;"))
- (princ "\n C:AreaPer : END ;")
- (setVar "CmdEcho" 1)
- (princ)
- )
据我所知，您不知道AutoLisp。这将是很好的，你学习这种编程语言，很容易，非常有用。
使用AutoCAD时，始终需要程序来帮助您工作。
PS:
今天我去乡下度假至少一周，那里没有互联网。所以我们听到复活节假期后。 | 
置顶卡
