cadalyst
AutoCAD

Making Entmake Work for You

31 Oct, 1998 By: Bill Kramer

Program Listings


;;------------------------------------------------
;; 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)
)
;;-----------------------------------------------


About the Author: Bill Kramer


More News and Resources from Cadalyst Partners

For Mold Designers! Cadalyst has an area of our site focused on technologies and resources specific to the mold design professional. Sponsored by Siemens NX.  Visit the Equipped Mold Designer here!


For Architects! Cadalyst has an area of our site focused on technologies and resources specific to the building design professional. Sponsored by HP.  Visit the Equipped Architect here!