Author Topic: same hatch find  (Read 2916 times)

0 Members and 1 Guest are viewing this topic.

dussla

  • Bull Frog
  • Posts: 286
same hatch find
« on: November 09, 2017, 11:02:38 PM »
hello freind
always thank you  for good lisp
still i am beginner.
this lisp is needed help . that lisp coding is to difficult to me .


if you see my attached file , you can hatchs
that is only  sample.

i would like to  select hatchs accoding hatch size

i need 3 fuctions

1.if i select   a certain hatch ,   to select same size hatch
2.if i select  a certain hatch ,  to select   small size hatch more than current hatch size ,
3. 2.if i select  a certain hatch ,  to select   big size hatch more than current hatch size

sorry my rude ask ~

dussla

  • Bull Frog
  • Posts: 286
Re: same hatch find
« Reply #1 on: November 10, 2017, 03:28:58 AM »
i used  Tharwat  code 
thank you for  Tharwat

i modified that some , but that is not work well


(defun c:ot3 ( / len sad sel kwd sgn)
  ;; Tharwat - 24.09.16 ;;
  (if (and  (setq src (car (entsel "\nSelect object to match area & layer.")))
         (setq area1 (vla-get-area (vlax-ename->vla-object src)))
                 (setq sad (ssadd) sel (ssget "_:L" '((0 . "hatch"))))
           (not (initget 7 "Longer Shoter"))
           (setq kwd (getkword "\nSpecify [Longer/Shorter] :"))
           (setq sgn (if (= kwd "Shoter") < >))
           )
    ((lambda (x / e )
   
       ;(setq src (vla-get-area (vlax-ename->vla-object src)))
       (while (setq e (ssname sel (setq x (1+ x))))
         (if (sgn  (vla-get-area (vlax-ename->vla-object e))(vla-get-area (vlax-ename->vla-object e)) area1)
           (ssadd e sad))
         )
       ) -1
         )
    )
  (sssetfirst nil sad)
  (princ)
  ) (vl-load-com)
 

ronjonp

  • Needs a day job
  • Posts: 7526
Re: same hatch find
« Reply #2 on: November 10, 2017, 09:38:36 AM »
Here's a quick one:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo (/ a b e o s)
  2.   (or *global* (setq *global* "Equal"))
  3.   (if
  4.     (and
  5.       (setq s (ssget "_x" '((0 . "hatch"))))
  6.       (setq e (car (entsel "\nPick a hatch to get area: ")))
  7.       (= 'real (type (setq a (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object e))))))
  8.       (not (initget "Equal Smaller Larger"))
  9.       (or (setq *global* (getkword (strcat "\nSpecify [Equal/Smaller/Larger] <" *global* ">: ")))
  10.           *global*
  11.       )
  12.     )
  13.      (progn
  14.        (foreach x (mapcar 'cadr (ssnamex s))
  15.          (setq o (eval (cdr (assoc *global* '(("Equal" . equal) ("Smaller" . <) ("Larger" . >))))))
  16.          (if (= 'real
  17.                 (type (setq b (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object x)))))
  18.              )
  19.            (if (null (if (= o equal)
  20.                        (o b a 1e-8)
  21.                        (o b a)
  22.                      )
  23.                )
  24.              (ssdel x s)
  25.            )
  26.          )
  27.        )
  28.        (sssetfirst nil s)
  29.      )
  30.   )
  31.   (princ)
  32. )
« Last Edit: November 10, 2017, 10:13:53 AM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

dussla

  • Bull Frog
  • Posts: 286
Re: same hatch find
« Reply #3 on: November 10, 2017, 10:10:20 AM »

Here's a quick one:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo (/ a b e o s)
  2.   (or *global* (setq *global* "Equal"))
  3.   (if
  4.     (and
  5.       (setq s (ssget "_x" '((0 . "hatch"))))
  6.       (setq e (car (entsel "\nPick a hatch to get area: ")))
  7.       (= 'real (type (setq a (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object e))))))
  8.       (not (initget "Equal Smaller Larger"))
  9.       (or (setq *global* (getkword (strcat "\nSpecify [Equal/Smaller/Larger] <" *global* ">: ")))
  10.           *global*
  11.       )
  12.     )
  13.      (progn
  14.        (foreach x (mapcar 'cadr (ssnamex s))
  15.          (setq o (eval (cdr (assoc *global* '(("Equal" . equal) ("Smaller" . <) ("Larger" . >))))))
  16.          (if (= 'real
  17.                 (type (setq b (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object x)))))
  18.              )
  19.            (if (null (if (= o equal)
  20.                        (o b a 1e-8)
  21.                        (o b a)
  22.                      )
  23.                )
  24.              (ssdel x s)
  25.            )
  26.          )
  27.        )
  28.        (sssetfirst nil s)
  29.      )
  30.   )
  31.   (princ)
  32. )



perpect really really thank you
there is  problem

1. if i   put   foo  enter  enter  ,   all hatch is selected
   default is  euqual ~
2. pls  can you make mutilple selection version ?~~


sorry my rude ask ~~~
really really thank you ~
« Last Edit: November 10, 2017, 10:37:35 AM by dussla »

ronjonp

  • Needs a day job
  • Posts: 7526
Re: same hatch find
« Reply #4 on: November 10, 2017, 10:16:21 AM »
Change the highlighted lines above ( 5 & 14 ) to:
(setq s (ssget '((0 . "hatch"))))
(foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

dussla

  • Bull Frog
  • Posts: 286
Re: same hatch find
« Reply #5 on: November 10, 2017, 10:54:55 AM »
sorry ~ i tested  that modified code~

1. still  default  equal is not work
    if i  foo enter   , and put ent   ,  that is selected all hatch


2.  mutilful selection mode  about  "Pick a hatch to get area"
     i want   above ~~~

3. if you see  attached file ,  some selection error

 sorry  ~~ really sorry ~
« Last Edit: November 10, 2017, 11:11:33 AM by dussla »

ronjonp

  • Needs a day job
  • Posts: 7526
Re: same hatch find
« Reply #6 on: November 10, 2017, 12:43:02 PM »
Dussla,

One issue is some of those hatches don't have an area property. I added a fuzz value to the <> operators too. = is to literal.
Code - Auto/Visual Lisp: [Select]
  1.  
  2. (defun c:foo (/ a b fuzz e o s)
  3.   (sssetfirst nil nil)
  4.   (or *global* (setq *global* "Equal"))
  5.   ;; Change this number to suit for equality check
  6.   (setq fuzz 0.1)
  7.   (if
  8.     (and
  9.       (setq e (car (entsel "\nPick a hatch to get area: ")))
  10.       (= 'real (type (setq a (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object e))))))
  11.       (not (initget "Equal Smaller Larger"))
  12.       (or (setq *global* (getkword (strcat "\nSpecify [Equal/Smaller/Larger] <" *global* ">: ")))
  13.           *global*
  14.       )
  15.       (setq s (ssget '((0 . "hatch"))))
  16.     )
  17.      (progn
  18.        (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
  19.          (setq o (eval (cdr (assoc *global* '(("Equal" . equal) ("Smaller" . <) ("Larger" . >))))))
  20.          (if (= 'real
  21.                 (type (setq b (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object x)))))
  22.              )
  23.            (if (null (cond ((= o equal) (o b a fuzz))
  24.                            ((and (o b a) (not (equal b a fuzz))))
  25.                      )
  26.                )
  27.              (ssdel x s)
  28.            )
  29.            (ssdel x s)
  30.          )
  31.        )
  32.        (sssetfirst nil s)
  33.      )
  34.   )
  35.   (princ)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

dussla

  • Bull Frog
  • Posts: 286
Re: same hatch find
« Reply #7 on: November 10, 2017, 08:02:01 PM »
perpect ~~   thank you for your effor ~

but my poor skill  i can;t make this


 (setq e (car (entsel "\nPick a hatch to get area: ")))

--> i want  (setq e  ssget  "\nPick a hatch to get area: ")))    :  mutilple section fuction


really sorry sorry  ~  i think you very busy~
really sorry

ronjonp

  • Needs a day job
  • Posts: 7526
Re: same hatch find
« Reply #8 on: November 10, 2017, 09:13:05 PM »
I'm not sure what you want. Sorry.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

dussla

  • Bull Frog
  • Posts: 286
Re: same hatch find
« Reply #9 on: November 10, 2017, 09:30:13 PM »
(defun c:foo (/ a b fuzz e o s)

  (sssetfirst nil nil)

 

  ;; Change this number to suit for equality check
(setq o  equal )
  (setq fuzz 0.2)

  (if

    (and

      ;(setq e (car (entsel "\nPick a hatch to get area: ")))
    
     (setq ss (ssget (list '(0 . "hatch")) ) )

      (= 'real (type (setq a (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object e))))))

   
     (setq s (ssget "_x" '((0 . "hatch"))))
     
    )

     (progn
   
    (setq copydex 0)
   
   (repeat (sslength ss)
   
             (setq ent (ssname ss copydex))
         
         
            (foreach   x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))

             (if (=   'real

            (type (setq b (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object x)))))

             )

            (if (null (cond ((= o equal) (o b a fuzz))

                  ((and (o b a) (not (equal b a fuzz))))

                )

               )

             (ssdel x s)

            )

            (ssdel x s)

          )

            )
            
            
             (ssadd s newss)
            
     )

       (sssetfirst nil newss)
     )
  )
  (princ)

)(vl-load-com)



sorry my poor english
and thank you for your concern and effor
in equal mode. i would like to make this fuction

ronjonp

  • Needs a day job
  • Posts: 7526
Re: same hatch find
« Reply #10 on: November 10, 2017, 10:39:46 PM »
Last try. Groups all hatches by changing color based on area equality.
Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo (/ a b c d e f)
  2.   ;; Change this number to suit for equality check
  3.   (setq f 0.1)
  4.   (setq e 0)
  5.   (if (and (setq s (ssget "_X" '((0 . "hatch"))))
  6.            (setq
  7.              s (vl-remove
  8.                  'nil
  9.                  (mapcar '(lambda (x)
  10.                             (if (= 'real (type (setq b (vl-catch-all-apply 'vla-get-area (list x)))))
  11.                               (cons b x)
  12.                             )
  13.                           )
  14.                          (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex s)))
  15.                  )
  16.                )
  17.            )
  18.       )
  19.     (while (setq b (car s))
  20.       (if (> (1+ e) 255)
  21.         (setq e 1)
  22.         (setq e (1+ e))
  23.       )
  24.       (foreach d (vl-remove-if-not '(lambda (x) (equal (car b) (car x) f)) s)
  25.         (vl-catch-all-apply 'vla-put-color (list (cdr d) e))
  26.         (setq s (vl-remove d s))
  27.       )
  28.     )
  29.   )
  30.   (princ)
  31. )

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

dussla

  • Bull Frog
  • Posts: 286
Re: same hatch find
« Reply #11 on: November 10, 2017, 10:51:43 PM »
wow  it is very good idea~~
really thank you for your difficult effort .
really thank you reall really~

ronjonp

  • Needs a day job
  • Posts: 7526
Re: same hatch find
« Reply #12 on: November 10, 2017, 10:53:41 PM »
wow  it is very good idea~~
really thank you for your difficult effort .
really thank you reall really~
Glad to help :) ... the language barrier is tough sometimes.
Quote
i need 3 fuctions

1.if i select   a certain hatch ,   to select same size hatch
2.if i select  a certain hatch ,  to select   small size hatch more than current hatch size ,
3. 2.if i select  a certain hatch ,  to select   big size hatch more than current hatch size
But in the end you wanted one  :?

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC