;;------------------------------------------------
;; Listing 1:  Entmake Tool-Kit Functions
;;------------------------------------------------
(defun TEXT_OUT (
      PT   ;;primary text point
      TXT  ;;string value to output
      )
   (entmake (list
      '(0 . "TEXT")
      (cons 10 PT)
      (cons 1 TXT)
      (cons 50 0.0)
      (cons 40 (getvar "TEXTSIZE"))
   ))
)
(defun INSERT_BLOCK (
    BN     ;;block name
    PT     ;;insert point
    LY     ;;insert layer
    RT     ;;block rotation
    SX SY  ;;scale X and Y
    ATF    ;;attribute follow flag
    )
   (entmake (list
     '(0 . "INSERT")
      (cons 8 LY)
      (cons 2 BN)
      (cons 10 PT)
      (cons 50 RT)
      (cons 41 SX)
      (cons 42 SY)
      (cons 66 (if ATF 1 0))
   ))
)
(defun Sequence_End ()
  (entmake '((0 . "SEQEND"))))

;;------------------------------------------------
;; Listing 2:  Another Entmake Tool-Kit Function
;;------------------------------------------------
(defun ATTRIBUTE (
     BN     ;;block name
     IP     ;;insertion point
     TAG    ;;tag value
     VALUE  ;;string for attribute
     /
     EL     ;;entity list
     EN     ;;entity name
     AEL    ;;attribute entity list
     )
   ;;First make sure block exists.
   (setq EL (tblsearch "BLOCK" BN))
   (if EL (progn
     ;;Get first entity in block definition.
     (setq EL (entget (cdr (assoc -2 EL))))
     ;;Loop through block definition
     (while EL
       ;;Looking for attribute definitions,
       (if (= (cdr (assoc 0 EL)) "ATTDEF")
         ;;with matching tag name
         (if (= (cdr (assoc 2 EL)) TAG)
            (setq AEL EL ;;save entity list
                  EL nil))) ;;loop break
       (if (and EL ;;keep looking?
                (setq EN ;;get next object
                   (entnext
                      (cdr (assoc -1 EL)))))
          (setq EL (entget EN))
          (setq EL nil) ;;end of block hit.
       )
     )
     (if AEL ;;Find the attribute definition?
       ;;Create the Attribute object
       (entmake (list
        '(0 . "ATTRIB")
         (assoc 8 AEL) ;layer
         (cons 2 TAG)  ;tag name
         (cons 10      ;base point
           (mapcar '+  ;determined by adding
              IP       ;insert point to 
              (cdr (assoc 10 AEL)))) ;attrib pt.
         (cons 1 VALUE) ;text value
         (assoc 70 AEL) ;generation flags
         (assoc 40 AEL) ;text height
         (assoc 50 AEL) ;rotation angle
       ))
     )
   )) ;;ends IF PROGN
)

;;------------------------------------------------
;; Listing 3:  Application Specific Entmake Function
;;------------------------------------------------
(defun DEF_CROSS_BLOCK ()
   (entmake
     '((0 . "BLOCK") (8 . "0") (70 . 2)
       (2 . "CROSSBLOCK") (10 0.0 0.0 0.0)))
   (entmake
     '((0 . "LINE") (8 . "0")
       (10 -0.1 0.0 0.0)
       (11 0.1 0.0 0.0)))
   (entmake
     '((0 . "LINE") (8 . "0")
       (10 0.0 -0.1 0.0)
       (11 0.0 0.1 0.0)))
   (entmake
     '((0 . "ATTDEF") (8 . "0")
      (10 0.1 0.1 0.0)
      (40 . 0.2) (50 . 0.0) (70 . 0)
      (1 . "ID") (2 . "ID") (3 . "ID")))
   (entmake '((0 . "ENDBLK") (8 . "0")))
)

;------------------------------------------------
; Listing 4: Mark the holes
;------------------------------------------------
(defun C:MARKHOLES ( /
     P_Numb ;;Current point number
     P_Inc  ;;Increment to use
     TxtSize ;Text size
     PT     ;;Input point
     )
  ;; Define the block if it does not exist.
  (if (null (tblsearch "BLOCK" "CROSSBLOCK"))
     (DEF_CROSS_BLOCK))
  ;; User input of sequence start.
  (setq P_Numb
     (getint "\nStarting sequence number <1>: "))
  (if (null P_Numb) (setq P_Numb 1))
  (setq P_Inc 1
        TxtSize (getvar "TEXTSIZE"))
  ;; Input loop for points or parameters
  (while (progn
            (initget 0 "Snaps Numb")
            (setq PT
              (getpoint
                "\nLocate a point/Snaps/Numb: "))
         )
     (cond
       ((listp PT) ;;Operator picked a point,
          ;;insert block with attribute
          (Insert_Block "CROSSBLOCK"
                        PT "HOLES" 0.0 1.0 1.0 'T)
          (Attribute  "CROSSBLOCK" PT
                      "ID" (itoa P_Numb))
          (Sequence_End)
          ;;increment sequence number
          (setq P_Numb (+ P_Numb P_Inc))
       )
       ((= PT "Numb") ;;New sequence number
          (setq TMP
             (getint
                (strcat "\nNext sequence number <"
                        (itoa P_Numb)
                        ">: ")))
          (if TMP (setq P_Numb TMP))
       )
       ((= PT "SNaps") ;;Change object snaps
          (command "_DDOSNAP"))
     )
   )
   ;;
   (princ)
)

;;-----------------------------------------------
;; Listing 5: Chart the holes
;;-----------------------------------------------
(defun C:CHARTHOLES ( /
    SS1   ;;Selection set of inserts
    CNT   ;;Counter for loop
    PT_ZERO ;;zero datum point
    PTS   ;;List of points and IDs
    PT    ;;point list
    EL    ;;Entity list
    ID    ;;Attribute text value
    CD    ;;Distance between columns in chart
    RD    ;;Distance between rows in chart
    PTI   ;;ID string sorted list
    IX    ;;ID string inside FOREACH loop
    PTX   ;;Text location point
    )
   ;;Locate the block insert objects
   (setq SS1 (ssget "X"
             '((0 . "INSERT")(2 . "CROSSBLOCK")))
         CNT (if SS1 (sslength SS1) 0)
         PT_ZERO ;;user input of zero point
             (getpoint
                "\nLocate zero datum point: ")
   )
   (if (null PT_ZERO) ;;use drawing zero
     (setq PT_ZERO (list 0.0 0.0 0.0)))
   ;;Loop through the selection set and build
   ;;list PTS containing (("ID" X Y Z) ...)
   (repeat CNT
     (setq CNT (1- CNT)
           EL (entget ;;Get the insert object
                 (ssname SS1 CNT))
           PT (mapcar ;;subtract zero datum
                 '-   ;;point from insert point
                    (cdr (assoc 10 EL))
                    PT_ZERO)
           EL (entget ;;Get the attrib object
                (entnext
                  (cdr (assoc -1 EL))))
           ID (cdr (assoc 1 EL)) ;;ID string
           PTS (cons (cons ID PT) PTS)
     )
   )
   (prompt (strcat "\nFound " (itoa (length PTS))
                   " holes to chart."))
   ;
   ; Build sorted list of ID strings.
   ;
   (setq PTI (acad_strlsort
                (mapcar 'car PTS))
         ;
         ; User input of chart location and
         ; generation parameters.
         PTX (getpoint "\nStart point of chart:")
         CD (getdist PTX "\nColumn size: ")
         RD (getdist PTX "\nRow size: ")
   )
   ; If we have good input,
   (if (and RD CD PTX)
      ; Loop through sorted list of ID strings
      (foreach IX PTI
         ;Use ID string as key into PTS list
         (setq PT (assoc IX PTS))
         ;Output a row of information.
         (Text_Out PTX (car PT)) ;ID
         (Text_Out               ;X
             (list (+ (car PTX) CD)
                   (cadr PTX) 0.0)
             (rtos (cadr PT) 2 3) )
         (Text_out               ;Y
             (list (+ (car PTX) (* 2 CD))
                   (cadr PTX) 0.0)
             (rtos (caddr PT) 2 3) )
         ;Update text point for a new row.
         (setq PTX
            (list
               (car PTX)
               (- (cadr PTX) RD)
               0.0)
         )
      ) ;;end FOREACH
   ) ;;end IF
   (princ)
)
;;-----------------------------------------------