Modifying OffsetHatch LISP

[Aljoosha]

Hello!

I'm a beginner to LISP language and tried to bite off more than I could chew. Found very useful OffHatch LISP from LeeMac named OffHatchV1-01. I can't post .lsp file, so I'll paste whole code here:

 

;;---------------------=={ Offset Hatch }==-------------------;;
;;                                                            ;;
;;  Offsets every object in a selection to both sides by a    ;;
;;  specified distance, then hatches the interior of the      ;;
;;  closed object formed by the two offset objects.           ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:offhat

    ( / *error* _reversepoly _substonce _substlast en1 en2 hat inc ob1 ob2 obj sel spc tmp )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (defun _reversepoly ( enx / _polydata lst wid )

        (defun _polydata ( enx )
            (if (setq enx (member (assoc 10 enx) enx))
                (vl-list*
                    (assoc 10 enx)
                    (assoc 40 enx)
                    (assoc 41 enx)
                    (assoc 42 enx)
                    (_polydata (cdr enx))
                )
            )
        )

        (setq wid (cdr (assoc 40 enx))
              enx (reverse (_polydata enx))
              enx (append (cdddr enx) (list (car enx) (cadr enx) (caddr enx)))
        )
        (while enx
            (setq lst
                (vl-list*
                    (cons 42 (- (cdr (assoc 42 enx))))
                    (cons 41 (cdr (assoc 40 enx)))
                    (cons 40 (cdr (assoc 41 enx)))
                    (assoc 10 enx)
                    lst
                )
                enx (cddddr enx)
            )
        )
        (reverse (vl-list* '(42 . 0.0) (cons 41 wid) (cons 40 wid) (cdddr lst)))
    )

    (defun _substonce ( a b l )
        (if l
            (if (equal b (car l))
                (cons a (cdr l))
                (cons (car l) (_substonce a b (cdr l)))
            )
        )
    )

    (defun _substlast ( a b l )
        (reverse (_substonce a b (reverse l)))
    )

    (cond
        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'clayer))))))
            (princ "\nCurrent layer locked.")
        )
        (   (progn (initget 6)
                (and
                    (setq *offset*
                        (cond
                            (   (getdist
                                    (strcat "\nSpecify Offset"
                                        (if *offset* (strcat " <" (rtos *offset*) ">: ") ": ")
                                    )
                                )
                            )
                            (   *offset*   )
                        )
                    )
                    (setq sel (LM:ssget "\nSelect LWPolylines: " '("_:L" ((0 . "LWPOLYLINE")))))
                )
            )
            (setq spc (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
            (LM:startundo (LM:acdoc))
            (repeat (setq inc (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq inc (1- inc)))))
                (if
                    (and
                        (setq ob1 (car (LM:catchapply 'vlax-invoke (list obj 'offset    *offset*))))
                        (setq ob2 (car (LM:catchapply 'vlax-invoke (list obj 'offset (- *offset*)))))
                    )
                    (if (vlax-curve-isclosed obj)
                        (progn
                            (if (< (vla-get-area ob1) (vla-get-area ob2))
                                (setq tmp ob1 ob1 ob2 ob2 tmp)
                            )
                            (setq hat (vla-addhatch spc achatchpatterntypepredefined "ANSI37" :vlax-true achatchobject))
                            (vlax-invoke hat 'appendouterloop (list ob1))
                            (vlax-invoke hat 'appendinnerloop (list ob2))
                            (vla-evaluate hat)
                        )
                        (progn
                            (setq en1 (entget (vlax-vla-object->ename ob1))
                                  en2 (entget (vlax-vla-object->ename ob2))
                            )
                            (entmod
                                (append
                                    (_substlast '(42 . 0.0) (assoc 42 (reverse en1))
                                        (vl-remove (assoc 210 en1)
                                            (subst
                                                (cons 90 (+ (cdr (assoc 90 en1)) (cdr (assoc 90 en2))))
                                                (assoc 90 en1)
                                                (subst
                                                    (cons 70 (logior 1 (cdr (assoc 70 en1))))
                                                    (assoc 70 en1)
                                                    en1
                                                )
                                            )
                                        )
                                    )
                                    (_reversepoly en2)
                                    (list (assoc 210 en1))
                                )
                            )
                            (vla-delete ob2)
                            (setq hat (vla-addhatch spc achatchpatterntypepredefined "ANSI37" :vlax-true achatchobject))
                            (vlax-invoke hat 'appendouterloop (list ob1))
                            (vla-evaluate hat)
                        )
                    )
                )
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; Catch Apply  -  Lee Mac
;; Applies a function to a list of parameters and catches any exceptions.
 
(defun LM:catchapply ( fnc prm / rtn )
    (if (not (vl-catch-all-error-p (setq rtn (vl-catch-all-apply fnc prm))))
        rtn
    )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;;
;; Arguments:
;; msg    - selection prompt
;; params - list of ssget arguments

(defun LM:ssget ( msg params / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget params))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
        
(vl-load-com) (princ)

 

 

I want to change offset and hatch color to a certain color code, so it won't be dependent on original PLINE layer properties. Also I would like the offset lines to be extended by offset value on both ends and then connected.

Here's a link to image, which helps to understand what I want to modify.

https://ibb.co/V2fZKW3

 

[Aljoosha]

Forgot to add this - I want linetype to be "Continuous" not "ByLayer".