AutoCAD
Making Entmake Work for You
31 Oct, 1998 By: Bill KramerProgram 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) ) ;;----------------------------------------------- |
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!