Lee's matchattribs.lsp

[zph]

Good day!

I have busing Lee Mac's routine for a while.

http://lee-mac.com/matchattribs.html

Let me start with that it works great.

Having said that, if I could change one thing about it, it would be this...

I would like this routine to prompt the user to select the source attribute (as it already does), but after that, the user can select all the blocks he wants to update (using an "ssget"-like function, for example) and if the block has an attribute name that matches the sources attribute name then the properties of the source attribute replace that of the destinations'.

I took a gander at the code structure and quickly realized that it is a bit above and over my head.

I know some of you gurus might be able to pull this off.

--- I've attached Lee's code ---

[marko_ribar]

Untested, but try it...

;;-------------------=={ Match Attribs }==--------------------;;
;;                                                            ;;
;;  Prompts for selection of source attribute, then proceeds  ;;
;;  to match the listed properties for subsequently picked    ;;
;;  attributes.                                               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Modified by Marko Ribar by user request - untested        ;;
;;------------------------------------------------------------;;
 
(defun c:MatchAttribs ( / properties source )
  (vl-load-com)
  ;; © Lee Mac 2010
 
;; List of Properties to Match, may be edited to suit
;;------------------------------------------------------------;;
  
  (setq properties
   '(
     Backward
     Height
     Layer
     Linetype
     LinetypeScale
     Lineweight
     ObliqueAngle
     Rotation
     ScaleFactor
     StyleName
     Thickness
     UpsideDown
    )
  )
 
;;------------------------------------------------------------;;
 
  (if (setq source
        (LM:Selectif
          (lambda ( x )
            (eq "ATTRIB" (cdr (assoc 0 (entget x))))
          )
          nentsel "\nSelect Source Attribute: "
        )
      )
    (
      (lambda ( properties values / ss i bl dest )
        (prompt "\nSelect Destination Blocks with Destination Attributes...")
        (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
          (repeat (setq i (sslength ss))
            (setq bl (ssname ss (setq i (1- i))))
            (if (not (vlax-property-available-p (vlax-ename->vla-object bl) 'Path))
              (progn
                (setq dest bl)
                (while (setq dest (entnext dest))

                  (setq dest (vlax-ename->vla-object dest))

                  (mapcar
                    (function
                      (lambda ( property value )
                        (vlax-put-property dest property value)
                      )
                    )
                    properties values
                  )
                )
              )
            )
          )
        )
      )
      properties
      (progn (setq source (vlax-ename->vla-object source))
        (mapcar
          (function
            (lambda ( property ) (vlax-get-property source property))
          )
          properties
        )
      )
    )
  )
 
  (princ)
)
 
;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - optional predicate function taking ename argument   ;;
;;  fun - selection function to invoke                        ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;
 
(defun LM:Selectif ( foo fun str / e )
  ;; © Lee Mac 2010
  (while
    (progn (setq e (car (fun str)))      
      (cond
        ( (eq 'ENAME (type e))

          (if (and foo (not (foo e)))
            (princ "\n** Invalid Object Selected **")
          )
        )
      )
    )
  )
  e
)

[marko_ribar]

Yes it had lacks... Try this, now tested...

;;-------------------=={ Match Attribs }==--------------------;;
;;                                                            ;;
;;  Prompts for selection of source attribute, then proceeds  ;;
;;  to match the listed properties for subsequently picked    ;;
;;  attributes.                                               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Modified by Marko Ribar by user request                   ;;
;;------------------------------------------------------------;;

(defun c:MatchAttribs ( / properties source ss i bl dest destt )
  (vl-load-com)
  ;; © Lee Mac 2010

;; List of Properties to Match, may be edited to suit
;;------------------------------------------------------------;;

  (setq properties
   '(
     Backward
     Height
     Layer
     Linetype
     LinetypeScale
     Lineweight
     ObliqueAngle
     Rotation
     ScaleFactor
     StyleName
     Thickness
     UpsideDown
    )
  )

;;------------------------------------------------------------;;

  (if (setq source
        (LM:Selectif
          (lambda ( x )
            (eq "ATTRIB" (cdr (assoc 0 (entget x))))
          )
          nentsel "\nSelect Source Attribute: "
        )
      )
    (progn
      (prompt "\nSelect Destination Blocks with Destination Attributes...")
      (if (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
        (repeat (setq i (sslength ss))
          (setq bl (ssname ss (setq i (1- i))))
          (if (not (vlax-property-available-p (vlax-ename->vla-object bl) 'Path))
            (progn
              (setq destt bl)
              ( (lambda ( properties values )
                  (while (and (setq destt (entnext destt)) (/= (cdr (assoc 0 (entget destt))) "SEQEND"))
                    (setq dest (vlax-ename->vla-object destt))

                    (mapcar
                      (function
                        (lambda ( property value )
                          (vlax-put-property dest property value)
                        )
                      )
                      properties values
                    )
                  )
                )
                properties
                (progn (if (= (type source) 'ENAME) (setq source (vlax-ename->vla-object source)))
                  (mapcar
                    (function
                      (lambda ( property ) (vlax-get-property source property))
                    )
                    properties
                  )
                )
              )
            )
          )
        )
      )
    )
  )

  (princ)
)

;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - optional predicate function taking ename argument   ;;
;;  fun - selection function to invoke                        ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:Selectif ( foo fun str / e )
  ;; © Lee Mac 2010
  (while
    (progn (setq e (car (fun str)))      
      (cond
        ( (eq 'ENAME (type e))

          (if (and foo (not (foo e)))
            (princ "\n** Invalid Object Selected **")
          )
        )
      )
    )
  )
  e
)

HTH, M.R.

[zph]

Thank you for your response, Marko.

This is almost what I need.

Your code seems to modify the properties of all the attributes regardless of the attribute name.

In one my attributed blocks, there are two different attributes that usually require different text widths (among other things).

[zph · Accepted solution]

After a bit of head scratching, hair pulling, getting stumped and asking around here for guidance (shout out to dbroad and Kent1Cooper), here is a solution.

It doesn't update everything that Lee's routine does, but it allows for selecting multiple destination blocks and updating them all at once:

;;;-------------------------------------------;;;
;						;
;.......text property...;assoc code.....Active?.;
;	Linetype	; 6		No	;
;	StyleName	; 7		Yes	;
;	Layer		; 8		Yes	;
;	Height		; 40		Yes	;
;	ScaleFactor	; 41		Yes	;
;	Rotation	; 50		Yes	;
;	ObliqueAngle	; 51		Yes	;
;	Color		; 62		Yes	;
;	Lineweight	; 370		No	;
;						;
;;;-------------------------------------------;;;

(defun c:mablkatts ( / adoc cntr eFlag *error* props sAtt sList bCntr 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 bCntr 0)

			(while (< bCntr (sslength dBlks))
			(setq dName (ssname dBlks bCntr))
			(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

									(cond 	
										;((or (= x 6)(= x 370))(setq dlist (append dlist (list (cond ((assoc x slist))((cons x "BYLAYER")))))))
										((= x 62)(setq dlist (append dlist (list (cond ((assoc x slist))((cons x 256)))))))
										((setq dList (subst (assoc x sList) (assoc x dList) dList)))
									) ;cond

								(entmod dList)
								(entupd dName)
								) ;progn
							) ;foreach
						(setq cntr (1+ cntr))
						(setq eFlag 2)
						) ;progn
					) ;if
				) ;while
			(setq bCntr (1+ bCntr))
			) ;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)
) ;mablkatts

[Anonymous]

ZPH Can you please insert/attach the .lsp file that is working for you? I'm in a time crunch on a project and I do not know .lsp at all.

Any help or guidance would be very much appreciated.

[zph]

AMT electrical,

You can create a routine by copy and pasting the code in post 5 into a .txt file and then saving the .txt file as mablkatts.lsp.

Then, use APPLOAD to load the routine into AutoCAD and type mablkatts into the AutoCAD command line to run the routine.

Good luck with your project.

~ZPH

[Anonymous]

Thank you for the reply. So am I deleting everything out of the file mablkatts.lsp and then pasting this code from post 5 back into the mablkatts.lsp?

Or

Am I just adding the text from post 5 into the mablkatts.lsp without deleting anything?

Regards,

AMT_Electrical.

[zph]

Copy from the beginning of "(defun c:mablkatts ...."

All the way to the end of "...) ;mablkatts"

into your mablkatts.lsp file.