Select Hatch by background color

March 16, 2017

I've wrote a function to select hatches based on their layer layColor patName patScale

What I'm missing is getting the DXF data on ssget for the vla-get-backgroundcolor

As I'm not sure if this is exposed to the DXF.

Any help would be appreciated. Thanks.

;
; Select hatches on same layer & pattern by 3dwannab
;
; v0.1 - 16.03.2017
; Usage: Select hatch to select other hatches on similar bkgCol color layer patName patScale

(defun c:TEST nil (c:QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor))
(defun c:QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor ( / ss ssdata layer layColor patName patScale bkgCol)

(while
	(not
		(and
			(setq
				ss (car (entsel "\nSelect Hatch to get same Hatch entities as:\nlayer layColor patName patScale bkgCol: "))
				ssdata (if ss (entget ss))
				)

			(= (cdr (assoc 0 ssdata)) "HATCH")

			(sssetfirst nil)

			(setq ss (vlax-ename->vla-object ss))

			(progn

				(setq
					bkgCol (vla-get-backgroundcolor ss)
					layColor (vla-get-color ss)
					layer (vla-get-Layer ss)
					patName (vla-get-PatternName ss)
					patScale (vla-get-PatternScale ss)
					)

				(setq ss (ssget "X" (list (cons 8 layer) '(0 . "HATCH") (cons 2 patName) (cons 62 layColor) (cons 41 patScale) (cons 410 (getvar 'ctab)))))
				(princ (strcat "\n   >>>   " (itoa (setq len (sslength ss))) (if (> len 1) " items" " item") " selected   <<<   "))

				(sssetfirst nil ss)(princ)

				)

			)
		)
	(prompt "\n   >>>   Nothing selected, or please select a hatch !   <<<   ")

	)

(princ)
)
(vl-load-com)
(princ "\n:: QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor.lsp | Version 1.0 | by 3dwannab ::")
(princ "\n:: Type \"QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor\" OR \"TEST\" to Invoke ::") (princ)

March 16, 2017

Alternative solution would be to iterate over the SS, construct a new SS and populate it with the hatches that match the criteria:

(defun C:test ( / e bkgColidx SS nSS i )
 (and 
   (setq e (car (entsel "\nSelect source hatch: ")))
   (= "HATCH" (cdr (assoc 0 (entget e))))
   (setq bkgColidx (vla-get-ColorIndex (vla-get-BackgroundColor (vlax-ename->vla-object e))))
   (setq SS (ssget "_X" (list '(0 . "HATCH")(cons 410 (getvar 'ctab)))))
   (progn
     (setq nSS (ssadd))
     (repeat (setq i (sslength SS))
       (and
         (setq e (ssname SS (setq i (1- i))))
         (= bkgColidx (vla-get-ColorIndex (vla-get-BackgroundColor (vlax-ename->vla-object e))))
         (ssadd e nSS)
       ); and
     ); repeat
     (sssetfirst nil nSS)
   ); progn
 ); and
 (princ)
) (vl-load-com) (princ)

The above should select the hatches with the same background index color, else you could use a RGB list for comparsion:

(setq RGB (mapcar '(lambda (x) (vlax-get (vla-get-BackgroundColor o) x)) '(Green Blue Red)))

As for the DXF, perhaps wait for the professor.

March 16, 2017

Hi,

Have a look at the Xdata of the Hatch object before and after adding background colour.

March 16, 2017

Alternative solution would be to iterate over the SS, construct a new SS and populate it with the hatches that match the criteria:

(defun C:test ( / e bkgColidx SS nSS i )
 (and 
   (setq e (car (entsel "\nSelect source hatch: ")))
   (= "HATCH" (cdr (assoc 0 (entget e))))
   (setq bkgColidx (vla-get-ColorIndex (vla-get-BackgroundColor (vlax-ename->vla-object e))))
   (setq SS (ssget "_X" (list '(0 . "HATCH")(cons 410 (getvar 'ctab)))))
   (progn
     (setq nSS (ssadd))
     (repeat (setq i (sslength SS))
       (and
         (setq e (ssname SS (setq i (1- i))))
         (= bkgColidx (vla-get-ColorIndex (vla-get-BackgroundColor (vlax-ename->vla-object e))))
         (ssadd e nSS)
       ); and
     ); repeat
     (sssetfirst nil nSS)
   ); progn
 ); and
 (princ)
) (vl-load-com) (princ)

The above should select the hatches with the same background index color, else you could use a RGB list for comparsion:

(setq RGB (mapcar '(lambda (x) (vlax-get (vla-get-BackgroundColor o) x)) '(Green Blue Red)))

As for the DXF, perhaps wait for the professor.

Thanks for going to the trouble of writing that for me. Is there any way to test how quick a fn is to compare them?

But it's always good to start my collection of code snippets. Thank you.

Hi,
Have a look at the Xdata of the Hatch object before and after adding background colour.

Interesting. I have a fn (don't know where, as I've had it a long time) and never used it.

;;  get entity list of user picked entity
;;  plus related objects
(defun c:myentget+ (/ ent elst)
(if (and (setq ent (car (entsel "\nSelect entity to list.")))
	(setq elst (entget ent '("*"))))
(progn
	(textscr)
	(princ "\n>>>------>  ")
	(princ (vlax-ename->vla-object ent))
	(mapcar 'print elst)
	(mapcar
		'(lambda(x / slst)
			(if (and (assoc x elst)
				(setq slst (entget (cdr (assoc x elst)))))
			(progn
				(prompt (strcat "\n\n*******  Dump DXF "(itoa x)" listing  *********"))
				(foreach n slst (print n))
				)
			)
			)
	'(330 340)) ; '(320 330 340 350 360))
	)
)
(princ)
)

and checked that. I missed this earlier. So, I've got this portion of data back :

(-3 ("HATCHBACKGROUNDCOLOR" (1071 . -1023410170) (1000 . "") (1000 . "")) ("GradientColor1ACI" (1070 . 5)) ("GradientColor2ACI" (1070 . 2)) ("ACAD" (1010 0.0 0.0 0.0)))

For the life of me I don't know what to do with it or how to use that in the filter for ssget.

My ssget _X now looks like (this is probably way off)

(setq ss (ssget "X" (list (cons 8 layer) '(0 . "HATCH") (cons 2 patName) (cons 1071 bkgCol) (cons 62 layColor) (cons 41 patScale) (cons 410 (getvar 'ctab)))))

April 11, 2017

Never did find a way to get the HATCHBACKGROUND DXF code filtered in the ssget.

Just went with this instead with the help of GRRRs code.

;; Select HATCH by: Layer, Pattern Name, Pattern Scale, Colour & Background Colour
;; by 3dwannb on 11.04.17
;;
;; Help by GRRR: http://www.cadtutor.net/forum/showthread.php?100136-Select-Hatch-by-background-color&p=681038&viewfull=1#post681038
;;
;; Known Bugs: None
;;
(defun c:QS_HLPSCB nil (c:QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor))
(defun c:QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor ( /
bkgCol
layColor
layer
patName
patScale
ss
nSS
ssdata
)
(while
(not
	(and
		(setq
			ss (car (entsel "\nSelect Hatch to get same Hatch entities as:\nLayer, Pattern Name, Pattern Scale, Colour & Background Colour :"))
			ssdata (if ss (entget ss))
			)
		(= (cdr (assoc 0 ssdata)) "HATCH")
		(sssetfirst nil)
		(setq ss (vlax-ename->vla-object ss))
		(progn
			(setq
				bkgCol (vla-get-backgroundcolor ss)
				bkgCol (vla-get-ColorIndex (vla-get-BackgroundColor ss))
				layColor (vla-get-color ss)
				layer (vla-get-Layer ss)
				patName (vla-get-PatternName ss)
				patScale (vla-get-PatternScale ss)
				ss (ssget "X" (list (cons 8 layer) '(0 . "HATCH") (cons 2 patName) (cons 62 layColor) (cons 41 patScale) (cons 410 (getvar 'ctab))))
				nSS (ssadd)
				)
			(repeat (setq i (sslength ss))
				(and
					(setq e (ssname ss (setq i (1- i))))
					(= bkgCol (vla-get-ColorIndex (vla-get-BackgroundColor (vlax-ename->vla-object e))))
					(ssadd e nSS)
					)
				)
			(princ (strcat "\n   >>>   " (itoa (setq len (sslength nSS))) (if (> len 1) " items" " item") " selected   <<<   "))
			(sssetfirst nil nSS)
			)
		)
	)
(prompt "\n   >>>   Nothing selected or not a Hatch !   <<<   ")
)
(princ)
)
(vl-load-com)
(princ "\n:: QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor.lsp | Version 1.0 | by 3dwannab ::")
(princ "\n:: Type \"QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor\" OR \"QS_HLPSCB\" to Invoke ::") (princ)

November 13

Just found out my code doesn't work for true colours as warned by @Grrr.

I tried to implement this. How do I go about this?

(setq RGB (mapcar '(lambda (x) (vlax-get (vla-get-BackgroundColor o) x)) '(Green Blue Red)))

I got playing with the -3 dxf code. See attached sample drawing to test. Codes 1070 and 1000 seem to select the hatch but not the 1071 one.

(setq test (ssget "X" 
                  '((0 . "HATCH")
                    (-3 
                      ("GradientColor1ACI" (1070 . 5)) ;; this seems to work
                      ("GradientColor2ACI" (1070 . 2)) ;; this seems to work
                      ("HATCHBACKGROUNDCOLOR" (1000 . "")) ;; this seems to work
                      ("HATCHBACKGROUNDCOLOR" (1071 . -1023755812)) ;; Hatch 1 - Doesn't work
                      ; ("HATCHBACKGROUNDCOLOR" (1071 . -1026695957)) ;; Hatch 2 - Doesn't work
                    )
                   )
           )
)
(sssetfirst nil test)

Selection hatch test.dwg

Edited November 13 by 3dwannab

November 14

Fixed it, bit of a nightmare but think this works. Will test it at work tomorrow.

;;
;; Select hatches by layname name, pattern name, pattern scale and background colour.
;; Forum post here: https://www.cadtutor.net/forum/topic/62756-select-hatch-by-background-color/
;; Modified on 2024.11.14 to fix the hatch background selection issue when it was a true color.
;;
;; TO DO: Add various options to combine all the hatch selection scripts to one and call it QSHATCHES
;;
(defun c:QSHatch_SAME_LAY_PATNAME_SCALE_COL_BKGCOL (/ bkgcol colxdata e en ent i laycol layname obj patname patscale ss) 

  (while 
    (not 
      (and 
        (setq en (car (entsel "\nSelect Hatch to get same Hatch entities as:\n\n- LAYER\n- PATTERN NAME\n- PATTERN SCALE\n- COLOUR\n- BACKGROUND COLOUR\n-------------------------------------------------------------")))
        (setq ent (if en (entget en)))
        (= (cdr (assoc 0 ent)) "HATCH")
        (sssetfirst nil)
        (setq obj (vlax-ename->vla-object en))
        (progn 

          (setq colxdata nil) ;; Reset this variable before collecting it to return nil if not found
          ;; Loop through the -3 xdata and get code 1071, that contains the true colour for hatches
          (foreach a (cdr (assoc -3 (entget en '("*")))) 
            (foreach x (cdr a) 
              (if (= (car x) 1071) 
                (setq colxdata (cdr x))
              )
            )
          )

          (setq bkgcol   (vla-get-backgroundcolor obj)
                bkgcol   (vla-get-ColorIndex (vla-get-BackgroundColor obj))
                laycol   (vla-get-color obj)
                layname  (vla-get-Layer obj)
                patname  (vla-get-PatternName obj)
                patscale (vla-get-PatternScale obj)
                ss       (ssget "X" 
                                (vl-remove 'nil 
                                           (list (cons 8 layname) 
                                                 '(0 . "HATCH")
                                                 (cons 2 patname)
                                                 (if (/= "SOLID" patname) 
                                                   (cons 41 patscale)
                                                 )
                                                 (cons 62 laycol)
                                                 (cons 410 (getvar 'ctab))
                                           )
                                )
                         )
                nss      (ssadd)
          )

          ;; Loop thorugh all the entities in the drawing and check if colxdata is the same. ssadd if a match is found
          (repeat (setq i (sslength ss)) 

            (setq e (ssname ss (setq i (1- i))))

            ;; xdata loop
            (foreach a (cdr (assoc -3 (entget e '("*")))) 
              (foreach x (cdr a) 
                (if 
                  (and 
                    (= (car x) 1071)
                    (= (cdr x) colxdata)
                  )
                  (progn 
                    ;; Testing lines
                    ; (princ "\ncolxdata")
                    ; (princ colxdata)
                    ; (princ "\n")
                    ; (princ "\ncdr x:")
                    ; (princ (cdr x))
                    (ssadd e nss)
                  )
                )
              )
            )

            ;; If index color
            (if 
              (and 
                (= bkgcol (vla-get-ColorIndex (vla-get-BackgroundColor (vlax-ename->vla-object e))))
                (= colxdata nil)
              )
              (ssadd e nss)
            )
          )

          (princ (strcat "\n\t\t<<< " (itoa (sslength nss)) (if (> (sslength nss) 1) " <<< similar HATCHES" " <<< similar HATCH") " selected\n: ------------------------------\n"))
          (sssetfirst nil nss)
          (command "_.regen")
        )
      )
    )
  )
  (princ)
)

;;(c:QSHatch_SAME_LAY_PATNAME_SCALE_COL_BKGCOL) ;; Unblock for testing

Sign In

Select Hatch by background color

Recommended Posts

3dwannab

Grrr

Tharwat

3dwannab

3dwannab

3dwannab

3dwannab

Join the conversation

Tutorials

Forums

Activity