Author Topic: Block select Lisp needed...  (Read 17178 times)

0 Members and 1 Guest are viewing this topic.

hudster

  • Gator
  • Posts: 2848
Block select Lisp needed...
« on: August 26, 2004, 05:03:23 AM »
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.
Revit BDS 2017, 2016, 2015, 2014, AutoCAD 2017, 2016, Navisworks 2017, 2016, BIM360 Glue

SMadsen

  • Guest
Block select Lisp needed...
« Reply #1 on: August 26, 2004, 07:44:22 AM »
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

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #2 on: August 26, 2004, 08:45:24 AM »
Quote from: SMadsen

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

I don't see that in my docs Stig, is that one of your functions?
TheSwamp.org  (serving the CAD community since 2003)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Block select Lisp needed...
« Reply #3 on: August 26, 2004, 08:51:22 AM »
I think he meant ssdel. :)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

daron

  • Guest
Block select Lisp needed...
« Reply #4 on: August 26, 2004, 08:51:45 AM »
I was wondering the same thing.  ssdel comes to mind though.

SMadsen

  • Guest
Block select Lisp needed...
« Reply #5 on: August 26, 2004, 09:01:26 AM »
Doh! Yep, SSDEL  :roll:

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #6 on: August 26, 2004, 09:04:32 AM »
Stig you ready for another race?
TheSwamp.org  (serving the CAD community since 2003)

SMadsen

  • Guest
Block select Lisp needed...
« Reply #7 on: August 26, 2004, 09:12:07 AM »
Bring it on :)
What kind, where, how?

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #8 on: August 26, 2004, 09:16:01 AM »
I'm thinking of solving the problem posted by Hudster. I have (almost) the solution using VLAX methods.
TheSwamp.org  (serving the CAD community since 2003)

hudster

  • Gator
  • Posts: 2848
Block select Lisp needed...
« Reply #9 on: August 26, 2004, 09:22:03 AM »
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?
Revit BDS 2017, 2016, 2015, 2014, AutoCAD 2017, 2016, Navisworks 2017, 2016, BIM360 Glue

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #10 on: August 26, 2004, 10:10:56 AM »
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)
  )

TheSwamp.org  (serving the CAD community since 2003)

SMadsen

  • Guest
Block select Lisp needed...
« Reply #11 on: August 26, 2004, 10:13:33 AM »
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

  • Guest
Block select Lisp needed...
« Reply #12 on: August 26, 2004, 10:14:06 AM »
Dang, 3 minutes late :)

SMadsen

  • Guest
Block select Lisp needed...
« Reply #13 on: August 26, 2004, 10:18:13 AM »
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

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #14 on: August 26, 2004, 10:23:06 AM »
I just changed mine a bit but it didn't help!

thanks Stig that's nice.
TheSwamp.org  (serving the CAD community since 2003)

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #15 on: August 26, 2004, 10:56:48 AM »
Man I have a LOT of tweaking to do. I'm not even close to matching that Stig.
TheSwamp.org  (serving the CAD community since 2003)

hudster

  • Gator
  • Posts: 2848
Block select Lisp needed...
« Reply #16 on: August 26, 2004, 11:07:21 AM »
Many thanks, I owe you one.

Works great.  I changed the end to pre-assign a layer for the blocks to be moved to. :)
Revit BDS 2017, 2016, 2015, 2014, AutoCAD 2017, 2016, Navisworks 2017, 2016, BIM360 Glue

SMadsen

  • Guest
Block select Lisp needed...
« Reply #17 on: August 26, 2004, 11:10:25 AM »
Quote from: Mark Thomas
Man I have a LOT of tweaking to do. I'm not even close to matching that Stig.

Well, you know my opinion on the VLA stuff .. don't use it if it doesn't serve a purpose :)

Glad you could use it, Hudster

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Block select Lisp needed...
« Reply #18 on: August 26, 2004, 05:57:34 PM »
Quote from: Mark Thomas
Man I have a LOT of tweaking to do. I'm not even close to matching that Stig.

Seems to me your biggest tweak will be creating a selection set of attributed blocks so you don't step through every entity.

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #19 on: August 27, 2004, 07:27:02 AM »
Quote from: Jeff_M
Seems to me your biggest tweak will be creating a selection set of attributed blocks so you don't step through every entity.

I agree Jeff.

Changing mine to use the ss method like Mr. Madsen appears to be a bit faster. than his. :D
Code: [Select]


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

(defun get-attribs (obj)
  (vlax-safearray->list
    (vlax-variant-value
      (vla-GetAttributes obj)
      )
    )
  )


(defun check-for-char (obj char / attribs ans_lst)

  (setq attribs (get-attribs obj))

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

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

(defun gbwa (/ time sset a obj)
  (setq time (getvar "MILLISECS"))
  (cond ((setq sset (ssget "X" '((0 . "INSERT") (66 . 1))))
         (setq a 0)
         (repeat (sslength sset)
                 (setq obj (vlax-ename->vla-object (ssname sset a)))
                 (if (check-for-char obj "E")
                   (vla-put-layer obj "0"); change layer name here
                   )
                 (vlax-release-object obj)
                 (setq a (1+ a))
                 )
         )
        (T (princ "No attributed blocks found"))
        )
  (timer time)
  (princ)
  )
TheSwamp.org  (serving the CAD community since 2003)

daron

  • Guest
Block select Lisp needed...
« Reply #20 on: August 27, 2004, 08:23:31 AM »
Hey Mark? Remember that recursive ss->vla-object function you built? I was wondering if you made that work in here somehow, what the speed difference would be?  At the same time, I've given some thought on Jeff's comment. The differences appear to be that your initial routine scans the entire modelspace (every entity in it), whereas the 66 . 1 still has to scan every block in the drawing paper and modelspace. I was wondering if you went back to your first version and set it up to look for blocks in modelspace only, would that also increase the speed?


BTW, can you post your results between routines?

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #21 on: August 27, 2004, 08:29:19 AM »
Quote from: Daron
Hey Mark? Remember that recursive ss->vla-object function you built? I was wondering if you made that work in here somehow, what the speed difference would be?

I kinda doubt it.
Quote
At the same time, I've given some thought on Jeff's comment. The differences appear to be that your initial routine scans the entire modelspace (every entity in it), whereas the 66 . 1 still has to scan every block in the drawing paper and modelspace. I was wondering if you went back to your first version and set it up to look for blocks in modelspace only, would that also increase the speed?

It was modelspace only, I think!


Quote
BTW, can you post your results between routines?

sure will.
TheSwamp.org  (serving the CAD community since 2003)

daron

  • Guest
Block select Lisp needed...
« Reply #22 on: August 27, 2004, 08:35:58 AM »
The first routine was just modelspace, but every entity in that space i.e. lines arcs. The (ssget "x" 66 . 1) scans every BLOCK object in the database. That includes paperspace. I think you could bring the numbers down by searching blocks in modelspace. I'm not sure how complicated that would be since the spaces (model/paper) are considered a block object, too. Would be neat to see.

SMadsen

  • Guest
Block select Lisp needed...
« Reply #23 on: August 27, 2004, 08:43:58 AM »
Excellent, Mark.
Here are times for 20 runs on 100 blocks, each containing 7 attributes:

;; GBWA
(/ (+ 0.2500 0.2340 0.2350 0.2190 0.2190 0.2190 0.2180 0.2180 0.2180 0.2190
      0.2190 0.2340 0.2810 0.2190 0.2180 0.2190 0.2190 0.2190 0.2190 0.2180) 20.0)
;; average time = 0.2257

;; C:ATTLAY
(/ (+ 0.2190 0.2190 0.2350 0.2190 0.2190 0.2810 0.2180 0.2190 0.2180 0.2190
      0.2960 0.2190 0.2340 0.2340 0.2190 0.2810 0.2190 0.2180 0.2190 0.2190) 20.0)
;; average time = 0.2312

Bypassing COMMAND and moving the blocks directly from the SSNAME loop - same method as you are using - gives these times:

;; ATTLAY
(/ (+ 0.2030 0.2190 0.2030 0.2190 0.2030 0.2810 0.2030 0.2190 0.2340 0.2190
      0.2660 0.2190 0.2030 0.2190 0.2180 0.2810 0.2190 0.2190 0.2030 0.2190) 20.0)
;; average time = 0.22345

All in all a draw, I would say.

Code used for changing blocks directly:
Code: [Select]
(defun attlay (/ a ent entl sset)
  (setq time (getvar "MILLISECS"))
  (cond ((setq sset (ssget "X" '((0 . "INSERT") (66 . 1))))
         (setq a 0)
         (repeat (sslength sset)
           (setq ent (ssname sset a)
                 a   (1+ a)
           )
           (and (getAttrib ent "*E")
                (setq entl (entget ent))
                (entmod (subst (cons 8 "0")(assoc 8 entl) entl))
           )
         )
        )
  )
  (timer time)
  (princ)
)

daron

  • Guest
Block select Lisp needed...
« Reply #24 on: August 27, 2004, 08:50:40 AM »
Cool, Stig. Mark, I just looked into what I was saying and it doesn't appear that you can separate the blocks through their space and search them out. At least not without some back door maneuvering, which would most likely take longer. Bummer.

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #25 on: August 27, 2004, 08:54:27 AM »
Here's what I get. (although remember I *AM* using the SS method as presented by Mr. Madsen)

Code: [Select]

Details;
1 block (block1) 3 attributes
10,000 insertions of block1.
2,500 contain the string ("E") in one on the attributes we are looking for.

SMadsen
Elapsed time: 3.1100 seconds

MThomas
Elapsed time: 2.1410 seconds
TheSwamp.org  (serving the CAD community since 2003)

SMadsen

  • Guest
Block select Lisp needed...
« Reply #26 on: August 27, 2004, 08:59:43 AM »
Quote from: Mark Thomas

Code: [Select]

SMadsen
Elapsed time: 3.1100 seconds

MThomas
Elapsed time: 2.1410 seconds

Is that mine with the COMMAND method or SUBST method?

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #27 on: August 27, 2004, 09:09:34 AM »
>Is that mine with the COMMAND method or SUBST method?
command
TheSwamp.org  (serving the CAD community since 2003)

SMadsen

  • Guest
Block select Lisp needed...
« Reply #28 on: August 27, 2004, 09:11:17 AM »
Okie
Do you have a chance of running the latter method also?

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #29 on: August 27, 2004, 09:14:00 AM »
Yep, I'll be done in a sec.............
TheSwamp.org  (serving the CAD community since 2003)

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #30 on: August 27, 2004, 09:20:21 AM »
Code: [Select]

Details;
1 block (block1) 3 attributes
10,000 insertions of block1.
2,500 contain the string ("E") in one on the attributes we are looking for.

SMadsen (SUBST method)
Elapsed time: 3.2030 seconds

MThomas
Elapsed time: 2.0160 seconds
TheSwamp.org  (serving the CAD community since 2003)

SMadsen

  • Guest
Block select Lisp needed...
« Reply #31 on: August 27, 2004, 09:23:39 AM »
Wow, slower? Hmmm
Ok, I'll bite the dust :D

Thanks Mark

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #32 on: August 27, 2004, 09:45:32 AM »
Just to make sure I ran it again, without closing the dwg, and the results ..........
Code: [Select]

Command: (gc)
nil

Command:
Command: (LOAD "D:/home/src/AutoLisp/Working/chg-blk-to-lay.lsp") ATTLAY


Command: (attlay)
Elapsed time: 3.2340 seconds

Command: change

Select objects: Specify opposite corner: 2500 found

Select objects:
Specify change point or [Properties]: p

Enter property to change [Color/Elev/LAyer/LType/ltScale/LWeight/Thickness]: la

Enter new layer name <0>: blocks

Enter property to change [Color/Elev/LAyer/LType/ltScale/LWeight/Thickness]:

Command: (gc)
nil

Command: (gbwa)
Elapsed time: 2.1410 seconds
TheSwamp.org  (serving the CAD community since 2003)

SMadsen

  • Guest
Block select Lisp needed...
« Reply #33 on: August 27, 2004, 10:14:57 AM »
Quote from: Mark Thomas
Just to make sure ...

Yeah right .. just rub it in   :lol:

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Block select Lisp needed...
« Reply #34 on: August 27, 2004, 10:18:04 AM »
So does that mean USA takes the gold?

(Pthhhht! "Denmark" ...like they even had a chance?!")
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

SMadsen

  • Guest
Block select Lisp needed...
« Reply #35 on: August 27, 2004, 10:20:16 AM »
Oh USA always think they are entitled to the gold, whether they deserve it or not .. didn't you know?  :twisted:

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Block select Lisp needed...
« Reply #36 on: August 27, 2004, 10:22:15 AM »
It would be interesting to see how well VBA did on this? Any takers ..................
TheSwamp.org  (serving the CAD community since 2003)

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Block select Lisp needed...
« Reply #37 on: August 27, 2004, 10:26:06 AM »
Pthhht! 'Knew it', Hell that expectation comes second nature by now.
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

SMadsen

  • Guest
Block select Lisp needed...
« Reply #38 on: August 27, 2004, 10:36:05 AM »
Quote from: Se7en
Pthhht! 'Knew it', Hell that expectation comes second nature by now.

Likewise :D

daron

  • Guest
Block select Lisp needed...
« Reply #39 on: August 27, 2004, 11:58:28 AM »
Quote from: SMadsen
Oh USA always think they are entitled to the gold, whether they deserve it or not .. didn't you know?  :twisted:


I thought that was Russia. I'm surprised they'd been so well behaved about it this year.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Block select Lisp needed...
« Reply #40 on: August 27, 2004, 12:00:03 PM »
Ok folks you asked for it......

My testing results on a drawing with .....

one block "block1" , 10000 insertions
three attributes, each with a value
2500 blocks had one value with an "e" or "E"

(attlay)
2.1870 seconds
(gbwa)
2.0641 seconds
VBA code below
0.5939 seconds

BUWAHAHAHAHAHAHAHAHAHA

Code: [Select]

Sub ChBlLayer()
 Dim SS As AcadSelectionSet
 Dim ATTS As Variant
 Dim Code As Variant
 Dim Data As Variant
 Dim GCode(1) As Integer
 Dim GData(1) As Variant
 Dim BRef As AcadBlockReference
 Dim STime As Variant
 Dim ETime As Variant
 STime = TimeIt
 
 GData(0) = "INSERT"
 GData(1) = 1
 GCode(0) = 0
 GCode(1) = 66
 
 Code = GCode
 Data = GData
 
 Set SS = ThisDrawing.SelectionSets.Add("test2")
 SS.Select acSelectionSetAll, , , Code, Data
 For Each BRef In SS
  ATTS = BRef.GetAttributes
  For X = 0 To UBound(ATTS)
  If InStr(1, ATTS(X).TextString, "e", 1) > 0 Then
   BRef.Layer = "0" 'put me on this layer
   X = UBound(ATTS) + 1
  End If
  Next X
 Next BRef
 SS.Delete
 ETime = TimeIt
 MsgBox ETime - STime & " Seconds"
End Sub
Function TimeIt()
 Dim CTIME As Variant
 CTIME = ThisDrawing.GetVariable("MILLISECS")
 TimeIt = CTIME / 1000
End Function
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

SMadsen

  • Guest
Block select Lisp needed...
« Reply #41 on: August 27, 2004, 12:34:49 PM »
What's that? TimeIt = CTIME / 10000  ?

Oh, you edited it!  :twisted:

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Block select Lisp needed...
« Reply #42 on: August 27, 2004, 01:26:44 PM »
nope ... never did...
just accept defeat with a grin ...
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie