LISP program for checking drawings

emryz · ‎11-01-2017

I've been trying to make a LISP program that checks the value of specific attributes within a block, and if the value is not what it should be, it logs it as an error. I would like to use this as a final check for those little "gotchas" before submitting our drawings.

I've tried to use code from various posts across the internet, but don't have enough skills with LISP yet to make it work properly. This is one template that I've found to be closest to my end goal:

(vl-load-com)

(defun C:demo  (/ blockdata blockdef blockname blockref en ent tmp)
  (if (setq ent (entsel "\n   >>   Select a block instance   >>"))
    (progn
      (setq en	      (car ent)
	    blockref  (vlax-ename->vla-object en)
	    blockname (vla-get-effectivename blockref)
	    blockdef  (vla-item
			(vla-get-blocks
			  (vla-get-activedocument (vlax-get-acad-object)))
			blockname)
	    )
      (if (equal :vlax-true (vla-get-hasattributes blockref))
	(progn
	(princ "\n")
	(princ en)
	
	(princ "\n")
	(princ blockref)
	
	(princ "\n")
	(princ blockname)
	
	(princ "\n")
	(princ blockdef)
	
	(princ "\n")
	(princ "\n")
	(princ "\n")
	  (foreach attrib  (vlax-invoke blockref 'GetAttributes)
	    (vlax-for item  blockdef
	      (if (equal (vla-get-objectname item) "AcDbAttributeDefinition")
		(progn
		  (if (equal (vla-get-tagstring attrib) (vla-get-tagstring item))
		    (progn
		      (setq tmp	(list
				  (vla-get-promptstring item)
				  (vla-get-tagstring attrib)
				  (vla-get-textstring attrib)))
		      (setq blockdata (cons tmp blockdata))
		      )
		    )
		  )
		)
	      )
	    )
	  (setq blockdata(reverse blockdata)
		)
	  (foreach lst blockdata
	    (princ (strcat "\n Prompt: "
			   (car lst)
			   " *** Tag: "
			   (cadr lst)
			   " *** Value: "
			   (last lst)))
	    )
	  )
	)
      )
    (princ "\n  >>  Nothing selected. Try again...")
    )
  (princ)
  )

However, I would like to delete the following line:

(if (setq ent (entsel "\n   >>   Select a block instance   >>"))
    (progn

And instead, I would like the block that the LISP program is looking for, to be predefined within the LISP program. So, no user input. From there, the LISP program checks attribute values of that block for other predefined values. Can anyone help?

Thanks,

Rob

lando7189 · ‎11-01-2017

Give this a try. - Lanny

(vl-load-com)

(defun C:demo  (/ blocknames objLayout objEnt blockdata blockdef blockname  en  tmp)
  
  (setq blocknames (list "BLOCK1" "BLOCK6" "BLOCK23")) ; <-- list of all block names you want to check (USE ALL CAPS HERE)

  (vlax-for objLayout (vla-get-Layouts (vla-get-activedocument (vlax-get-acad-object)))
    (vlax-for objEnt (vla-get-Block objLayout)
      (if (and
            (equal (vla-get-objectname objEnt) "AcDbBlockReference")
            (member (strcase (setq blockname (vla-get-effectivename objEnt))) blocknames)
            (equal :vlax-true (vla-get-hasattributes objEnt))
        )
        (progn
            (setq en (vlax-vla-object->ename objEnt)
                 blockdef  (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blockname)
            )

            (princ "\n")
            (princ en)
            
            (princ "\n")
            (princ objEnt)
            
            (princ "\n")
            (princ blockname)
            
            (princ "\n")
            (princ blockdef)
            
            (princ "\n")
            (princ "\n")
            (princ "\n")
              (foreach attrib  (vlax-invoke objEnt 'GetAttributes)
                (vlax-for item  blockdef
                  (if (equal (vla-get-objectname item) "AcDbAttributeDefinition")
                    (progn
                      (if (equal (vla-get-tagstring attrib) (vla-get-tagstring item))
                        (progn
                          (setq tmp (list
                              (vla-get-promptstring item)
                              (vla-get-tagstring attrib)
                              (vla-get-textstring attrib)))
                          (setq blockdata (cons tmp blockdata))
                          )
                        )
                      )
                    )
                  )
                )
              (setq blockdata(reverse blockdata))
              (foreach lst blockdata
                (princ (strcat "\n Prompt: "
                       (car lst)
                       " *** Tag: "
                       (cadr lst)
                       " *** Value: "
                       (last lst)))
              )
        )
      )
    )
  )
  (princ)
)

pbejse · ‎11-01-2017

@emryz wrote:

I've been trying to make a LISP program that checks the value of specific attributes within a block, and if the value is not what it should be, it logs it as an error. I would like to use this as a final check for those little "gotchas" before submitting our drawings..

... And instead, I would like the block that the LISP program is looking for, to be predefined within the LISP program. So, no user input. From there, the LISP program checks attribute values of that block for other predefined values. Can anyone help?

Thanks,

Rob

Easy coding, Where would you base the value for checking? from an external source? or a hard-coded value? it would be odd to think that the "correct values" are based on a constant value. More information please.

pBe

emryz · ‎11-02-2017

Lanny,

Thanks for the reply. Your code worked as intended. I tried to expound further on the code you wrote, but I didn't get very far. Would you be able to fill in the blanks? BTW....why do the blocknames need to be capitalized?

Lanny/pBe,

The end goal of the LISP program will be to check drawings for certain values that I know are always going to be the same. I am ok with adding Block Names, Attribute Names, and expected Attribute Values as hard code in the LISP program. It doesn't need to be sourced externally. At the end, it will output the result of all the checks to a txt file. If one of the values is different than what is expected, it makes an additional note for that Attribute Value on the output file. Sorry for being too vague earlier. Hopefully this clears up the end goal of the program.

Thanks again for all the help!

(vl-load-com)

(defun C:test9  (/ blocknames objLayout objEnt blockdata blockdef blockname  en  tmp)
  
  (setq blocknames (list "CAD-STD-FRONTSHEET") ; <-- list of all block names you want to check (USE ALL CAPS HERE)
;;;	attnames (list "DEPARTMENT")
;;;	attvalue (list "ENGINEERING")
  )

;;;******************************************************
;;;Look for predefined blocks

  (vlax-for objLayout (vla-get-Layouts (vla-get-activedocument (vlax-get-acad-object)))
    (vlax-for objEnt (vla-get-Block objLayout)
      (if (and
            (equal (vla-get-objectname objEnt) "AcDbBlockReference")
            (member (strcase (setq blockname (vla-get-effectivename objEnt))) blocknames)
            (equal :vlax-true (vla-get-hasattributes objEnt))
        )
        (progn
            (setq en (vlax-vla-object->ename objEnt)
                 blockdef  (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blockname)
            )
;;;
;;;******************************************************
;;;If block is found, look for a predefined attribute name within the block.
;;;
;;;	(if (equal (blocknames "CAD-STD-FRONTSHEET")
;;;		(progn
;;;		   (if (equal attnames "DEPARTMENT")
;;;			????????? 
;;;			????????? 
;;;			????????? 
;;;		   )
;;;	)
;;;
;;;******************************************************
;;;Check value of attribute value.
;;;If attribute value does not equal predefined value, flag the error.
;;;
;;;	????
;;;
;;;
;;;******************************************************
;;;Output log of all checks.
;;;
;;;	   (foreach attname (print attname))
;;;
;;;******************************************************
;;;Output list of attribute values that flag as error.
;;;
;;;	????
;;;
;;;******************************************************

        )
      )
    )
  )
  (princ)
)

lando7189 · ‎11-02-2017

It is all caps due to the evaluation to see if the blockname being checked is a member of the blocknames list.

(member (strcase (setq blockname (vla-get-effectivename objEnt))) blocknames)

If you want it to be case sensitive, just remove the strcase:

(member (setq blockname (vla-get-effectivename objEnt)) blocknames)

Here is the updated routine (note: the entry for 'SHOP-ORDER-PART-ITEM' within 'BlockCheckingInfo' is a test of my own block)

(vl-load-com)

(defun C:test9  (/ dxf GetAttributeList
                   BlockCheckingInfo
                   blocknames objLayout objEnt blockname chklist attlist errlist)

  ;;;* BEGIN NESTED FUNCTIONS

	(defun dxf (code EnameOrElist / VarType)
	  (setq VarType (type EnameOrElist))
	  (if (= VarType (read "ENAME"))
	    (cdr (assoc code (entget EnameOrElist)))
	    (cdr (assoc code EnameOrElist))
	  )
	)
  
	(defun GetAttributeList  (enam AsEverything / alis)
	  (setq  elis (entget enam)
	  alis nil
	  )
	  (if (and (= (dxf 0 elis) "INSERT")
	     (= (dxf 66 elis) 1)
	     (/= (logand 4 (dxf 70 elis)) 4)
	      )
	;;;* is block, with attributes, not xref
	    (while (/= (dxf 0 elis) "SEQEND")
	      (setq elis (entget (entnext (dxf -1 elis))))
	      (if (/= (dxf 0 elis) "SEQEND")
		  (if AsEverything
		    (setq alis (append alis (list elis)))
		    (setq
		      alis (append alis (list (cons (dxf 2 elis) (dxf 1 elis))))
		    )
		  )
	      )
	    )
	  )
	  alis
	)

  ;;;* END NESTED FUNCTIONS

  
  ;;;* MAIN DATASET CHECK
  (setq BlockCheckingInfo
     (list
       (cons "CAD-STD-FRONTSHEET" (list
         (cons "DEPARTMENT" "ENGINEERING")
       ))
       (cons "BLOCKNAME1" (list
         (cons "ATTNAME1" "ATTVAL1")
         (cons "ATTNAME2" "ATTVAL2")
         (cons "ATTNAME3" "ATTVAL3")
       ))
       (cons "BLOCKNAME2" (list
         (cons "ATTNAME1" "ATTVAL1")
         (cons "ATTNAME2" "ATTVAL2")
       ))
       (cons "BLOCKNAME3" (list
         (cons "ATTNAME1" "ATTVAL1")
         (cons "ATTNAME2" "ATTVAL2")
         (cons "ATTNAME3" "ATTVAL3")
         (cons "ATTNAME4" "ATTVAL4")
       ))
       (cons "SHOP-ORDER-PART-ITEM" (list ;; <- Lando's test block line
         (cons "SURF1" "13841")
         (cons "SURF2" "13841")
       )) 
     )
  )

;;;******************************************************
;;;Look for predefined blocks

  (vlax-for objLayout (vla-get-Layouts (vla-get-activedocument (vlax-get-acad-object)))
    (vlax-for objEnt (vla-get-Block objLayout)
      (if (and
            (equal (vla-get-objectname objEnt) "AcDbBlockReference")
            (setq chklist (cdr (assoc (strcase (setq blockname (vla-get-effectivename objEnt))) BlockCheckingInfo)))
            (equal :vlax-true (vla-get-hasattributes objEnt))
        )
        (progn
          (setq en (vlax-vla-object->ename objEnt))
          (setq attlist (GetAttributeList en nil))
          (mapcar '(lambda (x / y)
                     (cond
                       ((not (setq y (assoc (car x) attlist)))
                        (setq errlist (cons (list "attrib not found" x y blockname en) errlist))
                       )
                       ((not (equal (cdr x) (cdr y)))
                        (setq errlist (cons (list "invalid value"    x y blockname en) errlist))
                       )
                     )
                   )
             chklist
          )
        )
      )
    )
  )
  (if errlist
    (foreach errset errlist
      (print errset)
    )
    (princ "\nNo errors found.")
  )
  (princ)
)

emryz · ‎11-02-2017

Works perfectly. I'll study your code and see if I can learn how to expand the functionality. Thank you!

sagar.adhau · ‎10-16-2021

Hello Lany,

I need one help, I am trying to run lisp routine to cross check drawing Bill of material text before closing drawing and send to customer. I want to add alert which will pop up window message saying that ''BOM checked '' and after accepting this my drawing file should get closed or saved. can i do this. can you give me some suggestion

Regards,

Sagar

Community

LISP program for checking drawings

LISP program for checking drawings

LISP program for checking drawings