;;; ---------------------------------------------------------------------------
;;; TwinOffset.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Offsets an object to BOTH sides at once.
;;;
;;; The obvious use is drawing anything with a centreline: roads, walls, ducts,
;;; trenches, cable routes. Draw the centre once, offset both faces in a single
;;; operation.
;;;
;;; COMMANDS
;;;   TWINOFFSET  - offset objects to both sides
;;;   TWOF        - short alias for the same command
;;;
;;; OPTIONS, OFFERED AT THE DISTANCE PROMPT
;;;   Through   - instead of typing a distance, pick a point and the offset
;;;               distance is measured from the object to that point
;;;   Erase     - whether the source object is deleted after offsetting
;;;   Layer     - whether the new objects land on the SOURCE object's layer or
;;;               on the CURRENT layer
;;;
;;; The Erase and Layer settings persist for the whole AutoCAD session, so they
;;; only need setting once. The distance itself is held in OFFSETDIST, the same
;;; system variable the standard OFFSET command uses - so the two share a
;;; setting and neither surprises you after using the other.
;;;
;;; Offsets are applied through AutoCAD's own offset engine rather than by
;;; computing parallel geometry, which is what makes arcs, splines, ellipses
;;; and variable-width polylines all come out correctly.
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; Object types AutoCAD is able to offset.
(setq TwinOffset:Types "ARC,CIRCLE,ELLIPSE,SPLINE,LWPOLYLINE,XLINE,LINE")

;; ---------------------------------------------------------------------------
;; Session settings, remembered between runs. Global by necessity - they must
;; outlive the command that sets them.
;; ---------------------------------------------------------------------------
(or *TwinOffset:Erase* (setq *TwinOffset:Erase* "No"))
(or *TwinOffset:Layer* (setq *TwinOffset:Layer* "Source"))

;; ---------------------------------------------------------------------------
;; TwinOffset:Doc  -  cached active document
;; ---------------------------------------------------------------------------
(defun TwinOffset:Doc nil
    (eval (list 'defun 'TwinOffset:Doc 'nil
                (vla-get-activedocument (vlax-get-acad-object))
          )
    )
    (TwinOffset:Doc)
)

;; ---------------------------------------------------------------------------
;; TwinOffset:Both
;; ---------------------------------------------------------------------------
;; Offsets one object by +dist and by -dist.
;;
;; Each direction is attempted separately and independently caught, because a
;; tight inside curve can be impossible to offset by the requested distance -
;; the offset would have to fold through itself. When that happens it should
;; cost that one side, not the whole operation.
;;
;; Offset returns a list of the new objects, since offsetting a single polyline
;; can produce more than one result. Every one of them is moved to the current
;; layer when the Layer option calls for it.
;;
;; obj     - [vla-object] object to offset
;; dist    - [real] offset distance
;; current - [boolean] T to place results on the current layer
;; ---------------------------------------------------------------------------
(defun TwinOffset:Both ( obj dist current / result )
    (foreach d (list dist (- dist))
        (setq result (vl-catch-all-apply 'vlax-invoke (list obj 'Offset d)))
        (if (and (not (vl-catch-all-error-p result)) current)
            (foreach new result
                (vla-put-layer new (getvar 'CLAYER))
            )
        )
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; TwinOffset:Settings
;; ---------------------------------------------------------------------------
;; Runs the distance prompt, including its Through / Erase / Layer options.
;;
;; Returns the offset distance to use, or -1 to mean "ask for a through point
;; per object", or nil if the user cancelled.
;;
;; The loop continues while an OPTION was chosen - because choosing an option
;; should redisplay the prompt rather than proceed - and exits once a distance
;; or Through has been settled on.
;; ---------------------------------------------------------------------------
(defun TwinOffset:Settings ( / input dist )
    (while
        (progn
            (princ
                (strcat "\nCurrent settings:  Erase source=" *TwinOffset:Erase*
                        "   Layer=" *TwinOffset:Layer*
                        "   OFFSETGAPTYPE=" (itoa (getvar 'OFFSETGAPTYPE))
                )
            )
            ;; initget 6 rejects zero and negative distances while still
            ;; permitting the three keywords.
            (initget 6 "Through Erase Layer")
            (setq input
                (getdist
                    (strcat "\nSpecify offset distance [Through/Erase/Layer] <"
                            (if (minusp (getvar 'OFFSETDIST))
                                "Through"
                                (rtos (getvar 'OFFSETDIST))
                            )
                            ">: "
                    )
                )
            )
            (cond
                ;; Enter - accept the remembered distance and stop looping.
                (   (null input)
                    (setq dist (getvar 'OFFSETDIST))
                    nil
                )

                ;; Through mode is flagged by storing -1 in OFFSETDIST, which
                ;; is the same convention the native OFFSET command uses.
                (   (= "Through" input)
                    (setq dist (setvar 'OFFSETDIST -1))
                    nil
                )

                (   (= "Erase" input)
                    (initget "Yes No")
                    (setq *TwinOffset:Erase*
                        (cond ((getkword (strcat "\nErase source object after offsetting? [Yes/No] <"
                                                 *TwinOffset:Erase* ">: ")))
                              (*TwinOffset:Erase*)
                        )
                    )
                    t
                )

                (   (= "Layer" input)
                    (initget "Current Source")
                    (setq *TwinOffset:Layer*
                        (cond ((getkword (strcat "\nLayer for offset objects [Current/Source] <"
                                                 *TwinOffset:Layer* ">: ")))
                              (*TwinOffset:Layer*)
                        )
                    )
                    t
                )

                ;; A real distance was typed or picked - remember and stop.
                (   input
                    (setq dist (setvar 'OFFSETDIST input))
                    nil
                )
            )
        )
    )
    dist
)

;; ---------------------------------------------------------------------------
;; TwinOffset:ThroughDistance
;; ---------------------------------------------------------------------------
;; Returns the distance from an object to a picked point - used in Through
;; mode, where the offset is specified by where the result should pass rather
;; than by a typed value.
;;
;; The t argument to getclosestpointto extends the object where necessary, so
;; a point beyond the end of a line still yields a sensible perpendicular
;; distance rather than measuring to the endpoint.
;; ---------------------------------------------------------------------------
(defun TwinOffset:ThroughDistance ( ent pt )
    (setq pt (trans pt 1 0))
    (distance pt (vlax-curve-getClosestPointTo ent pt t))
)

;; ---------------------------------------------------------------------------
;; c:TWINOFFSET  -  main routine
;; ---------------------------------------------------------------------------
(defun c:TWINOFFSET ( / *error* vars vals dist sel ent obj pt current count )

    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars)
    )

    (defun TwinOffset:Restore ( )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (command "_.UNDO" "_End")
            (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        )
        (princ)
    )

    (defun *error* ( msg )
        (TwinOffset:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** TWINOFFSET error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)
    (setq count 0)

    (if (setq dist (TwinOffset:Settings))
        (progn
            (setq current (= "Current" *TwinOffset:Layer*))
            ;; AutoCAD 2015 and later refuse (command) inside an *error* handler
            ;; unless the routine says up front that it will use one. Restore does,
            ;; to close this undo group. The declaring call is absent on older
            ;; releases, so it is wrapped rather than tested for.
            (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
            (command "_.UNDO" "_Begin")

            ;; Keep offering objects until the user exits, so a whole run of
            ;; centrelines can be done without restarting the command.
            (while
                (progn
                    (initget "Exit")
                    (setq sel (entsel "\nSelect object to offset or [Exit] <Exit>: "))
                    (cond
                        (   (or (null sel) (= "Exit" sel))
                            nil
                        )

                        (   (not (wcmatch (cdr (assoc 0 (entget (car sel)))) TwinOffset:Types))
                            (princ "\nThat object type cannot be offset.")
                            t
                        )

                        (   t
                            (setq ent (car sel)
                                  obj (vlax-ename->vla-object ent)
                            )

                            (if (minusp dist)
                                ;; ---------------------------------------------
                                ;; Through mode - the distance comes from a
                                ;; picked point, asked once per object.
                                ;; ---------------------------------------------
                                (progn
                                    (initget "Exit")
                                    (setq pt (getpoint "\nSpecify through point or [Exit] <next object>: "))
                                    (if (listp pt)
                                        (progn
                                            (if pt
                                                (progn
                                                    (TwinOffset:Both obj
                                                        (TwinOffset:ThroughDistance ent pt)
                                                        current
                                                    )
                                                    (if (= "Yes" *TwinOffset:Erase*)
                                                        (vla-delete obj)
                                                    )
                                                    (setq count (1+ count))
                                                )
                                            )
                                            t
                                        )
                                        nil     ; user chose Exit
                                    )
                                )

                                ;; ---------------------------------------------
                                ;; Fixed-distance mode.
                                ;; ---------------------------------------------
                                (progn
                                    (TwinOffset:Both obj dist current)
                                    (if (= "Yes" *TwinOffset:Erase*)
                                        (vla-delete obj)
                                    )
                                    (setq count (1+ count))
                                    t
                                )
                            )
                        )
                    )
                )
            )

            (princ (strcat "\n" (itoa count)
                           " object" (if (= 1 count) "" "s") " offset to both sides."
                   )
            )
        )
        (princ "\n*Cancelled*")
    )

    (TwinOffset:Restore)
    (princ)
)

;; Short alias.
(defun c:TWOF nil (c:TWINOFFSET))

(princ)