This fifth exercise uncovers the secrets of near-by blocks.
At work, we use a AutoLISP routine called CAF (Cable Auto-Fill) that snags values from one block and inserts those into attributes in blocks that are determined to be within two grid spaces (GRID=15) from the first block.
The proximity of one block to another is determined by inclusion in a selection set which starts based on the insertion point of the originally selected block.
The property key '10' holds the coordinates for the insertion point of the original block.
After the first block (a gear block, aka: "SL-DEVICE-METRIC") is selected, its insertion point coordinates are memorized, and a second selection set is initialized with a starting point -105mm to the left (xStart = x - 105), and -60mm down (yStart = y - 60) from the insertion point of the first block.
The X value of the bottom right corner of the new selection set is defined by doubling the offset we applied to the X axis in the last step. So the xEnd value is "xStart + 210" ( 2 x 105 = 210 ). What this does is make the selection set wide enough to encompass an area starting three grid spaces to the left and ending three grid spaces to the right of the original block.
The Y value of the bottom right corner is defined by the value of an attribute in the original block. The name of that attribute is "length". yEnd is yStart + length.
Now that we have the start and end corners defined, we need to actually define what we want in the selection set. We will use (ssget "_C" (start xy) (end xy) (filter list)) This defines a 'crossing' set using our start and end corners, and only grabs things that match whatever properties we specified in the (filter list). In our case, we only want actual blocks (Entities with a value of 'INSERT' associated with key 0.)
Again: The Caveats
I did basic error-checking in this. If you wander too far outside the boundaries, things may go awry.
This code is not intended for production. It does not differentiate between source and destination blocks. In other words, you can put a destination's data in a SRC attribute with this. The only purpose of this code is to demonstrate how nearby blocks are identified and their attribute values manipulated.
The Code
;; WORKING_get-neighbor-values.lsp - Unmask the magic behind CAF and other similiar LISPS
;; 2022 - Gregory A Sanders
;;
;; Goals and steps:
;; - Select a block.
;; - Using knowledge gleaned from CAF, run various routines against that block to see what we get back.
;; - Eventually decipher the process of retrieving values from nearby bocks.
;; - Document that process for anyone who cares.
;;
(defun c:wgnv ( / effname ent entName primEntList blkHandle origin oLen oJLM oTLA thisAttrName thisAttrVal ent2 ent2list
x1 y1 x2 y2 subSel name srctla srcjlm)
(sssetfirst nil nil) ; Un-select everything in the model.
(setq effname "") ; Ensure 'effname' is blank.
; (textscr) ; Uncomment if you want the text screen.
; (repeat (1+ (atoi (getenv "CmdHistLines")))(terpri)) ; "terpri" is legacy for TERminate PRInt line.
(princ)
(princ "\n:")
(princ "\n--== MODIFYING NEARBY BLOCK ATTRIBUTES ==--")
(princ "\n:")
(setq ent (entsel "\nSelect a gear block: ")) ; Prompt user to select a block. Return entity definition.
(setq entName (car ent)) ; Get the <Entity name> of 'ent'.
(setq blkHandle (cdr(assoc 5 primEntList))) ; Get the block Handle (unique ID number).
(setq effname (vla-get-effectivename (vlax-ename->vla-object entName))) ; Remember the human-readable name.
(princ effname) ; Show what was selected.
(if (= effname "SL-DEVICE-Metric") ; Is it "SL-DEVICE-Metric" ? YES.
(progn ; 'progn' does each line and returns last value.
(setq origin (cdr (assoc 10 (entget entName))) ; The value from key 10 is the insertion point coords.
oLen (atoi (rtos (cdr (assoc "length" (LM:getdynprops ; Dynamic blocks have properties
(vlax-ename->vla-object entName)))))) ; that need special tools to retrieve.
oJLM (car (gs:getsetattval entName "JLM-NUMBER" "None")) ; Call 'getsetattval' function below
oTLA (car (gs:getsetattval entName "ENT-ID" "None")) ; with three parameters.
) ; Close (setq section.
(princ (strcat "\nOrigin: " (vl-prin1-to-string origin))) ; Console feedback.
(princ (strcat "\nLength: " (vl-prin1-to-string oLen))) ; Console feedback.
(princ (strcat "\nJLM: " (vl-prin1-to-string oJLM))) ; Console feedback.
(princ (strcat "\nTLA: " (vl-prin1-to-string oTLA))) ; Console feedback.
(setq ; Start creating coordinate variables.
x1 (- (atoi (rtos (car origin))) 105) ; Top left x.
y1 (- (atoi (rtos (car (cdr(reverse origin))))) 60) ; Top left y.
x2 (+ x1 210) ; Bottom right x.
y2 (- y1 oLen) ; Bottom right y.
) ; Close (setq section.
(setq subSel (ssget "_C" (list x1 y1) (list x2 y2)'((0 . "INSERT")))) ; Create a crossing selection using the new coords. '
(if (and subSel (> (sslength subSel) 1)) ; Did we actually get stuff in our crossing selection? YES.
(progn ; Do these things.
(repeat ; Do the following a set number of times.
(setq j (sslength subSel)) ; Define how many times by how many items there are in selection.
(setq ; Create/modify the following variables:
j (1- j) ; Reduce the value of 'j' by 1.
ent (ssname subSel j) ; Get the entity name at index 'j' in the selection set.
obj (vlax-ename->vla-object ent) ; Convert to VLA Object ID.
name (strcase (vla-get-effectivename obj)) ; Convert to human readable name.
) ; Close (setq section.
(if (= (strcase name) "SL-CONN-7-SHPC") ; Is this one "SL-CONN-7-SHPC"? YES.
(progn ; Do these things.
(setq srctla (cdr (gs:getsetattval ent "REF_SRC_TLA" oTLA))) ; Call getsetattval with three parameters.
(setq srcjlm (cdr (gs:getsetattval ent "REF_SRC_JLM" oJLM))) ; Call it again with different parameters.
(if (/= srctla "") ; Is 'srctla' empty? NO.
(princ (strcat "\nNew REF_SRC_TLA: " ; Console feedback.
(vl-prin1-to-string srctla)))
) ; Close (if .
(if (/= srcjlm "") ; Is 'srctla' empty? NO.
(princ (strcat "\nNew REF_SRC_JLM: " ; Console feedback.
(vl-prin1-to-string srcjlm)))
) ; Close (if .
) ; Close (progn .
) ; Close (if .
) ; Close (repeat .
) ; Close (progn .
) ; Close (if .
) ; Close (progn .
) ; Close (if .
(if (/= effname "SL-DEVICE-Metric") ; Is it "SL-DEVICE-Metric" ? NO.
(princ "\n--== That was not a gear block. ==--") ; Then say so.
) ; Close (if .
(princ) ; Clean console exit.
) ; Close (defun c:wgnv
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; RANDOM SUPPORTING FUNCTIONS ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
(defun c:clear ()
(repeat (1+ (atoi (getenv "CmdHistLines")))(terpri))
(princ)
)
;;
;; getsetattval - Return a specified attribute value,
;; and optionally set a new value.
;; 2022 - Gregory A Sanders
;;
(defun gs:getsetattval ( block attr newval / ent2 block primEntList ent2 ent2list)
(setq thisAttrVal "" thisAttrNewVal "") ; Set the return variables to nil.
(if (/= block nil) ; Is the incoming block name nil?
(progn ; 'progn' evaluates each line and returns the result of the last one.
(setq primEntList (entget block)) ; Get the DXF codes of 'block'.
(setq ent2 (entnext block)) ; Get the first sub-entity in 'block'.
(setq ent2list (entget ent2)) ; Grab the DXF codes for 'ent2'.
(while (/= (cdr(assoc 0 ent2list)) "SEQEND") ; Start the while loop and keep looping until SEQEND is found.
(if (= attr (cdr(assoc 2 ent2list))) ; If the specified attribute name (key 2) is found,
(progn ; Do these things
(setq thisAttrVal (cdr(assoc 1 ent2list))) ; Get the value from the '1.' key.value pair.
(princ (strcat "\nOld " attr ": " ; Console feedback.
(vl-prin1-to-string thisAttrVal)))
(if (/= newval "None") ; Do not modify attributes if 'newval' is "None".
(progn ; If 'newval' is NOT "None", do these things.
(setq ent2list (subst (cons 1 newval) (assoc 1 ent2list) ent2list)) ; Change the current value to the new value.
(entmod ent2list) ; Save mods we made to the block.
(setq thisAttrNewVal (cdr(assoc 1 ent2list))) ; Get the value from the '1.' key.value pair.
) ; Close (progn .
) ; Close (if .
) ; Close (progn .
) ; Close (if .
(setq ent2(entnext ent2)) ; Get the next sub-entity in 'block'.
(if (/= ent2 nil) ; Check to make sure there actually was a 'next entity'.
(setq ent2list(entget ent2))) ; Get the DXF group codes
) ; Close (while .
(list thisAttrVal thisAttrNewVal) ; Return the requested values in a list.
) ; Close (progn .
) ; Close (if .
) ; Close (defun gs:getsetattval .
;;
;; Get Dynamic Block Properties - Lee Mac
;; Returns an association list of Dynamic Block properties & values.
;; blk - [vla] VLA Dynamic Block Reference object
;; Returns: [lst] Association list of ((<prop> . <value>) ... )
;;
(defun LM:getdynprops ( blk )
(mapcar '(lambda ( x ) (cons (vla-get-propertyname x) (vlax-get x 'value)))
(vlax-invoke blk 'getdynamicblockproperties)
)
)
That does it for this fifth exercise. Now we know how the magic was done.
That works for me.
