Author Topic: same hatch find  (Read 173 times)

0 Members and 1 Guest are viewing this topic.

dussla

  • Bull Frog
  • Posts: 227
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: 227
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: 6398
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 10 x64 - AutoCAD /C3D 2018

Custom Build PC

dussla

  • Bull Frog
  • Posts: 227
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: 6398
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 10 x64 - AutoCAD /C3D 2018

Custom Build PC

dussla

  • Bull Frog
  • Posts: 227
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: 6398
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 10 x64 - AutoCAD /C3D 2018

Custom Build PC

dussla

  • Bull Frog
  • Posts: 227
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: 6398
Re: same hatch find
« Reply #8 on: November 10, 2017, 09:13:05 pm »
I'm not sure what you want. Sorry.

Windows 10 x64 - AutoCAD /C3D 2018

Custom Build PC

dussla

  • Bull Frog
  • Posts: 227
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: 6398
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 10 x64 - AutoCAD /C3D 2018

Custom Build PC

dussla

  • Bull Frog
  • Posts: 227
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: 6398
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 10 x64 - AutoCAD /C3D 2018

Custom Build PC