Lisp, hatch and region ignore island detection

[t_ott]

Hello everyone,

I would like the island detection to be set to ignore when the hatching is created.

(defun c:CreateHatchRegion ()
  (if (setq objLayer (getvar "clayer"))  ; Hole den aktuellen Layer
    (progn
      ;; Hole die Layer-Eigenschaften des aktuellen Layers
      (setq currentLayerData (tblsearch "LAYER" objLayer))
      (setq currentLayerColor (cdr (assoc 62 currentLayerData)))  ; Farbe des aktuellen Layers

      ;; Suche nach einer Region auf dem aktuellen Layer
      (setq sel (ssget "X" (list (cons 8 objLayer) (cons 0 "REGION"))))

      ;; Wenn eine Region gefunden wurde
      (if sel
        (progn
          (setq ent (ssname sel 0))  ; Wähle das erste gefundene Objekt
          
          ;; Erstelle eine SOLID-Schraffur auf der Region
          (command "_.hatch" "SOLID" ent "")

          ;; Hole die zuletzt erstellte Schraffur
          (if (setq lastHatch (entlast))
            (progn
              ;; Setze die Transparenz auf 90%
              (command "_.CHPROP" lastHatch "" "_transparency" "90" "")
            )
          )

          ;; Generiere den neuen Layernamen (aktueller Layer + "_Schraffur")
          (setq newLayer (strcat objLayer "_Schraffur"))

          ;; Überprüfe, ob der neue Layer bereits existiert
          (if (not (tblsearch "LAYER" newLayer))  ; Wenn der Layer nicht existiert
            (progn
              ;; Erstelle den Layer mit den gleichen Attributen wie der aktuelle Layer
              (command "._LAYER" "_M" newLayer "_Color" currentLayerColor "" "")
            )
          )

          ;; Setze den Layer der Schraffur auf den neuen Layer
          (command "_.CHPROP" lastHatch "" "_Layer" newLayer "")
          
          (princ "\nSchraffur mit Transparenz und dem neuen Layer erstellt.")
        )
      )
      (princ "\nKeine Region auf dem aktuellen Layer gefunden.")
    )
    (princ "\nKein aktueller Layer gefunden.")
  )
  (princ)  ; Beende die Ausgabe
)

Is this also possible with this code where a region is created.
(Orginal code: Union polylines; Stefan M. January 9, 2014

;Union polylines
;Stefan M. 09.01.2014 (angepasst für aktiven Layer, Linientyp und Farbe)
(defun c:UNIP ( / *error* i lst ms r1 reg ss sysvar prop obj reg1 op not_reg)
  (or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
  (vla-startundomark acDoc)
  (setq sysvar (mapcar 'getvar '(peditaccept draworderctl cmdecho)))
  
  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (mapcar 'setvar '(peditaccept draworderctl cmdecho) sysvar)
    (vla-endundomark acDoc)
    (princ)
  )
  
  (if
    (setq ss (ssget ":L" '((0 . "*POLYLINE,CIRCLE,REGION"))))
    (progn
      ; Verwendet aktiven Layer, Linientyp und Farbe
      (setq prop (list
                   (getvar "clayer")   ; Aktiver Layer
                   (getvar "celtype")  ; Aktiver Linientyp
                   (getvar "cecolor")  ; Aktive Farbe
                 ))
      
      (repeat (setq i (sslength ss))
        (setq i (1- i)
              obj (vlax-ename->vla-object (ssname ss i))
        )
        (if
          (eq (vla-get-ObjectName obj) "AcDbRegion")
          (setq reg1 (cons obj reg1))
          (setq lst  (cons obj lst))
        )
      )
      
      (if lst
          (foreach x lst
            (if
              (and
                (not (eq (vla-get-objectname x) "AcDbCircle"))
                (eq (vla-get-closed x) :vlax-false)
              )
              (progn
                (setq op T)
                (vla-put-closed x :vlax-true)
              )
              (setq op nil)
            )
            (if
              (not (vl-catch-all-error-p (setq r1 (vl-catch-all-apply 'vlax-invoke (list ms 'AddRegion (list x))))))
              (progn
                (setq reg (cons (car r1) reg))
                (vla-delete x)
              )
              (progn
                (if op (vla-put-closed x :vlax-false))
                (setq not_reg (cons x not_reg))
              )
            )
          )
      )
      
      (setq reg (append reg reg1))
      (if
        (setq r1 (car reg))
        (progn
          (foreach x (cdr reg) (vlax-invoke r1 'boolean acunion x))
          (mapcar '(lambda (p v) (vlax-put r1 p v))
                  '(Layer LineType Color)
                  prop
          )
          (setq
            lst (apply
                  'append
                  (mapcar
                    '(lambda (a)
                       (if
                         (listp a)
                         (mapcar 'vlax-vla-object->ename a)
                         (list (vlax-vla-object->ename a))
                       )
                     )
                    (mapcar
                      '(lambda (e / p)
                         (if (eq (vla-get-objectname e) "AcDbRegion")
                           (progn
                             (setq p (vlax-invoke e 'explode))
                             (vla-delete e)
                             p
                           )
                           e
                         )
                       )
                      (vlax-invoke r1 'explode)
                    )
                  )
                )
          )
          (vla-delete r1)
          (setq ss (ssadd))
          (foreach x lst (if (not (eq (cdr (assoc 1 (entget x))) "CIRCLE")) (ssadd x ss)))
          (if
            (< 1 (sslength ss))
            (progn
              (mapcar 'setvar '(peditaccept draworderctl cmdecho) '(1 0 0))
              (command "_pedit" "_m" ss "" "_j" "" "")
            )
          )
        )
      )
    )
  )
  (*error* nil)
  (princ)
)

Thank you very much, Tom 

[paullimapa]

In regards to ignoring island detection use:

(setvar "HPISLANDDETECTION" 2)

https://help.autodesk.com/view/ACDLT/2024/ENU/?guid=GUID-3B578500-B1F3-450E-8C1B-5DEE394B2A27

[t_ott]

so right:

          ;; Erstelle eine SOLID-Schraffur auf der Region
		  (setvar "HPISLANDDETECTION" 2)
          (command "_.hatch" "SOLID" ent "")

I'm including an example file where the green circles are where errors occur when you run UNIP.
If you then run CreateHatchRegion, islands are created there.

Thanks, Tom

[paullimapa]

You may want to contact the author of UNIP to see if there's an improved version.

Or you can try Lee Mac's Outline.lsp which combines plines and creates a pline that is an outline then you can convert the new pline to a region:

https://www.lee-mac.com/outlineobjects.html

[ec-cad]

Don't know how to fix it, but see .png files attached. If you zoom in (really far), to the areas you

marked with circles, you will see what causes the issue. Maybe you need some 'gap' type Pedit to cure it.

ECCAD

[t_ott]

I would like to write to the author UNIP but unfortunately I don't have any contact details.
And Lee Mac's Lisp is Stark, I used it at first but then came across UNIP, which does exactly what I needed.

But thanks for your quick answer.

Greetings Tom

[t_ott]

Hi,

I didn't zoom in that far, I have no idea how that could have happened.
These are holding areas for a hydraulic system and I normally make sure that something like this doesn't happen and the program actually takes care of this.
But whatever, thank you for the explanation.

Greetings Tom

[paullimapa]

Go back to the original post by Stefan:

To find each closed boundary of selected object

Scroll down to here:

You can try replying to this old post or better yet create an account:

click on his name and send him a message