TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: hudster 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.
-
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
-
- Remove any insert that doesn't match {hint: SSREMOVE}
I don't see that in my docs Stig, is that one of your functions?
-
I think he meant ssdel. :)
-
I was wondering the same thing. ssdel comes to mind though.
-
Doh! Yep, SSDEL :roll:
-
Stig you ready for another race?
-
Bring it on :)
What kind, where, how?
-
I'm thinking of solving the problem posted by Hudster. I have (almost) the solution using VLAX methods.
-
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?
-
Here is my first shot at it. It is rather slow.
(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)
)
-
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
(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.
-
Dang, 3 minutes late :)
-
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"))
-
I just changed mine a bit but it didn't help!
thanks Stig that's nice.
-
Man I have a LOT of tweaking to do. I'm not even close to matching that Stig.
-
Many thanks, I owe you one.
Works great. I changed the end to pre-assign a layer for the blocks to be moved to. :)
-
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
-
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.
-
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
(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)
)
-
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?
-
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.
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!
BTW, can you post your results between routines?
sure will.
-
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.
-
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:
(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)
)
-
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.
-
Here's what I get. (although remember I *AM* using the SS method as presented by Mr. Madsen)
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
-
SMadsen
Elapsed time: 3.1100 seconds
MThomas
Elapsed time: 2.1410 seconds
Is that mine with the COMMAND method or SUBST method?
-
>Is that mine with the COMMAND method or SUBST method?
command
-
Okie
Do you have a chance of running the latter method also?
-
Yep, I'll be done in a sec.............
-
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
-
Wow, slower? Hmmm
Ok, I'll bite the dust :D
Thanks Mark
-
Just to make sure I ran it again, without closing the dwg, and the results ..........
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
-
Just to make sure ...
Yeah right .. just rub it in :lol:
-
So does that mean USA takes the gold?
(Pthhhht! "Denmark" ...like they even had a chance?!")
-
Oh USA always think they are entitled to the gold, whether they deserve it or not .. didn't you know? :twisted:
-
It would be interesting to see how well VBA did on this? Any takers ..................
-
Pthhht! 'Knew it', Hell that expectation comes second nature by now.
-
Pthhht! 'Knew it', Hell that expectation comes second nature by now.
Likewise :D
-
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.
-
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
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
-
What's that? TimeIt = CTIME / 10000 ?
Oh, you edited it! :twisted:
-
nope ... never did...
just accept defeat with a grin ...