TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: BuckoAk on November 16, 2010, 03:37:09 PM
-
I have situations where I need to know what titleblocks are inserted so certain lisp programs can run.
I am currently using this statement to locate the titleblocks but when it comes to dynamic blocks it retrieves "(2 . *U52)".
If you list the titleblock it comes back a normal name, is it possible to retrieve the true block name from an anonymous name.
Or possibly add additional code that can gather this info?
Any help would greatly be appreciated.
(setq $CLIENT#2 nil)
;;;********** Check For CLIENT#2
(setq BrdrList (list '"CLIENT2_8x11" '"CLIENT2_22X34"))
(foreach Item BrdrList
(if (= $CLIENT#2 nil)
(setq $CLIENT#2 (ssget "X" (list (cons 0 "INSERT") (cons 2 Item) ))))
);_end foreach
)
-
Perhaps use a SelectionSet of:
(cons 2 (strcat Item ",`*U*"))
Then, when iterating through the SelectionSet, test:
(if (eq Item (vla-get-EffectiveName (vlax-ename->vla-object <entity>)))
...
Oh BTW, quotes are not needed, use
(setq BrdrList (list "CLIENT2_8x11" "CLIENT2_22X34"))
or:
(setq BrdrList '("CLIENT2_8x11" "CLIENT2_22X34"))
-
You could use this sub in place of the ssget call:
(defun GetBlockSelectionSet ( name / ss ) (vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat name ",`*U*")))))
(
(lambda ( i / e )
(while (setq e (ssname ss (setq i (1+ i))))
(if (not (eq name (vla-get-EffectiveName (vlax-ename->vla-object e))))
(ssdel e ss)
)
)
ss
)
-1
)
)
)
Then in your code:
(foreach item '("CLIENT2_8x11" "CLIENT2_22X34")
(if (setq ss (GetBlockSelectionSet item))
...
)
)
-
Thank you very much Lee Mac
I added it to the rest of my code and It works great!
-
Thank you very much Lee Mac
I added it to the rest of my code and It works great!
Good to hear mate :-)
-
I would study Lee's code and try and implement the procedure, rather than just issuing the sub. Right now, you are executing ssget on every `*U* block for each given name - extremely inefficient. Use his method, make one selection with ssget, then filter accordingly and use cond to make appropriate modifications.
-
I would study Lee's code and try and implement the procedure, rather than just issuing the sub. Right now, you are executing ssget on every `*U* block for each given name - extremely inefficient. Use his method, make one selection with ssget, then filter accordingly and use cond to make appropriate modifications.
Completely agree - minimise the number of iterations through the same items.
-
I would study Lee's code and try and implement the procedure, rather than just issuing the sub. Right now, you are executing ssget on every `*U* block for each given name - extremely inefficient. Use his method, make one selection with ssget, then filter accordingly and use cond to make appropriate modifications.
Completely agree - minimise the number of iterations through the same items.
Precisely.
-
I would study Lee's code and try and implement the procedure, rather than just issuing the sub. Right now, you are executing ssget on every `*U* block for each given name - extremely inefficient. Use his method, make one selection with ssget, then filter accordingly and use cond to make appropriate modifications.
I understand what your saying, Now only if I could count on my users to implement the tool the way is was originally intended (by selection).
It gets to be a hassle at submittal time when things are not printing correctly, the main code is only being seen on certain times.
As it stands the code is saving me a lot of hassle and barley puts a dent in processor overhead.
-
You could use this sub in place of the ssget call:
(defun GetBlockSelectionSet ( name / ss ) (vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat name ",`*U*")))))
(
(lambda ( i / e )
(while (setq e (ssname ss (setq i (1+ i))))
(if (not (eq name (vla-get-EffectiveName (vlax-ename->vla-object e))))
(ssdel e ss)
)
)
ss
)
-1
)
)
)
Then in your code:
(foreach item '("CLIENT2_8x11" "CLIENT2_22X34")
(if (setq ss (GetBlockSelectionSet item))
...
)
)
Thank you very much Lee Mac
I added it to the rest of my code and It works great!
Dear Lee Mac and BuckoAk,
What is wrong, when I do a test in the drawing DynBlkTest.dwg I get a wrong result.
Regards Harrie.
(defun GetBlockSelectionSet ( name / ss ) (vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat name ",`*U*")))))
(
(lambda ( i / e )
(while (setq e (ssname ss (setq i (1+ i))))
(if (not (eq name (vla-get-EffectiveName (vlax-ename->vla-object e))))
(ssdel e ss)
)
)
ss
)
-1
)
)
)
(defun C:test(/ )
(princ "\n***************************Test*********************************************")
(princ "\n*******In drawing DynBlkTest.dwg I count 12 Cars and 6 Trees****************")
(princ "\n****************************************************************************\n")
(princ "\n****************************************************************************")
(princ "\n************************Test Results****************************************")
(setq S nil S (GetBlockSelectionSet "Car"))
(setq SL (sslength s))
(If (= SL 12)
(princ "\nThis result is good, because the selection set for the block 'Car' Counts 12")
(princ (strcat "\nThis result is wrong, because the selection set for the block 'Car' Counts " (itoa SL)))
)
(princ "\n****************************************************************************")
(setq S nil S (GetBlockSelectionSet "Tree"))
(setq SL (sslength s))
(If (= SL 6)
(princ "\nThis result is good, because the selection set for the block 'Tree' Counts 6")
(princ (strcat "\nThis result is wrong, because the selection set for the block 'Tree' Counts " (itoa SL)))
)
(princ "\n****************************************************************************")
(textpage)
(princ)
)
-
Try this
(defun getblocksbyname (bname / ss)
(vl-load-com)
(if (setq ss (ssget "_X"
(list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
(vl-remove-if
'(lambda (blk) (not (eq bname (vla-get-effectivename blk))))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
)
)
;;;Use:
(alert (strcat " Selected: "(itoa (length(getblocksbyname "Car")))" blocks \"Car\""));<-case-sensitive
-
Try this
(defun getblocksbyname (bname / ss)
(vl-load-com)
(if (setq ss (ssget "_X"
(list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
(vl-remove-if
'(lambda (blk) (not (eq bname (vla-get-effectivename blk))))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
)
)
;;;Use:
(alert (strcat " Selected: "(itoa (length(getblocksbyname "Car")))" blocks \"Car\""));<-case-sensitive
Thanks Fixo,
(alert (strcat " Selected: "(itoa (length(getblocksbyname "Car")))" blocks \"Car\""))
and
(alert (strcat " Selected: "(itoa (length(getblocksbyname "Tree")))" blocks \"Tree\""))
gives a good result in DynBlkTest.dwg.
Regards Harrie.
-
Glad, if so
Cheers :)
-
Dear Fixo,
But how I get the selection set?
I want to change the Visibility State in PROPERTIES.
Is this the correct way:
(defun GetBlocksByName2 (bname / ss)
(vl-load-com)
(if (setq ss
(ssget "_X"
(list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))
)
)
(progn
(setq SSLst
(vl-remove-if
'(lambda (blk)
(not (eq (strcase bname) (strcase (vla-get-effectivename blk))))
)
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
)
)
(setq i 0
ss nil
ss (ssadd)
)
(repeat (length SSLst)
(setq ss (ssadd (vlax-vla-object->ename (nth i SSLst)) ss))
(setq i (1+ i))
)
)
)
ss
)
and for drawing DynBlkTest.dwg with dynamic block Tree
(alert (strcat " Selected: "(itoa (sslength (GetBlocksByName2 "Tree")))" blocks \"Tree\""))
and
(command "_.SELECT" (GetBlocksByName2 "Tree"))
and
(command "_.PSELECT" (GetBlocksByName2 "Tree") "")
Regards Harrie.
-
Look into sssetfirst:
(defun getblocksbyname2 (bname / obj ss ss2)
(vl-load-com)
(setq ss2 (ssadd))
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
(foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq obj (vlax-ename->vla-object blk))
(and (eq (strcase bname) (strcase (vla-get-effectivename obj))) (setq ss2 (ssadd blk ss2)))
)
)
(sssetfirst nil ss2)
)
-
cat...
(defun getBlocksByName (bname / ss)
(vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
((lambda (i n / e)
(while (setq e (ssname ss (setq i (1+ i))))
(or (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e)))) (ssdel e ss))
)
(sssetfirst nil ss)
)
-1
(strcase bname)
)
)
)
-
Thanks Ronjonp,
But I prefer it, like this:
(defun getblocksbyname2 (bname / obj ss ss2)
(vl-load-com)
(setq ss2 (ssadd))
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
(foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq obj (vlax-ename->vla-object blk))
(and (eq (strcase bname) (strcase (vla-get-effectivename obj))) (setq ss2 (ssadd blk ss2)))
)
)
;(sssetfirst nil ss2)
ss2
)
Because with (sssetfirst nil ss2), I can't use it in _.PSELECT from PROPERTIES.
Regards, Harrie.
-
Thanks Alanjt,
But your program gives the same problem as the program from Lee Mac.
Regards, Harrie.
-
cat...
(defun getBlocksByName (bname / ss)
(vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
((lambda (i n / e)
(while (setq e (ssname ss (setq i (1+ i))))
(or (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e)))) (ssdel e ss))
)
(sssetfirst nil ss)
)
-1
(strcase bname)
)
)
)
Alan, while you're removing items from the selection set you're stepping, you cannot increment with 1+ systematically...
EDIT: Same problem with Lee's code.
Increment by 1+ only if the item isn't deleted
(defun getBlocksByName (bname / ss)
(vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
((lambda (i n / e)
(while (setq e (ssname ss i))
(if (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e))))
(setq i (1+ i))
(ssdel e ss)
)
)
(sssetfirst nil ss)
)
0
(strcase bname)
)
)
)
Or décrement (1-)
(defun getBlocksByName (bname / ss)
(vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
((lambda (i n / e)
(while (setq e (ssname ss (setq i (1- i))))
(or (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e)))) (ssdel e ss))
)
(sssetfirst nil ss)
)
(sslength ss)
(strcase bname)
)
)
)
-
Just a little FYI.
This is over kill
(setq ss2 (ssadd blk ss2))
You only need this:
(ssadd blk ss2) ; adds blk to selection set
-
Thanks Gile,
Your programs gives a good result in DynBlkTest.dwg.
But, I prefer at the end:
)
ss
)
Because then I can use it in _.PSELECT from PROPERTIES.
Regards, Harrie.
-
Thanks Gile,
Your programs gives a good result in DynBlkTest.dwg.
But, I prefer at the end:
)
ss
)
Because then I can use it in _.PSELECT from PROPERTIES.
Regards, Harrie.
So, here's the way I'd have written it:
(defun ssBlocksByName (bname / ss n blk)
(vl-load-com)
(if
(setq bname (strcase bname)
ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*"))))
)
(repeat (setq n (sslength ss))
(and
(setq blk (ssname ss (setq n (1- n))))
(/= bname (strcase (vla-get-effectivename (vlax-ename->vla-object blk))))
(ssdel blk ss)
)
)
)
ss
)
-
Thanks Gile,
So, here's the way I'd have written it: Yes.
Regards, Harrie.
-
Crap, I didn't even think about that. Thanks Gile.
cat...
(defun getBlocksByName (bname / ss)
(vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
((lambda (i n / e)
(while (setq e (ssname ss (setq i (1+ i))))
(or (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e)))) (ssdel e ss))
)
(sssetfirst nil ss)
)
-1
(strcase bname)
)
)
)
Alan, while you're removing items from the selection set you're stepping, you cannot increment with 1+ systematically...
EDIT: Same problem with Lee's code.
Increment by 1+ only if the item isn't deleted
(defun getBlocksByName (bname / ss)
(vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
((lambda (i n / e)
(while (setq e (ssname ss i))
(if (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e))))
(setq i (1+ i))
(ssdel e ss)
)
)
(sssetfirst nil ss)
)
0
(strcase bname)
)
)
)
Or décrement (1-)
(defun getBlocksByName (bname / ss)
(vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
((lambda (i n / e)
(while (setq e (ssname ss (setq i (1- i))))
(or (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e)))) (ssdel e ss))
)
(sssetfirst nil ss)
)
(sslength ss)
(strcase bname)
)
)
)
-
Crap, I didn't even think about that. Thanks Gile.
Ditto, completely overlooked that :ugly:
Thanks guys :-)
-
Thanks Ronjonp,
But I prefer it, like this:
(defun getblocksbyname2 (bname / obj ss ss2)
(vl-load-com)
(setq ss2 (ssadd))
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
(foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq obj (vlax-ename->vla-object blk))
(and (eq (strcase bname) (strcase (vla-get-effectivename obj))) (setq ss2 (ssadd blk ss2)))
)
)
;(sssetfirst nil ss2)
ss2
)
Because with (sssetfirst nil ss2), I can't use it in _.PSELECT from PROPERTIES.
Regards, Harrie.
sssetfirst wil select them for you ... what is pselect?
-
Thanks Ronjonp,
But I prefer it, like this:
(defun getblocksbyname2 (bname / obj ss ss2)
(vl-load-com)
(setq ss2 (ssadd))
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
(foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq obj (vlax-ename->vla-object blk))
(and (eq (strcase bname) (strcase (vla-get-effectivename obj))) (setq ss2 (ssadd blk ss2)))
)
)
;(sssetfirst nil ss2)
ss2
)
Because with (sssetfirst nil ss2), I can't use it in _.PSELECT from PROPERTIES.
Regards, Harrie.
sssetfirst wil select them for you ... what is pselect?
The only difference I've ever noticed is that, unlike Select, PSelect will leave the selected item(s) selected.
-
Like this:
(defun GetBlocksByName (bname / obj ss ss2)
(vl-load-com)
(setq ss2 (ssadd))
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
(foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq obj (vlax-ename->vla-object blk))
(and (eq (strcase bname) (strcase (vla-get-effectivename obj))) (ssadd blk ss2))
)
)
ss2
)
(defun c:SELDYNBLK(/ BlkName)
(vl-load-com)
(setq BlkName (getstring "\nEnter block name or <Select>:"))
(if (= BlkName "")
(setq BlkName (vla-get-effectivename (vlax-ename->vla-object(car (entsel)))))
)
(setq S (GetBlocksByName BlkName))
;(princ (strcat "\nThere are " (itoa (sslength S)) " blocks in the selection.\n"))
(command "_.PSELECT" S "")
)
(defun C:SDB() (c:SELDYNBLK))
Regards, HofCAD CSI.
-
Of course, there is another method 8-)
(defun test ( block )
(ssget "_X"
(list
(cons 0 "INSERT")
(cons 2 (LM:BlockList->Str (cons block (LM:AnonymousInstancesof block)) ","))
)
)
)
(defun LM:AnonymousInstancesof ( block / def rec nme ref lst )
(while (setq def (tblnext "BLOCK" (null def)))
(if (= 1 (logand 1 (cdr (assoc 70 def))))
(progn
(setq rec
(entget
(cdr
(assoc 330
(entget
(tblobjname "BLOCK" (setq nme (cdr (assoc 2 def))))
)
)
)
)
)
(while (setq ref (assoc 331 rec))
(if
(and
(eq block (vla-get-effectivename (vlax-ename->vla-object (cdr ref))))
(not (member nme lst))
)
(setq lst (cons nme lst))
)
(setq rec (cdr (member (assoc 331 rec) rec)))
)
)
)
)
(reverse lst)
)
(defun LM:BlockList->Str ( lst del / f )
(defun f ( s ) (if (wcmatch s "`**") (strcat "`" s) s))
(if (cdr lst)
(strcat (f (car lst)) del (LM:BlockList->Str (cdr lst) del))
(f (car lst))
)
)
-
Similar to Lee's but will output a list '(("blockname" (ename1 ename2 ename3)))
(defun rjp-getinsertedblocks (/ b brec inserts name o out)
(while (setq b (tblnext "block" (not b)))
(if (not (assoc 1 b))
;;xref path
(progn (setq name (cdr (assoc 2 b))
brec (entget (cdr (assoc 330 (entget (tblobjname "block" name)))))
inserts (cdr (member '(102 . "{BLKREFS") brec))
inserts (mapcar (function cdr) (cdr (member '(102 . "}") (reverse inserts))))
)
(if (and (setq inserts (vl-remove-if-not (function (lambda (x) (entget x))) inserts))
(setq o (vlax-ename->vla-object (car inserts)))
(vlax-property-available-p o 'effectivename)
(setq name (vla-get-effectivename o))
)
(if (assoc name out)
(setq out (mapcar (function (lambda (x)
(if (eq (car x) name)
(list name (append (cadr x) inserts))
x
)
)
)
out
)
)
(setq out (cons (list name inserts) out))
)
)
)
)
)
(vl-sort out (function (lambda (n1 n2) (< (car n1) (car n2)))))
)
(mapcar '(lambda (x) (print (strcat (car x) " - " (itoa (length (cadr x))))))
(rjp-getinsertedblocks)
)
-
Nice one Ron :wink:
-
Nice one Ron :wink:
Thanks Lee :)