Separate Hatches in Back- and Foreground

[se.ha]

Hi community

For official, city approved, dwgs, I need to separate all of my hatches in back- and foreground colors and patterns. I am new to LISP coding but this is as far as I have gotten:

(defun c:test (/ c a d)
  (vl-load-com)
  (vlax-for l (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object))))
    (cond ((= -1 (vlax-get l 'lock)) (vlax-put l 'lock 0) (setq a (cons l a))))
  )
  (vlax-for b (vla-get-blocks d)
    (if (= 0 (vlax-get b 'isxref))
      (vlax-for o b
        (cond
          ((and (vlax-write-enabled-p o) (= (vla-get-objectname o) "AcDbHatch"))
           (or c (progn (setq c (vla-get-backgroundcolor o)) (vla-put-entitycolor c -939524096)))
           (vla-put-backgroundcolor o c)
          )
        )
      )
    )
  )
  (foreach l a (vlax-put l 'lock -1))
  (vla-regen d acallviewports)
  (princ)
)

;; Run the command automatically when the file is loaded
(c:test)

Additionally I was thinking to check for the background color and create a copy of the hatch before setting the background color to none. The background pattern is always going to be solid.

Any help is appreciated.

[EnM4st3r]

Hi, can you explain more on how you want to change the hatches, and on what conditions it should be changed?

[se.ha]

Hi @EnM4st3r 

Thanks for the response.

I use Revit to export my dwg. In Revit I can set a background and foreground pattern/color for elements:

Unfortunately by exporting to dwg I get one pattern with two colors:

I need all hatches that consist of back- AND foreground to be separated into two hatches so I can put them on individual layers. I was thinking of checking if the hatch has back- and foreground color. If so, store the background color, change it to none, create copy of original hatch and change the pattern to solid and the color to the stored value to achieve this:

Obviously the patterns need to be in the same spot as before. The background is always going to be solid. 

[EnM4st3r]

ah, now i understand. From your code i assume all the hatches are inside blocks after exporting?
Could you also post a sample dwg with the hatches?

[se.ha]

Not all hatches are inside of blocks but they could be. 

Attached is a simple test-file containing a couple of walls with hatches.

Thank you  

[EnM4st3r · Accepted solution]

now i remember why i didnt like to work with color objects.. they are so weird.

Heres my first test function, what i noticed is that the draworder gets messed up so one would need to change that also.

(defun c:testhatch (/ splithatch ss i nullColor)
  (defun splithatch (obj / col obj2 c)
    (if (and
          (= (vla-get-objectname obj) "AcDbHatch")
          (vlax-write-enabled-p obj)
          (not (= (setq col (vla-get-entitycolor (vla-get-backgroundcolor obj))) -939524096))
        ) 
      (progn
        (or nullColor (progn (setq nullColor (vla-get-backgroundcolor obj)) (vla-put-entitycolor nullColor -939524096)))
        (vla-put-backgroundcolor obj nullColor)
        (setq obj2 (vla-copy obj))
        (vla-setpattern obj2 acHatchPatternTypePreDefined "SOLID")
        (vla-put-entitycolor (setq c (vla-get-truecolor obj2)) col)
        (vla-put-truecolor obj2 c)
      )
    )
  )
  
  (setq ss (ssget '((0 . "HATCH"))))
  (setq i 0)
  (while (< i (sslength ss))
    (splithatch (vlax-ename->vla-object (ssname ss i)))
    (setq i (1+ i))
  )
)

[se.ha · Accepted solution]

Thank you @EnM4st3r 

With your help (and ChatGPT) i managed to get the result I wanted. Here is the final code:

(defun c:testhatch (/ splithatch nullColor doc modelSpace hatchList backgroundLayer foregroundLayer)
  ;; Set the layer names
  (setq backgroundLayer "BackgroundLayer")
  (setq foregroundLayer "ForegroundLayer")

  ;; Function to create a layer if it doesn't exist
  (defun ensure-layer (layerName / layer)
    (if (not (tblsearch "LAYER" layerName))
      (progn
        (setq layer (vla-add (vla-get-layers doc) layerName))
        (vla-put-color layer 7) ;; Optional: set the layer color to white
      )
    )
  )

  ;; Function to process each hatch object
  (defun splithatch (obj / col obj2 c)
    (if (and
          ;; Check if the object is a hatch and is writable
          (= (vla-get-objectname obj) "AcDbHatch")
          (vlax-write-enabled-p obj)
          ;; Check if the background color is not equal to -939524096
          (not (= (setq col (vla-get-entitycolor (vla-get-backgroundcolor obj))) -939524096))
        ) 
      (progn
        ;; Set nullColor if not already set
        (or nullColor 
            (progn 
              (setq nullColor (vla-get-backgroundcolor obj)) 
              (vla-put-entitycolor nullColor -939524096))
        )
        ;; Set the hatch background color to nullColor
        (vla-put-backgroundcolor obj nullColor)
        ;; Copy the hatch object
        (setq obj2 (vla-copy obj))
        ;; Change the pattern to solid and restore the color
        (vla-setpattern obj2 acHatchPatternTypePreDefined "SOLID")
        (vla-put-entitycolor (setq c (vla-get-truecolor obj2)) col)
        (vla-put-truecolor obj2 c)
        ;; Set the layer for the background hatch
        (vla-put-layer obj2 backgroundLayer)
        ;; Set the layer for the foreground hatch
        (vla-put-layer obj foregroundLayer)
        ;; Add the solid hatch to the list for draw order change
        (setq hatchList (cons (vlax-vla-object->ename obj2) hatchList))
      )
    )
  )

  ;; Initialize the hatch list
  (setq hatchList nil)
  ;; Get the current drawing
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  ;; Ensure layers exist
  (ensure-layer backgroundLayer)
  (ensure-layer foregroundLayer)
  ;; Get the model space
  (setq modelSpace (vla-get-ModelSpace doc))
  ;; Iterate through all objects in the model space
  (vlax-for obj modelSpace
    ;; Process only hatch objects
    (if (= (vla-get-objectname obj) "AcDbHatch")
      (splithatch obj)
    )
  )

  ;; Change the draw order to send all solid hatches to the back
  (if hatchList
    (progn
      ;; Create a selection set from the list of hatches
      (setq ss (ssadd))
      (foreach e hatchList (ssadd e ss))
      ;; Use DRAWORDER command to send to back
      (command "_.DRAWORDER" ss "" "B")
    )
  )
)

[EnM4st3r]

Nice. Notice that this will not change hatches inside of blocks.
(Also, lines 50-51 are not necessary as its initially nil.)

[se.ha]

Thanks for the input.

I deleted the two lines and made some changes, so the code would work inside blocks as well.