;; ZONETAG tags pline area
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/making-a-tool-to-report-polyline-areas-area-variable-gets-stuck/m-p/12087423#M451169
(defun C:ZONETAG 
;; Localize varables
 (/ AreaString AttDiaOG AttReqOG CmdEcho dragmode dynmode ep en ent 
    Get-ObjectIDx64 ip MenuEcho MkDyBlAt newlay oldlay orthomode osmode
    stropt TagBlock ZoneName
 )
 ;;;---load vl functions
 (if(not(car (atoms-family 1 '("vl-load-com"))))(vl-load-com))
; Get-ObjectIDx64 given object return object ID 
 (defun Get-ObjectIDx64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
    (if (> (vl-string-search "x64" (getvar "platform")) 0)
      (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
      (rtos (vla-get-objectid obj) 2 0)
    )
  )
 ) ; defun Get-ObjectIDx64 
; MkDyBlAt
; Entity make Annotative Block with objects & Attribute Definitions with Annotative Text Style
; modifed from Lee Mac's c:crb
; https://www.cadtutor.net/forum/topic/33348-how-to-create-an-annotative-block-by-entmake-function/?do=findComment&comment=270778
(defun MkDyBlAt ( )

   ;;===============================================;;
   ;; Example by Lee Mac 2011  -  www.lee-mac.com   ;;
   ;;===============================================;;
   
   (if (not (tblsearch "BLOCK" "ZONE AREA TAG"))
       (progn
           (if (not (tblsearch "STYLE" "AN1-8"))
    ; make Annotative Text Style
               (entmake
                   (list
                       (cons 0 "STYLE")
                       (cons 100 "AcDbSymbolTableRecord")
                       (cons 100 "AcDbTextStyleTableRecord")
                       (cons 2 "AN1-8") ; style name
                       (cons 70 0) ; standard flag values
                       (cons 40 0.125) ; 1:1 height for annotative text
   '(41 . 1.0) ; width factor
   '(50 . 0.0) ; oblique angle
   '(71 . 0) ; text generation flag
   '(42 . 0.125) ; last height used
                       (cons 3 "ARIALN.ttf") ; primary font
    '(4 . "") ; bigfont
    '(-3
     ("AcadAnnotative"
       (1000 . "AnnotativeData")
       (1002 . "{")
       (1070 . 1) ; 1=1
       (1070 . 1)
       (1002 . "}")
     )
   )
                     
                   )
               )
           )
   ; make Annotative Block
           (entmake
               (list
                   (cons 0 "BLOCK")
                   (cons 8 "0") ; layer
                   (cons 370 0)
                   (cons 2 "ZONE AREA TAG") ; block name
                   (cons 70 2) ; block type flag 2 = with attributes
                   (list 10 0.0 0.0 0.0) ; block insertion
               )
           )
   ; make Line Objects inside Block
           (entmake
               (list
                   (cons 0 "LINE")
                   (cons 8 "0") ; layer
                   (cons 370 0) ; lweight
                   (list 10 -0.302539 0.280586 0.0) ; start point
                   (list 11 0.302539 0.280586 0.0) ; end point
               )
           )
           (entmake
               (list
                   (cons 0 "LINE")
                   (cons 8 "0") ; layer
                   (cons 370 0) ; lweight
                   (list 10 0.302539 0.0 0.0) ; start point
                   (list 11 -0.302539 0.0 0.0) ; end point
               )
           )
   ; make Arc Objects inside Block
           (entmake
               (list
                   (cons 0 "ARC")
                   (cons 8 "0") ; layer
                   (cons 370 0) ; lweight
                   (list 10 -0.113648 0.140293 0.0) ; center
                   (cons 40 0.235291) ; radius
                   (cons 50 2.50277) ; start angle
                   (cons 51 3.78042) ; end angle
               )
           )
           (entmake
               (list
                   (cons 0 "ARC")
                   (cons 8 "0") ; layer
                   (cons 370 0) ; lweight
                   (list 10 0.113648 0.140293 0.0) ; center
                   (cons 40 0.235291) ; radius
                   (cons 50 5.64436) ; start angle
                   (cons 51 0.638825) ; end angle
               )
           )
           (entmake
               (list
                   (cons 0 "ATTDEF")
                   (cons 8 "0") ; layer
                   (cons 370 0) ; lweight
                   (cons 7 "AN1-8") ; style
                   (list 10 -0.195003 -0.171509 0.0) ; start point
                   (list 11 0.0 -0.109009 0.0)
                   (cons 40 0.125) ; height
                   (cons 1 "### SF") ; default value
                   (cons 3 "AREA") ; prompt
                   (cons 2 "AREA") ; tag
                   (cons 41 1) ; relative x-scale factor
                   (cons 50 0) ; rotation angle
                   (cons 51 0) ; oblique angle
                   (cons 70 0) ; flag is set for 1=invisible, 2=constant, 4=verified, 8=preset
                   (cons 71 0) ; 2=backward 4=upside down
                   (cons 72 1) ; 1=center horizontal justification
                   (cons 73 0) ; vertical justification
                   (cons 74 2) ; vertical justification
               )
           )
           (entmake
               (list
                   (cons 0 "ATTDEF")
                   (cons 8 "0") ; layer
                   (cons 370 0) ; lweight
                   (cons 7 "AN1-8") ; style
                   (list 10 -0.198883 0.0777929 0.0) ; start point
                   (list 11 -5.68434e-14 0.140293 0.0)
                   (cons 40 0.125) ; height
                   (cons 1 "ZONE") ; default value
                   (cons 3 "ZONE") ; prompt
                   (cons 2 "ZONE") ; tag
                   (cons 41 1) ; relative x-scale factor
                   (cons 50 0) ; rotation angle
                   (cons 51 0) ; oblique angle
                   (cons 70 0) ; flag is set for 1=invisible, 2=constant, 4=verified, 8=preset
                   (cons 71 0) ; 2=backward 4=upside down
                   (cons 72 1) ; 1=center horizontal justification
                   (cons 73 0) ; vertical justification
                   (cons 74 2) ; vertical justification
               )
           )
           (entmake
               (list
                   (cons 0 "ENDBLK")
                   (cons 8 "0")
               )
           )
           (
               (lambda ( lst )
                   (regapp "ACAD")
                   (regapp "AcadAnnotative")
                   (entmod
                       (append (subst (cons 70 1) (assoc 70 lst) lst)
                           (list
                              (list -3
                                  (list "ACAD"
                                      (cons 1000 "DesignCenter Data")
                                      (cons 1002 "{")
                                      (cons 1070 1)
                                      (cons 1070 1)
                                      (cons 1002 "}")
                                  )
                                  (list "AcadAnnotative"
                                      (cons 1000 "AnnotativeData")
                                      (cons 1002 "{")
                                      (cons 1070 1)
                                      (cons 1070 1)
                                      (cons 1002 "}")
                                  )
                              )
                          )
                       )
                   )
               )
               (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" "ZONE AREA TAG")))))
           )
       (princ"\nSuccesfully Created Annotative Block, Text Style & Attribute.")
       ) ; progn
      (princ"\nAnnotative Block & Attribute Already Exists.")
   )
   (princ)
) ; defun
;;	CLICK ON CLOSED POLYLINE
  (while (not ep)
   (princ"\nPick a Closed Polyline...")
   (setq ep (ssget "_+.:E:S" '((0 . "POLYLINE,LWPOLYLINE") (-4 . "&") (70 . 1)))) ;; restrict selection
  )
  (if ep
   (progn
;; SET ERROR TRAP
;; VARIABLES
    (setq AttDiaOG (getvar "ATTDIA"))
    (setq AttReqOG (getvar "ATTREQ"))
    (setq CmdEcho (getvar "CMDECHO"))
    (setq MenuEcho (getvar "MENUECHO"))
    (setq dragmode (getvar "dragmode"))
    (setq osmode (getvar "OSMODE"))
    (setq orthomode (getvar "ORTHOMODE"))
    (setvar "CMDECHO" 0)
    (setvar "MENUECHO" 0)
    (setvar "ATTDIA" 0)
    (setvar "ATTREQ" 1)
    (setvar "OSMODE" 0)
    (setvar "ORTHOMODE" 0)
    (setvar "dragmode" 2)
;; get Entity name & Entity data
    (setq ent (entget (setq en (ssname ep 0))))   

;; GET TAG TO PLACE SOMEWHERE
   (setq ZoneName (getstring T "\nEnter Zone Number: "))

;; (princ "\nTotal Area = ")
;; (command "._Area" "_O" en)
;; (setq AreaString (getvar "area"))

;; Select area Unit Type format
   ; dynmode needs to be 1 or 3 to display cursor popup
   (if(<= (rem (getvar"dynmode") 2) 0) ; if even # chks negative value as well
     (progn
      (setq dynmode (getvar"dynmode")) ; save current setting
      (setvar "dynmode" 1) ; enable dynmode
     )
   ) ; if
  (if(= (getvar"lunits") 4) ; if architectural units assume 1 unit = 1 inch otherwise metric assume 1 unit = 1 mm
   (progn
   ; set as global variable
    (or **stroptimp** (setq **stroptimp** "2-Sq-Feet"))
    (initget (setq stropt "1-Sq-Inch 2-Sq-Feet")) 
    (setq **stroptimp**    ; set new default
     (cond  ; display in popup # selection option as cursor hovers over graphics area & highlite # selection options at command line
      ((getkword (strcat "\nPick Unit Format: [" (vl-string-translate " " "/" stropt) "] <" **stroptimp** ">: "))) 
      (**stroptimp**)
     ) ; cond
    ) ; setq    
;;	Convert Area to Square Feet vs Square Inch 
;;  Use Fields to link pline area
       (if (= **stroptimp** "2-Sq-Feet")
;        (setq AreaString (strcat (rtos (/ AreaString (* 12 12)) 2 2) " FT" (chr 178)))        ;;	Limit significant digits to max. 2
        (setq AreaString
         (strcat 
          "%<\\AcObjProp.16.2 Object (%<\\_ObjId " 
          (Get-ObjectIDx64 (vlax-ename->vla-object en)) 
          ">%).Area \\f \"%lu2%pr2%ps[, Ft" 
          (chr 178) 
          "]%ct8[0.0069444444444444]%th44\">%"
         )
        )
;        (setq AreaString (strcat (rtos AreaString 2 2) " Inch" (chr 178)))  ;;	Limit significant digits to max. 2
        (setq AreaString
         (strcat 
          "%<\\AcObjProp.16.2 Object (%<\\_ObjId " 
          (Get-ObjectIDx64 (vlax-ename->vla-object en)) 
          ">%).Area \\f \"%lu2%pr2%ps[, Inch" 
          (chr 178) 
          "]%th44\">%"
         )
        )

       )
     ) ; progn
   (progn
   ; set as global variable
    (or **stroptmet** (setq **stroptmet** "2-Sq-Meter"))
    (initget (setq stropt "1-Sq-Millimeter 2-Sq-Meter")) 
    (setq **stroptmet**    ; set new default
     (cond  ; display in popup # selection option as cursor hovers over graphics area & highlite # selection options at command line
      ((getkword (strcat "\nPick Unit Format: [" (vl-string-translate " " "/" stropt) "] <" **stroptmet** ">: "))) 
      (**stroptmet**)
     ) ; cond
    ) ; setq    
;;	Convert Area to Square Meter vs Square MM
;;  Use Fields to link pline area
       (if (= **stroptmet** "2-Sq-Meter")
;        (setq AreaString (strcat (rtos (/ AreaString (* 1000 1000)) 2 2) " m" (chr 178)))        ;; Limit significant digits to max. 2
        (setq AreaString
         (strcat 
          "%<\\AcObjProp.16.2 Object (%<\\_ObjId " 
          (Get-ObjectIDx64 (vlax-ename->vla-object en)) 
          ">%).Area \\f \"%lu2%pr2%ps[, m" 
          (chr 178) 
          "]%ct8[1.000000000000000E-006]%th44\">%"
         )
        )
;        (setq AreaString (strcat (rtos AreaString 2 2) " mm" (chr 178)))   ;; Limit significant digits to max. 2
        (setq AreaString
         (strcat 
          "%<\\AcObjProp.16.2 Object (%<\\_ObjId " 
          (Get-ObjectIDx64 (vlax-ename->vla-object en)) 
          ">%).Area \\f \"%lu2%pr2%ps[, mm" 
          (chr 178) 
          "]%th44\">%"
         )
        )
       ) ; if
     ) ; progn
  ) ; if
  (if dynmode (setvar "dynmode" dynmode)) ; restore original dynmode setting

;;	INSERTION POINT
    (command "_.Zoom" "_O" en "") ; need to zoom to show entire pline in graphics area to successfully get geocenter
    (setq ip (osnap (vlax-curve-getStartPoint en) "_gcen")) ;  use built-in geocenter osnap to get centerpoint of pline
    (command "_.Zoom" "_P") ; zoom back to original display location
;   (setq ip (getpoint "\nPlace the Zone Tag: "))
    (if(not ip)(setq ip (getvar"viewctr"))) ; if can't locate geocenter then use center of screen
;;  Check if Zone Tag Block is already inserted. If not, then entity make it in current drawing
    (MkDyBlAt)
;;	INSERTS ZONE TAG BLOCK
    (command "_.Insert" "ZONE AREA TAG" ip 1 1 0 AreaString ZoneName)			;;  Inserts a fitting at the specified scale and location.
;;	ASSIGNS THE PROPER LAYER TO THE FITTING.
    (setq TagBlock (entget (entlast)))						;;  Grabs the block that was just inserted
    (setq newlay (assoc 8 ent))								;;  Layer of the line the user first clicked on.
    (setq oldlay (assoc 8 tagblock))						;;  Finds the layer that the block was placed on.
    (setq tagblock (subst newlay oldlay tagblock))			;;  Display the entity list with the correct layer name string.
    (entmod tagblock)										;;  Writes the corrected layer name string to the block.
;;  force fieldeval to be 31
    (if(/= 31 (getvar"fieldeval"))(setvar"fieldeval"31))
;; Reposition inserted block 
    (princ "\nPlace the Zone Tag: ")
    (command "_.Move" "_L" "" ip pause)
;; DISARM ERROR TRAP
;; RESTORE SYSTEM VARIABLES
    (setvar "ATTDIA" AttDiaOG)
    (setvar "ATTREQ" AttReqOG)
    (setvar "ORTHOMODE" orthomode)
    (setvar "OSMODE" osmode)
    (setvar "dragmode" dragmode)
    (setvar "CMDECHO" CmdEcho)
    (setvar "MENUECHO" MenuEcho)
   ) ; progn
  ) ; if
  (princ) ; clean exit
) ; defun