Topic: Block select Lisp needed...

[hudster]

I'm looking for a lisp that will allow me to move blocks to a new layer depending on their attribute values.

I need to move emergency lighting blocks only to a new layer for building warrant purposes, and It's a bit of a pain having to manually change each one to a new layer.

The blocks all have attribute values ending in E.

Cheers for any help
Andy.

[SMadsen]

You could choose to write it yourself.
- Make a selection set of all blocks with attributes {hint: '((0 . "INSERT")(66 . 1)) }
- Run through each insert in the selection to test for attribute values {hints: ENTNEXT and WCMATCH}
- Remove any insert that doesn't match {hint: SSREMOVE}
- Return finished selection set

[Mark]

- Remove any insert that doesn't match {hint: SSREMOVE}

I don't see that in my docs Stig, is that one of your functions?

[MP]

I think he meant ssdel.

[daron]

I was wondering the same thing.  ssdel comes to mind though.

[SMadsen]

Doh! Yep, SSDEL  

[Mark]

Stig you ready for another race?

[SMadsen]

Bring it on
What kind, where, how?

[Mark]

I'm thinking of solving the problem posted by Hudster. I have (almost) the solution using VLAX methods.

[hudster]

I've not quite got the necessary skills regarding selection sets yet.

I'm only at the lisp stage where I can write basic routines.

***edit***

Stig, are your autolisp lessons nearly ready?

[Mark]

Here is my first shot at it. It is rather slow.

Code: [Select]




(defun startTimer ()
  (setq time (getvar "DATE"))
  )

(defun endTimer (func)
  (setq time    (- (getvar "DATE") time)
        seconds (* 86400.0 (- time (fix time)))
        )
  (gc)
  (outPut seconds func)
  )

(defun outPut (secs def)
  ;(princ "\nPurging...")
  ;(command "PURGE" "Layers" "*" "N")
  (gc)
  (princ (strcat "\nTimed " def ": " (rtos secs 2 6)))
  (princ)
  )


(defun get-mspace ()
  (vla-get-modelspace
    (vla-get-activedocument
      (vlax-get-acad-object)
      )
    )
  )

(defun check-for-char (obj char / attrib-list ans_lst)
  (setq attrib-list
        (vlax-safearray->list
          (vlax-variant-value
            (vla-GetAttributes obj)
            )
          )
        )

  (mapcar
    '(lambda (x / ts)
       (setq ts (vla-get-textstring x))
       (cond ((= (substr ts (strlen ts)) char)
              (setq ans_lst (cons "yes" ans)))
             )
       )
    attrib-list
    ); mapcar

  (if (vl-position "yes" ans_lst)
    T nil
    )
  )
 

(defun chg-blk-to-lay (/ mspace o_name has_attrs)

  (setq mspace (get-mspace))
  (startTimer)
  (vlax-for blk mspace
            (setq o_name (vla-get-objectname blk))

            (cond ((= o_name "AcDbBlockReference")
                   (cond ((vlax-property-available-p blk 'HasAttributes)
                          (if (check-for-char blk "E"); change the char here
                            (vla-put-layer blk "0"); change layer name here
                            )
                          )
                         )
                   ); 1st cond.
                  (T (princ "\r searching ............."))
                  )
            )
  (endTimer (vl-symbol-name 'chg-blk-to-lay))
  (princ)
  )



[SMadsen]

Here's a simple take on it. A bit primitive at the command interface but you can change it to whatever suits the task best

Code: [Select]

(defun getAttrib (ent val / att blk entl)
  (setq blk ent)
  (while (and ent (/= "SEQEND" (cdr (assoc 0 (setq entl (entget ent))))))
    (and (= "ATTRIB" (cdr (assoc 0 entl)))
         (wcmatch (cdr (assoc 1 entl)) val)
         (setq att blk)
    )
    (setq ent (entnext ent))
  )
  att
)

(defun ss_attval (/ a ent sset)
  (cond ((setq sset (ssget "X" '((0 . "INSERT") (66 . 1))))
         (setq a 0)
         (repeat (sslength sset)
           (setq ent (ssname sset a)
                 a   (1+ a))
           (and (not (getAttrib ent "*E"))
                (ssdel ent sset)
                (setq a (1- a)))
         )
        )
  )
  sset
)

(defun C:ATTLAY (/ ss)
  (cond ((setq ss (ss_attval))
         (command "_CHPROP" ss "" "Layer")
        )
  )
)

Thanks for the reminder on the lessons. I've been a bit hung up this summer so they're not entirely translated yet. But enough to start it up and get translations ready during.

[SMadsen]

Dang, 3 minutes late

[SMadsen]

By the way, Mark. I've developed a preference for the MILLISECS variable. It's quite accurate and easier to deal with for timers

(setq time (getvar "MILLISECS"))
(setq time (/ (- (getvar "MILLISECS") time) 1000.0))
(princ (strcat "Elapsed time: " (rtos time) " seconds"))

[Mark]

I just changed mine a bit but it didn't help!

thanks Stig that's nice.