TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Kerry on July 23, 2008, 08:38:05 PM
-
This has me baffled and I'm wondering if anyone has come across it previously ...
I'm unioning 2 selection sets together.
However, the contents of one of the original sets is changing to the unioned value.
;;--------------------------
;;; Union of two selection sets
(defun KDUB:SSunion (ss1 ss2 / ss index)
(setq ss (ssadd))
(cond ((and ss1 ss2)
(setq ss ss1
index -1
)
(repeat (sslength ss2) (ssadd (ssname ss2 (setq index (1+ index))) ss))
)
((and ss1 (not ss2)) (setq ss ss1))
((and ss2 (not ss1)) (setq ss ss2))
)
(if (> (sslength ss) 0)
(eval ss)
nil
)
)
;;--------------------------
;;--------------------------
(defun testit (/ s1 s2 s3)
(prompt "\nFirst Selection Set")
(setq s1 (ssget))
(prompt "\nSecond Selection Set")
(setq s2 (ssget) )
(princ (sslength s1)) (terpri)
(princ (sslength s2)) (terpri)
;;
(setq s3 (KDUB:SSunion s1 s2))
(prin1 (sslength s1)) (terpri)
(prin1 (sslength s2)) (terpri)
(prin1 (sslength s3)) (terpri)
(princ)
)
;;--------------------------
(testit)
First Selection Set
Select objects: Specify opposite corner: 3 found
Select objects:
Second Selection Set
Select objects: Specify opposite corner: 4 found
Select objects:
3
4
7
4
7
Does this look familiar to anyone ??
-
Doesn't this (setq ss ss1) make them the same ss?
Oops, I'm late for dinner so can't spend much more time here. But you'd need to do the same thing with ss1 as you did with ss2......
-
I may have misunderstood your intent Jeff ..
All the variables are local.
.. and I believe the assignment of variables if by value, not by reference ....
-
This works, and retains the value of the original Selection Sets
... BUT it changes the value of the 'Previous' Selection .. which may upset my users.
(prompt "\nFirst Selection Set")
(setq s1 (ssget))
(prompt "\nSecond Selection Set")
(setq s2 (ssget))
(vl-cmdf "_.SELECT" S1 "_ADD" S2 "")
(setq s3 (ssget "_P"))
-
... BUT it changes the value of the 'Previous' Selection .. which may upset my users.
Which I 'spose could be solved like this ...
(setq original (ssget "_P"))
(prompt "\nFirst Selection Set")
(setq s1 (ssget))
(prompt "\nSecond Selection Set")
(setq s2 (ssget))
(vl-cmdf "_.SELECT" S1 "_ADD" S2 "")
(setq s3 (ssget "_P"))
(vl-cmdf "_.SELECT" original "")
but it's hardly an elegant solution :(
-
Maybe this will do:
(defun KDUB:SSunion (ss1 ss2 / ss index ename)
(setq ss (ssadd))
(cond ((and ss1 ss2)
(setq index -1)
(while (setq ename (ssname ss1 (setq index (1+ index))))
(ssadd ename ss))
(setq index -1)
(while (setq ename (ssname ss2 (setq index (1+ index))))
(ssadd ename ss))
)
((and ss1 (not ss2)) (setq ss ss1))
((and ss2 (not ss1)) (setq ss ss2))
)
(if (> (sslength ss) 0)
(eval ss)
nil
)
)
-
Hi Alan, I'd come to a similar solution ..
Jeff's comment
... But you'd need to do the same thing with ss1 as you did with ss2......
got me thinking along the correct track :-)
(defun kdub:ssunion (ss1 ss2 / ss index)
(setq ss (ssadd))
(cond ((and ss1 ss2)
(setq index -1)
(repeat (sslength ss1) (ssadd (ssname ss1 (setq index (1+ index))) ss))
(setq index -1)
(repeat (sslength ss2) (ssadd (ssname ss2 (setq index (1+ index))) ss))
)
((and ss1 (not ss2)) (setq ss ss1))
((and ss2 (not ss1)) (setq ss ss2))
)
(if (> (sslength ss) 0)
(eval ss)
nil
)
)
-
I think WHILE is faster. 8-)
-
:police: :lol:
Benchmarking ............Elapsed milliseconds / relative speed for 512 iteration(s):
(KDUB:SSUNION S1 S2).....1609 / 1 <fastest>
(CAB:SSUNION S1 S2)......1609 / 1 <slowest>
Benchmarking ............Elapsed milliseconds / relative speed for 512 iteration(s):
(CAB:SSUNION S1 S2)......1609 / 1.01 <fastest>
(KDUB:SSUNION S1 S2).....1625 / 1 <slowest>
-
I found this on some old stuff:
;SUBSTRACT "SS2" FROM "SS1" CREATES "SS3"
(defun ssdiff (ss1 ss2 / ss3 n obj)
(setq ss3 ss1 n 0)
(repeat (sslength ss2)
(progn
(setq obj (ssname ss2 n))
(if (ssmemb obj ss3) (ssdel obj ss3))
(setq n (1+ n))
)
)
ss3
);defun
(defun ssunion (ss1 ss2 / hilite ss3)
(setq hilite (getvar "HIGHLIGHT"))
(setvar "HIGHLIGHT" 0)
(command "SELECT" ss1 ss2 "")
(setq ss3 (ssget "P"))
(setvar "HIGHLIGHT" hilite)
ss3
)
-
I was JUST testing the relative speed of my previous COMMAND based post ...
(defun COMMAND:SSunion (ss1 ss2 / s3)
(vl-cmdf "_.SELECT" SS1 "_ADD" SS2 "")
(setq s3 (ssget "_P"))
) (prompt "\nFirst Selection Set")
(setq s1 (ssget))
(prompt "\nSecond Selection Set")
(setq s2 (ssget) )
(BenchMark
'(
(KDUB:SSunion s1 s2)
(CAB:SSunion s1 s2)
(COMMAND:SSunion s1 s2)
)
)
Benchmarking ............Elapsed milliseconds / relative speed for 512 iteration(s):
(COMMAND:SSUNION S1 S2)......1078 / 2.1 <fastest>
(CAB:SSUNION S1 S2)......2250 / 1.01
(KDUB:SSUNION S1 S2).....2265 / 1 <slowest>
-
COMMAND faster, that's unexpected. :-)
-
IMHO, there is no reason to use the (cond). If the user is calling a function to UNION 2 selection sets, it should be the responsibility of the calling function to ensure there are 2 valid ssets. Otherwise the validity check should be checking that they are selections sets, not just that they are not nil. But that's just me... :-)
Here's what I thought of, no benchmark to test with though.
(defun JMM:ssunion (ss1 ss2 / ss)
(setq ss (ssadd))
(foreach ssinput (list ss1 ss2)
(mapcar '(lambda (x)
(if (= (type (cadr x)) 'ENAME)
(ssadd (cadr x) ss)
)
)
(ssnamex ssinput)
)
)
ss
)
-
My condensed version.
(defun KDUB:SSunion (ss1 ss2 / ss)
(setq ss (ssadd))
(foreach selset (list ss1 ss2)
(mapcar (function (lambda (x) (ssadd x ss)))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))))
)
(if (not (zerop (sslength ss)))
(eval ss)
)
)
-
there is (acet-ss-union (list s1 s2)) in Express Tools
and it works with several selection sets :
(acet-ss-union (list s1 s2 s3 s4 .....))
Bruno
-
(defun th-all-ssset-union (sslst / lst ss)
(setq ss (ssadd))
(foreach each sslst
(setq lst (append
(hao-ss2lst each)
lst
)
)
)
(foreach each lst
(ssadd each ss)
)
ss
)
(defun hao-ss2lst (ss / n l)
(if (and
ss
(< 0 (sslength ss))
)
(repeat (setq n (sslength ss))
(setq n (1- n)
l (cons (ssname ss n) l)
)
)
)
)
(defun th-lst2ss (l / ss)
(setq ss (ssadd))
(foreach e l
(if (= (type e) 'ename)
(ssadd e ss)
)
)
(if (> (sslength ss) 0)
(eval ss)
nil
)
)
(defun hao-all-ssset-union (sslst)
(th-lst2ss (apply
'append
(mapcar
(function (lambda (x)
(hao-ss2lst x)
)
)
sslst
)
)
)
)
-
mine
(defun BT0:ssUnion (sslst / s x n)
(setq sslst (vl-remove-if-not '(lambda (x) (= (type x) 'PICKSET)) sslst))
(cond
((= (length sslst) 0) nil)
((= (length sslst) 1) (eval (car sslst)))
(T
(setq s (ssadd))
(foreach x sslst
(repeat (setq n (sslength x))
(ssadd (ssname x (setq n (1- n))) s)
)
)
(eval s)
)
)
)
Bruno Toniutti