Topic: can you check my code about area / length filtering

[dussla]

i made some code
that code fucnction is  to filtering  same area /  same length objects
but that is not working correctly
can you test and modify ~~

[CAB]

Try something like this.
Note that this is just an example, not finished code.

Code: [Select]

;;  CAB 11.05.2007
;;  Get a selection set of thawed objects with matching area and layer in current space
(defun AreaMatch (/ ent obj Area2match lst ss ss2)
  (vl-load-com)
  (while
    (not
      (and
        (or (setq ent (car (entsel "\nSelect object to match area & layer.")))
            (prompt "\nMissed, try again."))
        (setq obj (vlax-ename->vla-object ent))
        (or (vlax-property-available-p obj 'area)
            (prompt "\nNo Area for that object, try again."))
      )
    )
  )
  (setq Area2match (vla-get-area obj)
        ss2  (ssadd)
  )
  (if (setq ss (ssget "All" (list (cons 8 (vla-get-layer obj))
                                  (cons 410 (getvar "ctab")))))
    (progn
      (setq lst (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex ss))))
      (mapcar
        '(lambda (x)
           (if (and (vlax-property-available-p x 'area)
                    (equal Area2match (vla-get-area x) 0.001))
             (ssadd (vlax-vla-object->ename x) ss2)
           )
         )
        lst
      )
    )
  )
  (if (and ss (not(zerop(sslength ss2))))
    ss2
  )
)

(defun c:test( / ss)
  (if (setq ss (AreaMatch))
    (command "_.move" ss "")
  )
  (princ)
)

[dussla]

thank you answer
i will test soon
if i want to filter  same perimeter (= length ) about entry ?
sorry  i dont know obejct arx programing well
~~~

[CAB]

Try this for length:

Code: [Select]

;;  CAB 11.06.2007
;;  Get a selection set of thawed objects in current space with matching length a
;;  Option to match layer too
;;  Note that the object my not have a length property but may still have a length
;;  via the vlax-curve function
;;  Highlights the selected items & returns the selection set
(defun c:lSel (/ fuzz ent obj layFilter Length2match lst ss ss2 len)
  (vl-load-com)
  (setq fuzz  0.001)
  (while
    (not
      (and
        (or (setq ent (car (entsel "\nSelect object to match length & layer.")))
            (prompt "\nMissed, try again."))
        (setq obj (vlax-ename->vla-object ent))
        (or (not (vl-catch-all-error-p
                   (vl-catch-all-apply
                      'vlax-curve-getdistatparam (list obj 0.1))))
             (prompt "\nNo Length for that object, try again."))
      )
    )
  )
  (initget "Yes No")
  (if (equal (getkword "\nMatch layer too? [Yes/No]<Yes>: ") "No")
     (setq layFilter '(8 . "*"))
     (setq layFilter (cons 8 (vla-get-layer obj)))
  )
  (setq Length2match (vlax-curve-getdistatparam  obj
                       (vlax-curve-getendparam obj))
        ss2  (ssadd)
  )
  (prompt (strcat "\nLength to matcn = " (rtos Length2match)))
  (prompt "\nSelect objects or ENTER for All objects in this space.")
  (if (or (setq ss (ssget (list layFilter (cons 410 (getvar "ctab")))))
          (setq ss (ssget "_All" (list layFilter (cons 410 (getvar "ctab"))))))
    (progn
      (setq lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (mapcar
        '(lambda (x)
           (if (and
                 (not (vl-catch-all-error-p
                        (setq len (vl-catch-all-apply
                                     'vlax-curve-getdistatparam
                                         (list x (vlax-curve-getendparam x))))))
                 (equal Length2match len fuzz))
             (ssadd (vlax-vla-object->ename x) ss2)
           )
         )
        lst
      )
    )
  )
  (sssetfirst)
  (print)
  (if (and ss (not(zerop(sslength ss2))))
    (cadr(sssetfirst nil ss2))
  )
)
<edit: bug fixed>

[CAB]

Here is one for area that is a more polished version.

Code: [Select]

;;  Sel by Area.lsp

;;  CAB 11.05.2007
;;  Get a selection set of thawed objects in current space with matching area
;;  Option to match layer too
;;  Highlights the selected items & returns the selection set
(defun c:aSel (/ fuzz ent obj layFilter Area2match lst ss ss2)
  (vl-load-com)
  (setq fuzz  0.001)
  (while
    (not
      (and
        (or (setq ent (car (entsel "\nSelect object to match area & layer.")))
            (prompt "\nMissed, try again."))
        (setq obj (vlax-ename->vla-object ent))
        (or (vlax-property-available-p obj 'area)
            (prompt "\nNo Area for that object, try again."))
      )
    )
  )
  (initget "Yes No")
  (if (equal (getkword "\nMatch layer too? [Yes/No]<Yes>: ") "No")
     (setq layFilter '(8 . "*"))
     (setq layFilter (cons 8 (vla-get-layer obj)))
  )
  (setq Area2match (vla-get-area obj)
        ss2  (ssadd)
  )
  (prompt "\nSelect objects or ENTER for All objects in this space.")

  (if (or (setq ss (ssget (list layFilter (cons 410 (getvar "ctab")))))
          (setq ss (ssget "_All" (list layFilter (cons 410 (getvar "ctab"))))))
    (progn
      (setq lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (mapcar
        '(lambda (x)
           (if (and (vlax-property-available-p x 'area)
                    (equal Area2match (vla-get-area x) fuzz))
             (ssadd (vlax-vla-object->ename x) ss2)
           )
         )
        lst
      )
    )
  )
  (sssetfirst)
  (print)
  (if (and ss (not(zerop(sslength ss2))))
    (cadr(sssetfirst nil ss2))
  )
)

[CAB]

And while I'm at it one for object type.

Code: [Select]

;;  Sel by Type.lsp

;;  CAB 11.06.2007
;;  Get a selection set of thawed objects in current space with matching type
;;  Option to match layer too
;;  Highlights the selected items & returns the selection set
(defun c:oSel (/ fuzz ent obj layFilter Area2match lst ss ss2)
  (vl-load-com)
  (setq fuzz  0.001)
  (while
    (not
      (and
        (or (setq ent (car (entsel "\nSelect object to match object type & layer.")))
            (prompt "\nMissed, try again."))
        (setq obj (vlax-ename->vla-object ent)
              typ (cdr(assoc 0 (entget ent))))
        (or (not (vl-position typ '("")))
            (prompt "\nObject type not supported, try again."))
      )
    )
  )
  (initget "Yes No")
  (if (equal (getkword "\nMatch layer too? [Yes/No]<Yes>: ") "No")
     (setq layFilter '(8 . "*"))
     (setq layFilter (cons 8 (vla-get-layer obj)))
  )
  (setq ss2 (ssadd))
  (prompt "\nSelect objects or ENTER for All objects in this space.")

  (or (setq ss (ssget (list layFilter (cons 0 typ)(cons 410 (getvar "ctab")))))
      (setq ss (ssget "_All" (list layFilter (cons 0 typ)(cons 410 (getvar "ctab"))))))
  (sssetfirst)
  (print)
  (if (and ss (not(zerop(sslength ss))))
    (cadr(sssetfirst nil ss))
  )
)

[dussla]

thank you good reply
your code is perpect ~~~
thank you again

[CAB]

You are welcome.

[Jan ter Aij]

Dear CAB,

Why gives the program lSel the following error message:
Error: bad argument type: lentityp (0 (162.023 88.2897 0.0))

Regards Jan.

[CAB]

Oh shoot!
I updated part of that routine & didn't test it.
Copy it again as I updated the code.

PS Welcome to TheSwamp

[Jan ter Aij]

Oh shoot!
I updated part of that routine & didn't test it.
Copy it again as I updated the code.

PS Welcome to TheSwamp

Dear CAB,

Thank You.

Regards Jan.