foreach assistance...

[zph]

Good day!  Below is some code I am working on and I've been scratching my head over it for a while so I thought I might pass it to you guys.

When I remove the FOREACH and hard code the "x" values, the entire routine works.  Once I try to step through the entire 'props' list using FOREACH, the routine breaks without error sent to the cmd line.

(setq props (list 7 8 40 41 50 51 62))
  (while (not (eq (cdr (assoc 0 dList)) "SEQEND"))
  (setq dName (entnext dName))
  (setq dList (entget dName))
   (if (equal (cdr (assoc 2 dList)) sAttName)
    (progn
(foreach x props (setq dList (subst (cons x sAttList)(assoc x dList) dList)))
(entmod dList)
    
    ) ;progn
   ) ;if
  ) ;while

Any ideas?

[dbroad · Accepted solution]

(foreach x props (setq dList (subst (cons x sAttList)(assoc x dList) dList)))

It appears that you are processing the attributes of a block looking for a particular attribute and are then changing the properties for that attribute.  In the above line (cons x sAttList) is being applied to every property.  What is sAttList?  Should the same list be a color, a layer name, a text rotation value, etc.?  It should probably be (cons x (cdr(assoc x sAttlist)))....

Personally, I prefer editing the block and using attsync or battman.

[zph]

Yeah, after I posted I figured I should posted the entire code for context.  Here it is:

(defun c:testy ( / adoc cntr *error* props sList sAttList sAttName sBlockName cntr1 ssUId dName dList cntr2 nProp)

(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(setvar "cmdecho" 0)
(setq cntr 0)

(defun *error* (msg)
	(if (member msg '("Function cancelled" "quit / exit abort" "*Cancel*"))
		(progn (setvar "cmdecho" 1)(vla-endundomark adoc)(princ "\n <!> Routine aborted <!> "))
	) ;if
) ;*error*

(setq props (list 7 8 40 41 50 51 62)) ;setq assoc codes for properties
(setq sList (entget (car (nentsel "\n\033\n <> Select source attribute <> "))))
(setq sAttName (cdr (assoc 2 sList)))
(setq sBlockName (cdr (assoc 330 sList)))

(princ "\n\033\n <> Select destination block\(s\) <> ")
(setq ssUId (ssget '((0 . "insert"))))
(setq cntr1 0)

	(while (< cntr1 (sslength ssUId))
	(setq dName (ssname ssUId cntr1))
	(setq dList (entget dName))

		(while (not (eq (cdr (assoc 0 dList)) "SEQEND"))
		(setq dName (entnext dName))
		(setq dList (entget dName))

			(if (equal (cdr (assoc 2 dList)) sAttName)
				(progn
				(foreach x props (setq dList (subst (cons x sList)(assoc x dList) dList)))
				(entmod dList)
				(setq cntr (1+ cntr))
				) ;progn
			) ;if
		) ;while
	(setq cntr1 (1+ cntr1))
	) ;while

(setvar "cmdecho" 1)
(vla-endundomark adoc)
(princ (strcat "\n\033\n " (itoa cntr) " Block attributes modified.\n <!> Routine complete <!>"))
(princ)
) ;testy

The variable in question is now "sList" and yes, this routine matches the attributes of a source attribute and, based upon the attribute tag of the source, replaces the destination objects properties.

Yes, battman and such work for making a global type change to the drawing, but I've not had much success with individual block attribute changes that should not effect the entire drawing file.

[dbroad]

Did you read and integrate my suggested changes?

[zph]

Sorry, yes, thank you... I have incorporated your change and it works.

However, the routine function properly with most of the properties, most of the time.....

I seems that the color isn't updated.

Also, if the style names of the source attribute is updated to its destination, and the routine is run again, the source attribute (of the previous source attribute) style name isn't updated if it becomes a destination.

EDIT: reworded for better clarity...hopefully

[dbroad]

Color is complex.  The DXF code for color is not present if the color is bylayer.  So test for existence of the code before trying to substitute for it.  In addition, true color is handled by key 420 rather than key 62.  You may need to test for its presence if a true color has been assigned and match that.

[zph]

I found that the applicable color code in this instance is 62.  I've hard coded the 62 (into the blue if statement), because it is the only code holding a "nil" value.  I then change the value of the color in the list, but the color doesn't change on screen.  I tried entupd, but no luck on that.  I've highlited the portion of code in question.  If you comment out the blue and red code the routine works for all the other assoc codes...it seems to 'skip' over the 62.

(defun c:testy ( / adoc cntr eFlag *error* props sAtt sList cntr1 dBlks dName dList)

(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(setvar "cmdecho" 0)
(setq cntr 0)
(setq eFlag 1)

(defun *error* (msg)
	(if (member msg '("Function cancelled" "quit / exit abort" "*Cancel*"))
		(progn
		(setvar "cmdecho" 1)
		(vla-endundomark adoc)
			(cond 	((= eFlag 1)(princ "\n <!> Routine aborted <!> "))
				((= eFlag 2)
					(progn
					(princ (strcat "\n\033\n " (itoa cntr)))
					(princ " Block attributes modified.\n <!> Routine complete <!>")
					) ;progn
				)
			) ;cond
		) ;progn
	) ;if
) ;*error*

;*** Block attribute text properties **;
(setq props (list 7 8 40 41 50 51 62)) 
;**************************************;

(if (not (setq sAtt (car (nentsel "\n\033\n <> Select source attribute <> "))))
(progn (princ "\n\033\n Block attribute selection set empty ")(exit))
) ;if

(if (= (cdr (assoc 0 (entget sAtt))) "ATTRIB")
		
	(if 	(and	(setq sList (entget sAtt))
			(princ "\n\033\n <> Select destination block\(s\) <> ")
			(setq dBlks (ssget '((0 . "insert"))))
		) ;and

		(progn
		(setq cntr1 0)

			(while (< cntr1 (sslength dBlks))
			(setq dName (ssname dBlks cntr1))
			(setq dList (entget dName))

				(while (not (eq (cdr (assoc 0 dList)) "SEQEND"))
				(setq dName (entnext dName))
				(setq dList (entget dName))

					(if (equal (cdr (assoc 2 dList)) (cdr (assoc 2 sList)))
						(progn
							(foreach x props

(progn
	(if (= x 62)
		(if (= (assoc 62 sList) nil)
		(setq dList (cons (cons 62 (cdr byLayer)) dList))
		(setq dList (cons (cons 62 (cdr (assoc 62 sList))) dList))
		) ;if

		(setq dList (subst (cons x (cdr (assoc x sList))) (assoc x dList) dList))
	) ;if

(entmod dList)
(princ (strcat "\n assoc code " (itoa x) " updated. Value now: "))(princ (cdr (assoc x dList)))
) ;progn

							) ;foreach
						(setq cntr (1+ cntr))
						(setq eFlag 2)
						) ;progn
					) ;if
				) ;while
			(setq cntr1 (1+ cntr1))
			) ;while
		) ;progn

		(progn (princ "\n\033\n Block selection set empty ")(exit))
	) ;if

	(progn (princ "\n\033\n Block attribute required ")(exit))
) ;if

(if (= eFlag 2)(exit))
(princ)
) ;testy


;**********************************    End of File     **********************************;

[dbroad]

What are you storing in the variable bylayer?  DXF codes use color numbers, if present.  To set something to bylayer use 256.  To set to byblock use 0.

This doesn't make much sense to me:

(setq dList (cons (cons 62 (cdr byLayer)) dList))

Might need to be something like

(setq dlist (cons (cons 62 256) dlist))

[zph]

I included your suggestion, but alas, it still isn't displaying the color change.  The list value changes, but doesn't update.

Code snipit with your edits:

(progn
	(if (= x 62)
		(if (= (assoc 62 sList) nil)
		(setq dList (cons (cons 62 256) dList))
		(setq dList (cons (cons 62 (cdr (assoc 62 sList))) dList))
		) ;if

		(setq dList (subst (cons x (cdr (assoc x sList))) (assoc x dList) dList))
	) ;if

(entmod dList)
(entupd dName)
(princ (strcat "\n assoc code " (itoa x) " updated. Value now: "))(princ (cdr (assoc x dList)))
) ;progn

[zph]

I restructured the if statements to be a cond and to include all 4 conditions.  I found that conditions 1, 2, and 4 function properly.  Condition 3 doesn't; the source text is not byLayer (or nil) and the destination text is byLayer.

(progn
	(if (= x 62)
		(cond
			((and (= (assoc 62 sList) nil)(= (assoc 62 dList) nil))	
				(setq dList (cons (cons 62 256) dList))
			) ;cond1 *isn't needed technically; both are already byLayer = no change

			((and (= (assoc 62 sList) nil)(assoc 62 dList))
				(setq dList (subst (cons 62 256) (assoc 62 dList) dList))
			) ;cond2 works

			((and (assoc 62 sList)(= (assoc 62 dList) nil))
				(setq dList (cons (cons 62 (cdr (assoc 62 sList))) dList))
			) ;cond3

			((and (assoc 62 sList) (assoc 62 dList)(not (= (assoc 62 sList) (assoc 62 dList))))
				(setq dList (subst (cons 62 (cdr (assoc 62 sList))) (assoc 62 dList) dList))
			) ;cond4 works	
		) ;cond

		(setq dList (subst (cons x (cdr (assoc x sList))) (assoc x dList) dList))
	) ;if

(entmod dList)
(entupd dName)
(princ (strcat "\n assoc code " (itoa x) " updated. Value now: "))(princ (cdr (assoc x dList)))
) ;progn

[dbroad]

What does this condition test? Won't it always be false?  It can't be nil and non-nil at the same time.

(and (assoc 62 sList)(= (assoc 62 dList) nil))

 How is this

(setq dList (cons (cons 62 (cdr (assoc 62 sList))) dList))

different from this?

(setq dList (cons (assoc 62 sList) dList))

 I haven't looked at all of your code but you might also consider that entmod doesn't always look kindly to dxf lists that are out of traditional order.

[zph]

dbroad, Thank you for your response.

I've responded to each of your points below in blue.

-----------------------

dbroad wrote:

What does this condition test? Won't it always be false?  It can't be nil and non-nil at the same time.

(and (assoc 62 sList)(= (assoc 62 dList) nil))

This looks like the 3rd condition I was refering to; sList is the SOURCE and it exists (and since this is assoc 62 the layer isn't set to byLayer but any other color....1, 2, 3, etc...not byLayer).  The DESTINATION is dList and in this condition the destination layer is set to byLayer prior to any modifications.  This condition calls to different variables: sList and dList.  Why will this condition always be false?

 How is this

(setq dList (cons (cons 62 (cdr (assoc 62 sList))) dList))

This is adding a dotted pair (62 . "2ndValueOfsList'sAssoc62") to dList.  At least, that is what I *think* it is doing 🙂

different from this?

(setq dList (cons (assoc 62 sList) dList))

This is adding the 1st value of sList's assoc 62 code (which should be "62") to dList with no additional data provided about it.  Does this result in the 2nd value being functionally set to "nil"?

EDIT:  Looked at this again; is (assoc 62 sList) the entire dotted pair of sList assoc 62?  If it is, then it adds this dotted pair to the variable dList and there would be (I assume) no difference between the results of the two pieces of code.

 I haven't looked at all of your code but you might also consider that entmod doesn't always look kindly to dxf lists that are out of traditional order.

I am not sure I understand correctly.  Are you saying that if a dxf list of out of numerical order errors can occur using entmod?  So, I guess the question is, what is "traditional order"?

---

[dbroad]

Sorry. Looks like I didn't read the condition closely enough.  Your condition looks OK.

I think you'll find that 

(cons 62 (cdr (assoc 62 sList))

and this 

(assoc 62 sList)

are the same thing.  It is best to use the simplest form.

My last point was that you can't add the (62 .color) as the first element of the list.  Entmod, I believe, expects the first element of the data list to be (-1 . <ename>) .  You should test this outside of a program flow manually and determine whether an error is triggered.  Substituting data does not change the order but when you (cons ...) a list together you add the new element as the first element.  Try changing an entity to some color other than bylayer.  Then use (entget(car(entsel))) on it.  Look at where the color goes into the list.  Try to replicate that when you entmod.

[Kent1Cooper]

---

@zph wrote:

I restructured the if statements to be a cond and to include all 4 conditions.  ....

....
	(if (= x 62)
....
	) ;if

(entmod dList)
....

---

I believe [without setting up the whole set of circumstances to confirm] that you can greatly simplify that -- you don't really need to check whether there's a color entry.

If an entity-data list has two entries for some category for which it can keep only one, it uses the later one.  So you can just stick a code-62 entry on the end, and that will override any earlier entry that may be there, if there is one, or just add itself if there isn't one.  And if there isn't one in the source, whether or not there is in the current list, you can force it to bylayer in the same way.  The returned list in the process will then show the (62 . 256) entry, but if you then (entget) the object, there will be no 62-code entry any more.  Try, in place of the whole (if (= x 62)... stretch, something like this [which can be collapsed into one line -- I just pulled it apart for the comments]:

(setq dlist

  (append ; stick onto the end of...

    dlist ; the original

    (list

      (cond

        ((assoc 62 slist)); if the source has one [it's not ByLayer], use that

        ((62 . 256)); otherwise [source is ByLayer], make it ByLayer

      ); cond

    ); list

  ); append

); setq

[zph]

Certainly isn't the most graceful, but it works:

((and (assoc 62 sList)(= (assoc 62 dList) nil))
	(progn	
		(setq nList1 ())
		(setq nList2 ())
		(setq nCntr 0)

			(while (< nCntr 8)
			(setq nList1 (cons (nth nCntr dList) nList1))
			(setq nCntr (1+ nCntr))
			) ;while

			(while (< nCntr (length dList))
			(setq nList2 (cons (nth nCntr dList) nList2))
			(setq nCntr (1+ nCntr))
			) ;while
			
		(setq nList1 (cons (assoc 62 sList) nList1))
		(setq dList (append (reverse nList1) (reverse nList2)))
	) ;progn
)

The routine now functions as intended.  Thank you, dbroad!

[zph]

I gave it a go, but acad returned an error upon loading it.

; error: bad argument type: consp 256

[Kent1Cooper]

---

@zph wrote:
I gave it a go, but acad returned an error upon loading it.

; error: bad argument type: consp 256

---

That may be my fault [untested].  In place of

((62 . 256))

try

((cons 62 256))

or possibly

('(62 . 256))

EDIT:  But come to think of it, if the error is on loading, it could be in how you've incorporated it into the larger routine.  It shouldn't be getting to that on loading, unless there's something like an extra right parenthesis somewhere that's completing the function definition prematurely, and it's then going on to perform functions that follow.

[dbroad]

Glad you solved your problem.  As Kent showed, using the append function can a good way to add something as the last element of a list.  As long as the color code is not the first element, it should work in entmod.

[zph]

(cons 62 256) corrected the problem.

I enjoy working at an issue and eventually finding a solution - 30 to 40 lines of code. I then am in awe/humbled after you guys can take a look at it and reduce/simplify it down to one line of code. You guys are awesome!

Thanks again! Cheers!