[编程交流] 具有z值的二维对象

(defun ss=ss1+ss2 ( ss1 ss2 / lst1 n1 lst2 n2 lst n ss )
 (setq n1 (if (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss1))) 0 (sslength ss1)))
 (repeat n1
   (setq lst1 (cons (ssname ss1 (setq n1 (1- n1))) lst1))
 )
 (setq n2 (if (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss2))) 0 (sslength ss2)))
 (repeat n2
   (setq lst2 (cons (ssname ss2 (setq n2 (1- n2))) lst2))
 )
 (if (eq lst1 nil) (setq lst lst2))
 (if (eq lst2 nil) (setq lst lst1))
 (if (and lst1 lst2)
 (progn
 (foreach ent lst2
   (if (not (member ent lst1)) (setq lst (cons ent lst)))
 )
 (setq lst (append lst1 lst))
 )
 )
 (setq ss (ssadd))
 (foreach ent lst
   (ssadd ent ss)
 )
 ss
)
(defun ss=ss1-ss2 ( ss1 ss2 / lst1 n1 lst2 n2 lst n ss )
 (setq n1 (if (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss1))) 0 (sslength ss1)))
 (repeat n1
   (setq lst1 (cons (ssname ss1 (setq n1 (1- n1))) lst1))
 )
 (setq n2 (if (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss2))) 0 (sslength ss2)))
 (repeat n2
   (setq lst2 (cons (ssname ss2 (setq n2 (1- n2))) lst2))
 )
 (if (eq lst1 nil) (setq lst nil))
 (if (eq lst2 nil) (setq lst lst1))
 (if (and lst1 lst2) (setq lst (append lst1 lst2)))
 (setq ss (ssadd))
 (foreach ent lst
   (if (and (not (member ent lst2)) (not (member ent (cdr (member ent lst))))) (ssadd ent ss))
 )
 ss
)
(defun sspointselev0 ( / ssnew ss n entlst ent )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "POINT"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (mapcar '(lambda (x) (if (= (car x) 10) (if (equal (cadddr x) 0.0 1e- (ssadd ent ssnew)))) entlst)
 )
 ssnew
)
(defun sslwpolyselev0 ( / ssnew ss n entlst ent )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (if (and (equal (assoc 210 entlst) '(210 0.0 0.0 1.0) 1e- (equal (cdr (assoc 38 entlst)) 0.0 1e-) (ssadd ent ssnew))
 )
 ssnew
)
(defun sspolylineselev0 ( / ssnew ss n entlst ent en tst )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "POLYLINE"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (setq en ent)
   (while (eq (cdr (assoc 0 (entget (setq en (entnext en))))) "VERTEX")
     (mapcar '(lambda (x) (if (= (car x) 10) (if (equal (cadddr x) 0.0 1e- (setq tst (cons T tst)) (setq tst (cons nil tst))))) (entget en))
   )
   (if (eval (cons 'and tst)) (ssadd ent ssnew))
   (setq tst nil)
 )
 ssnew
)
(defun ssinsertselev0 ( / ssnew ss n entlst ent )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "INSERT"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (if (and (equal (assoc 210 entlst) '(210 0.0 0.0 1.0) 1e- (equal (cadddr (assoc 10 entlst)) 0.0 1e-) (ssadd ent ssnew))
 )
 ssnew
)
(defun sslineselev0 ( / ssnew ss n entlst ent )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "LINE"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (if (and (equal (assoc 210 entlst) '(210 0.0 0.0 1.0) 1e- (equal (cadddr (assoc 10 entlst)) 0.0 1e- (equal (cadddr (assoc 11 entlst)) 0.0 1e-) (ssadd ent ssnew))
 )
 ssnew
)
(defun sscircleselev0 ( / ssnew ss n entlst ent )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "CIRCLE"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (if (and (equal (assoc 210 entlst) '(210 0.0 0.0 1.0) 1e- (equal (cadddr (assoc 10 entlst)) 0.0 1e-) (ssadd ent ssnew))
 )
 ssnew
)
(defun ssarcselev0 ( / ssnew ss n entlst ent )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "ARC"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (if (and (equal (assoc 210 entlst) '(210 0.0 0.0 1.0) 1e- (equal (cadddr (assoc 10 entlst)) 0.0 1e-) (ssadd ent ssnew))
 )
 ssnew
)
(defun ssellipseselev0 ( / ssnew ss n entlst ent )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "ELLIPSE"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (if (and (equal (assoc 210 entlst) '(210 0.0 0.0 1.0) 1e- (equal (cadddr (assoc 10 entlst)) 0.0 1e- (equal (cadddr (assoc 11 entlst)) 0.0 1e-) (ssadd ent ssnew))
 )
 ssnew
)
(defun sssplineselev0 ( / ssnew ss n entlst ent tst10 tst11 )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "SPLINE"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (mapcar '(lambda (x) (if (= (car x) 10) (if (equal (cadddr x) 0.0 1e- (setq tst10 (cons T tst10)) (setq tst10 (cons nil tst10))))) entlst)
   (mapcar '(lambda (x) (if (= (car x) 11) (if (equal (cadddr x) 0.0 1e- (setq tst11 (cons T tst11)) (setq tst11 (cons nil tst11))))) entlst)
   (if (and (equal (assoc 210 entlst) '(210 0.0 0.0 1.0) 1e- (eval (cons 'and tst10)) (eval (cons 'and tst11))) (ssadd ent ssnew))
   (setq tst10 nil tst11 nil)
 )
 ssnew
)
(defun ssdimensionselev0 ( / ssnew ss n entlst ent )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "DIMENSION"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (if (and (equal (assoc 210 entlst) '(210 0.0 0.0 1.0) 1e- (equal (cadddr (assoc 10 entlst)) 0.0 1e- (equal (cadddr (assoc 11 entlst)) 0.0 1e- (equal (cadddr (assoc 12 entlst)) 0.0 1e- (equal (cadddr (assoc 13 entlst)) 0.0 1e- (equal (cadddr (assoc 14 entlst)) 0.0 1e- (equal (cadddr (assoc 15 entlst)) 0.0 1e- (equal (cadddr (assoc 16 entlst)) 0.0 1e-) (ssadd ent ssnew))
 )
 ssnew
)
(defun sstextselev0 ( / ssnew ss n entlst ent )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "TEXT"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (if (and (equal (assoc 210 entlst) '(210 0.0 0.0 1.0) 1e- (equal (cadddr (assoc 10 entlst)) 0.0 1e-) (ssadd ent ssnew))
 )
 ssnew
)
(defun ssmtextselev0 ( / ssnew ss n entlst ent )
 (setq ssnew (ssadd))
 (setq ss (ssget "_X" '((0 . "MTEXT"))))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq entlst (entget (setq ent (ssname ss (setq n (1- n))))))
   (if (and (equal (assoc 210 entlst) '(210 0.0 0.0 1.0) 1e- (equal (cadddr (assoc 10 entlst)) 0.0 1e-) (ssadd ent ssnew))
 )
 ssnew
)
(defun selallelev0 ( / ss )
 (setq ss (ssadd))
 (setq ss (ss=ss1+ss2 (sspointselev0) ss))
 (setq ss (ss=ss1+ss2 (sslwpolyselev0) ss))
 (setq ss (ss=ss1+ss2 (sspolylineselev0) ss))
 (setq ss (ss=ss1+ss2 (ssinsertselev0) ss))
 (setq ss (ss=ss1+ss2 (sslineselev0) ss))
 (setq ss (ss=ss1+ss2 (sscircleselev0) ss))
 (setq ss (ss=ss1+ss2 (ssarcselev0) ss))
 (setq ss (ss=ss1+ss2 (ssellipseselev0) ss))
 (setq ss (ss=ss1+ss2 (sssplineselev0) ss))
 (setq ss (ss=ss1+ss2 (ssdimensionselev0) ss))
 (setq ss (ss=ss1+ss2 (sstextselev0) ss))
 (setq ss (ss=ss1+ss2 (ssmtextselev0) ss))
 ss
)
(defun c:selallelev=0 nil
 (sssetfirst nil (selallelev0))
 (princ)
)
(defun c:selallelev/=0 nil
 (sssetfirst nil (ss=ss1-ss2 (ssget "_X") (selallelev0)))
 (princ)
)
(princ)
(princ "\nFor selecting all objects in elev=0.0 use : selallelev=0\nFor selecting all objects in elev/=0.0 use : selallelev/=0")
(textpage)
(princ)

(defun ss=ss1-ss2 ( ss1 ss2 / lst1 n1 lst2 n2 lst n ss )
 (setq n1 (if (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss1))) 0 (sslength ss1)))
 (repeat n1
   (setq lst1 (cons (ssname ss1 (setq n1 (1- n1))) lst1))
 )
 (setq n2 (if (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss2))) 0 (sslength ss2)))
 (repeat n2
   (setq lst2 (cons (ssname ss2 (setq n2 (1- n2))) lst2))
 )
 (if (eq lst1 nil) (setq lst nil))
 (if (eq lst2 nil) (setq lst lst1))
 (if (and lst1 lst2) (setq lst (append lst1 lst2)))
 (setq ss (ssadd))
 (foreach ent lst
   (if (and (not (member ent lst2)) (not (member ent (cdr (member ent lst))))) (ssadd ent ss))
 )
 ss
)
(defun selallelev0 ( / ss ssnew n ent entA minpt maxpt ) (vl-load-com)
 (setq ssnew (ssadd))
 (setq ss (ssget "_X"))
 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'sslength (list ss)))) (setq n (sslength ss)) (setq n 0))
 (repeat n
   (setq ent (ssname ss (setq n (1- n))))
   (setq entA (vlax-ename->vla-object ent))
   (vla-getboundingbox entA 'minpoint 'maxpoint)
   (setq minpt (vlax-safearray->list minpoint) maxpt (vlax-safearray->list maxpoint))
   (if (and (equal (caddr minpt) 0.0 1e- (equal (caddr maxpt) 0.0 1e-) (ssadd ent ssnew))
 )
 ssnew
)
(defun c:selallelev=0 nil
 (sssetfirst nil (selallelev0))
 (princ)
)
(defun c:selallelev/=0 nil
 (sssetfirst nil (ss=ss1-ss2 (ssget "_X") (selallelev0)))
 (princ)
)
(princ)
(princ "\nFor selecting all objects in elev=0.0 use : selallelev=0\nFor selecting all objects in elev/=0.0 use : selallelev/=0")
(textpage)
(princ)