Programm works, but with error messages

[wkplan]

Hi all,

 

I found "ATT-SELECT.lsp" published by cadalyst.

 

What it does:

- collect one attribut of a block as input

- notice the value of this attribute

- compare the attribute tag AND value to all other blocks with same name

- put matching blocks in a selection-set

- finally prompt a message and tell the user how many blocks of this type have the same value.

 

This works perfect, and pretty quick, because the programm parses the block-name through a ssget-filter-selection, and loops two times doing the compares.

 

In my case, all blocks that will be compared, are surrounded with one single closed polyline.

That makes it easy to:

- take the selection-set,

- extract the insertion-point

- invoke the bhatch-command with this insertion-point

- and do a bhatch for all founded blocks that match.

 

I placed my poorly part of code direct before the finally prompt-message, therefore I'm sure the selection-set ist complete and I can do my part.

 

Surprising to me all works perfect -except some few cases the hatch will fail (but that's a minor isssue)- the routine runs pretty slow now, as hatching by points will take time, and after each drawn hatch I get the message "unknown command "TT"..."

 

But I'm sure the programm knows this command, because it is defined as (defun C:TT ()

 

Can anyone explain me why this happens?

 

Below the code:

;;;CADALYST 07/06  Tip2128: ATT-SELECT.lsp  Attribute Filter   (c) Raymond Rizkallah


(defun rt1 ()                            ;;; only ATTRIB or NULL will be selected

   (setq e1 (nentsel "\nSelect attribute to filter: "))

   (if (null e1) 
     (progn (setq ex_tag nil) (QUIT)) 
     (progn
       (while (/= (cdr (assoc 0 (entget (car e1)))) "ATTRIB") 
         (PRINC "Attribute not found. ") (princ (cdr (assoc 0 (entget (car e1)))))   
         (RT1) 
       ) ;end while
        
     )   ;end progn
   )     ;end if
) 

;__________________________________________________________
(defun C:TT ()

 
  (RT1) 
;  (setq e1 (nentsel "\nSelect attribute to filter: "))
  (setvar "cmdecho" 0)
  (setq eget (entget (car e1))) 
  (setq EX_STR (cdr (assoc 1 EGET)))   ;EXISTING TEXTSTRING
  (setq ex_tag (cdr (assoc 2 EGET)))   ;EXISTING tag

 (SETQ PT1 (CADR E1))
 (SETQ SS0 (SSGET PT1))
 (SETQ BLKNAME (CDR (ASSOC 2 (ENTGET (SSNAME SS0 0)))))

 (prompt (strcat "\n Block: " blkname "   Attribute tag: " ex_tag "   >: " ex_str "\n "))
; +++ added code for new line at the end of prompt, just for better reading  
 
;______________ SELECTING BLOCKS "BLKNAME" _________________

 (SETQ LST1 (LIST '(0 . "INSERT") (CONS 2 BLKNAME)) )
 (SETQ SS1 (SSGET "X" LST1))
; (SETQ SS1 (SSGET LST1))
; (IF (NULL SS1) (SETQ SS1 (SSGET "X" LST1)) )

 (setq SSM (SSADD))
 (setq len1 (sslength ss1) n1 0 ssx (ssadd))


 (WHILE (< n1 len1) ;WHILE 1
   (setq ename1 (ssname ss1 n1) eget1 (entget ename1) CTRL1 nil COUNTER 0 str1 "") 
   (SETQ en1 ename1)
   ;____ Find Tag Level
   (while (and (null ctrl1) (/= (CDR (ASSOC 0 (ENTGET (setq en1 (ENTNEXT en1))))) "SEQEND"))
          (setq tag1 (CDR (ASSOC 2 (ENTGET en1))))
          (if (= tag1 ex_tag) (setq str1 (CDR (ASSOC 1 (ENTGET en1))) ctrl1 T))
          (setq counter (1+ counter))
   ) ;end while2
   ;_____

   ;(if (= str1 ex_str) (princ str1))
   (if (= (STRCASE str1) (STRCASE ex_str)) (setq ssx (ssadd ename1 ssx)))
   (setq n1 (1+ n1))
 ) ; end WHILE1
             

 (setq lenx (sslength ssx))  
 (command "._select" ssx "")
[color=RoyalBlue]; +++ from here starts my code +++
 (command "_zoom" "_e") ; zoom to extends, neccassary for hatching
 (repeat (setq n (sslength ssx)) ; loop till any part of the selection-set is proccessed
   (setq en (ssname ssx (setq n (1- n)))) ; get entity-name
   (setq p1 (cdr (assoc 10 (entget en)))) ; extract insertion-point
   (progn ; force hatch to use solid
     (setvar "HPNAME" "SOLID")
     (command ".-bhatch" p1 "" "") ; do a hatch, point to the insertion-point of entity
   ) ; end of progn
 )                    ; end of repeat
; +++ end of my code +++[/color]
 (PROMPT (strcat "\n Match found : [" (itoa lenx) "].   Selected objects are stored in Previous Selection."))
 (setvar "cmdecho" 1) 
 (princ)
)
;_____________________________________________________________

(prompt "\n Start command with [TT]  - by Raymond Rizkallah -  April 06. ")
(PRINC) 

regards

Wolfgang

[Lee Mac]

That normally means you have an extra "" in your code, which tries to re-invoke the last command, mid-lisp...

 

Lee

[wkplan]

Lee,

 

thank you for youre quick answer (as usual)!

 

I found the extra "" in my .-bhatch command.

changed

(command ".-bhatch" p1 "" "")

to

(command ".-bhatch" p1 "" )

and everythings works perfect!

 

Kind regards

Wolfgang

[Lee Mac]

Another method:

 

(defun c:MrWolf (/ doc nss ent Obj bNme tag val sel)
 (vl-load-com)
 
 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object)) nss (ssadd))
       

 (while
   (progn
     (setq ent (car (nentsel "\nSelect Attribute to Filter: ")))
     (cond ((eq 'ENAME (type ent))
            (if (not (eq "AcDbAttribute"
                       (vla-get-ObjectName
                         (setq Obj (vlax-ename->vla-object ent)))))
              (princ "\n** Object is not an Attribute **")))
           (t (princ "\n** Nothing Selected **")))))

 (setq bNme
   (vla-get-Name
     (vla-objectidtoobject doc
       (vla-get-Ownerid Obj))))

 (princ (strcat "\n<< Block: " bNme " | Tag: "
                (setq tag (vla-get-TagString Obj)) " | Value: "
                  (setq val (vla-get-TextString Obj)) " >>"))

 (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 bNme) '(66 . 1))))
 (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
   (foreach att (append (vlax-invoke Obj 'GetAttributes)
                        (vlax-invoke Obj 'GetConstantAttributes))
     (if (and
           (apply '=
             (mapcar 'strcase
               (list tag (vla-get-TagString att))))
           (apply '=
             (mapcar 'strcase
               (list val (vla-get-TextString att)))))
       (ssadd (vlax-vla-object->ename Obj) nss))))
 (vla-delete sel)

 (if (not (zerop (sslength nss)))
   (progn
     (setvar "HPNAME" "SOLID")
     (mapcar
       (function
         (lambda (ent)
           (vl-cmdf "_.-bhatch"
             (cdr (assoc 10 (entget ent))) "")))
       (mapcar 'cadr (ssnamex nss)))))
 
 (princ))
        

[wkplan]

Lee,

 

it took me two days and one night to add 10 lines of code to something i've found in the wide,wide web.

 

You needed 53 minutes, incl. reading my message, setup your code and post it!

 

I searched in many forums about different topics belonging to autocad lisp, and someday I noticed that -round about one year ago- a person called "Lee Mac" started first posts here and at the swamp.

 

It's amazing to look at your everyday growing programming skills!

And it's great that YOU give us more then only some kind advice!

 

May I suggest one minor change to your code?

 

Please add in there between (the blue one):

(while
   (progn
     (setq ent (car (nentsel "\nSelect Attribute to Filter: ")))
     (cond ((eq 'ENAME (type ent))
            (if (not (eq "AcDbAttribute"
                       (vla-get-ObjectName
                         (setq Obj (vlax-ename->vla-object ent)))))
              (princ "\n** Object is not an Attribute **")))
           (t (princ "\n** Nothing Selected **")))))
[color=Blue](command "_.zoom" "_e")[/color]
 (setq bNme
   (vla-get-Name
     (vla-objectidtoobject doc
       (vla-get-Ownerid Obj))))

This will make sure the hatch-function will not stop, if not the hole drawing is visible. (I suggest you allways have to "zoom in" to select the attribute).

 

 

Kind regards

Wolfgang

[Lee Mac]

Thanks Wolfgang

 

Feel free to modify my code how you like, I posted it to help you learn.

 

Thanks,

 

Lee