;;; =========================================================================== ;;; Routine Name: OMPNL (Offset Multiple Polylines to New Layer) ;;; Version: 2026.1 (Direct UI Edition) ;;; Description: Offsets multiple polylines by the same amount, in the same ;;; direction, directly generating them on target layers. ;;; Eliminated command-line loop - runs straight from the UI menu. ;;; =========================================================================== (vl-load-com) ;; Global variables to save configurations across multiple command calls (if (not *OMPNL_Layer*) (setq *OMPNL_Layer* "Current")) (if (not *OMPNL_Dist*) (setq *OMPNL_Dist* 1.0)) (if (not *OMPNL_Direction*) (setq *OMPNL_Direction* "In")) (if (not *OMPNL_LayerName*) (setq *OMPNL_LayerName* "")) ;; --------------------------------------------------------------------- ;; POP-UP SETTINGS DIALOG (Toggled Version) ;; --------------------------------------------------------------------- (defun OMPNL:SettingsDialog (/ dclFile file dclId result layMode newDist newDir newLayMode newName tempDist) ;; Build a temporary DCL file (setq dclFile (vl-filename-mktemp "ompnl" nil ".dcl")) (setq file (open dclFile "w")) (write-line "ompnl_settings : dialog {" file) (write-line " label = \"OMPNL - Offset Settings\";" file) (write-line " : edit_box {" file) (write-line " key = \"dist\";" file) (write-line " label = \"Offset distance:\";" file) (write-line " edit_width = 12;" file) (write-line " }" file) (write-line " : boxed_column {" file) (write-line " label = \"Direction\";" file) (write-line " : row {" file) (write-line " : toggle { key = \"tg_in\"; label = \"In\"; }" file) (write-line " : toggle { key = \"tg_out\"; label = \"Out\"; }" file) (write-line " }" file) (write-line " }" file) (write-line " : boxed_column {" file) (write-line " label = \"Destination layer\";" file) (write-line " : toggle { key = \"tg_current\"; label = \"Current layer\"; }" file) (write-line " : toggle { key = \"tg_source\"; label = \"Source object's layer\"; }" file) (write-line " : toggle { key = \"tg_name\"; label = \"Named layer (type below)\"; }" file) (write-line " : toggle { key = \"tg_pick\"; label = \"Pick an object after OK\"; }" file) (write-line " spacer;" file) (write-line " : edit_box {" file) (write-line " key = \"lname\";" file) (write-line " label = \"Layer name:\";" file) (write-line " edit_width = 20;" file) (write-line " }" file) (write-line " }" file) (write-line " ok_cancel;" file) (write-line "}" file) (close file) (setq dclId (load_dialog dclFile)) (if (not (new_dialog "ompnl_settings" dclId)) (progn (unload_dialog dclId) (vl-file-delete dclFile) (alert "Could not open the settings dialog.") (setq result nil) ) (progn ;; ----- Pre-fill with the saved settings ----- (set_tile "dist" (rtos *OMPNL_Dist* 2 4)) (if (= *OMPNL_Direction* "In") (progn (set_tile "tg_in" "1") (set_tile "tg_out" "0")) (progn (set_tile "tg_out" "1") (set_tile "tg_in" "0")) ) (setq layMode (cond ((= (strcase *OMPNL_Layer*) "CURRENT") "tg_current") ((= (strcase *OMPNL_Layer*) "SOURCE") "tg_source") (t "tg_name") ) ) (set_tile "tg_current" "0") (set_tile "tg_source" "0") (set_tile "tg_name" "0") (set_tile "tg_pick" "0") (set_tile layMode "1") (if (= layMode "tg_name") (set_tile "lname" *OMPNL_Layer*) (set_tile "lname" *OMPNL_LayerName*) ) ;; UI Interaction function for disabling Layer Name input (defun update_ompnl_ui () (if (= (get_tile "tg_name") "1") (mode_tile "lname" 0) (mode_tile "lname" 1) ) ) (update_ompnl_ui) ;; Exclusive Tick Logic (Auto-Uncheck) (action_tile "tg_in" "(if (= $value \"1\") (set_tile \"tg_out\" \"0\") (set_tile \"tg_in\" \"1\"))") (action_tile "tg_out" "(if (= $value \"1\") (set_tile \"tg_in\" \"0\") (set_tile \"tg_out\" \"1\"))") (action_tile "tg_current" "(if (= $value \"1\") (progn (set_tile \"tg_source\" \"0\") (set_tile \"tg_name\" \"0\") (set_tile \"tg_pick\" \"0\")) (set_tile \"tg_current\" \"1\")) (update_ompnl_ui)") (action_tile "tg_source" "(if (= $value \"1\") (progn (set_tile \"tg_current\" \"0\") (set_tile \"tg_name\" \"0\") (set_tile \"tg_pick\" \"0\")) (set_tile \"tg_source\" \"1\")) (update_ompnl_ui)") (action_tile "tg_name" "(if (= $value \"1\") (progn (set_tile \"tg_current\" \"0\") (set_tile \"tg_source\" \"0\") (set_tile \"tg_pick\" \"0\")) (set_tile \"tg_name\" \"1\")) (update_ompnl_ui)") (action_tile "tg_pick" "(if (= $value \"1\") (progn (set_tile \"tg_current\" \"0\") (set_tile \"tg_source\" \"0\") (set_tile \"tg_name\" \"0\")) (set_tile \"tg_pick\" \"1\")) (update_ompnl_ui)") ;; ----- Read the tiles when OK is pressed ----- (action_tile "accept" (strcat "(setq newDist (get_tile \"dist\"))" "(setq newDir (if (= (get_tile \"tg_in\") \"1\") \"In\" \"Out\"))" "(setq newLayMode (cond ((= (get_tile \"tg_current\") \"1\") \"current\")" " ((= (get_tile \"tg_source\") \"1\") \"source\")" " ((= (get_tile \"tg_name\") \"1\") \"name\")" " (t \"pick\")))" "(setq newName (get_tile \"lname\"))" "(done_dialog 1)" ) ) (action_tile "cancel" "(done_dialog 0)") (setq result (= (start_dialog) 1)) ;; ----- Validate and store the new settings ----- (if result (progn (setq tempDist (distof newDist 2)) (if (and tempDist (> tempDist 0.0)) (setq *OMPNL_Dist* tempDist) (progn (alert "Invalid distance - keeping the previous value.") (setq result nil) ) ) (if result (progn (setq *OMPNL_Direction* newDir) (cond ((= newLayMode "current") (setq *OMPNL_Layer* "Current")) ((= newLayMode "source") (setq *OMPNL_Layer* "Source")) ((= newLayMode "name") (if (/= newName "") (progn (setq *OMPNL_LayerName* newName) (if (not (tblsearch "LAYER" newName)) (command "._-layer" "_new" newName "") ) (setq *OMPNL_Layer* newName) ) (progn (alert "No layer name typed - keeping the previous layer setting.") (setq result nil) ) ) ) ;; "pick" is handled after the dialog closes ) ) ) ) ) (unload_dialog dclId) (vl-file-delete dclFile) ) ) ;; Returns: "cancel" | "ok" | "pick" (if result (if (and newLayMode (= newLayMode "pick")) "pick" "ok") "cancel" ) ) ;; --------------------------------------------------------------------- ;; MAIN COMMAND ;; --------------------------------------------------------------------- (defun c:OffsetMultiplePolylinestoNewLayer (/ ss echo offdist direction n en ed pt LL UR MP minpoint maxpoint area1 area2 newpoly vtx ucsFlag enExtr elev enType ENTITY dlgResult pickedEnt targetLayer obj) (vl-load-com) ;; Trigger the Settings UI immediately (setq dlgResult (OMPNL:SettingsDialog)) (cond ((= dlgResult "cancel") (princ "\nCommand cancelled.") ) (t ;; If user selected "Pick an object", ask them to click an object now (if (= dlgResult "pick") (progn (setq pickedEnt (entsel "\nSelect object to copy target layer from: ")) (if pickedEnt (progn (setq *OMPNL_Layer* (cdr (assoc 8 (entget (car pickedEnt))))) (princ (strcat "\nDestination layer set to: " *OMPNL_Layer*)) ) (princ "\nNo selection made. Using previous layer configuration.") ) ) ) ;; Directly prompt for the polylines to offset (prompt "\nSelect polyline(s) to offset: ") (setq ss (ssget '((0 . "*POLYLINE")))) (if (and ss (> (sslength ss) 0)) (progn (command "._undo" "_begin") (setq offdist *OMPNL_Dist* direction *OMPNL_Direction* echo (getvar "CmdEcho")) (setvar "CmdEcho" 0) ;; -------------------------------------------------------------- ;; ORIGINAL DIRECTION LOGIC: OUT ;; -------------------------------------------------------------- (if (= direction "Out") (progn ;;OUT (setq n 0) (setq pt (list (1+ (car (getvar 'extmax))) (1+ (cadr (getvar 'extmax))))) (repeat (sslength ss) (setq en (ssname ss n)) (if (not (= 8 (logand 8 (cdr (assoc 70 (entget en)))))) ;; No 3D Polylines (progn (command "._offset" offdist en pt "") ;; Compute the destination layer context dynamically (setq targetLayer (cond ((= (strcase *OMPNL_Layer*) "CURRENT") (getvar "CLayer")) ((= (strcase *OMPNL_Layer*) "SOURCE") (cdr (assoc 8 (entget en)))) (t *OMPNL_Layer*) ) ) (setq ENTITY (entlast) ENTITY (entget ENTITY) ENTITY (subst (cons 8 targetLayer) (assoc 8 ENTITY) ENTITY) ) (entmod ENTITY) ) ) (setq n (1+ n)) ) ) ;; -------------------------------------------------------------- ;; ORIGINAL DIRECTION LOGIC: IN ;; -------------------------------------------------------------- (progn ;;IN (setq n 0) (repeat (sslength ss) (setq ucsFlag nil) (setq en (ssname ss n)) (setq ed (entget en)) (setq enType (cdr (assoc 0 ed))) (if (not (= 8 (logand 8 (cdr (assoc 70 ed))))) (progn (setq enExtr (cadddr (assoc 210 ed))) (if (not (= enExtr (caddr (trans '(0.0 0.0 1.0) 0 1)))) (progn (setq elev (cond ((= enType "LWPOLYLINE") (cdr (assoc 38 ed)) ) (T (caddr (cdr (assoc 10 ed))) ) ) ) (command "._ucs" "_3point" (trans (list 0.0 0.0 elev) en 1) (trans (list 1.0 0.0 elev) en 1) (trans (list 0.0 1.0 elev) en 1) ) (setq ucsFlag T) ) ) (setq obj (vlax-ename->vla-object en)) (vla-getboundingbox obj 'minpoint 'maxpoint) (setq LL (trans (vlax-safearray->list minpoint) 0 1) UR (trans (vlax-safearray->list maxpoint) 0 1) MP (list (/ (+ (car LL) (car UR)) 2.0) (/ (+ (cadr LL) (cadr UR)) 2.0)) ) (command "._area" "_object" en) (setq area1 (getvar 'area)) (command "._offset" offdist en MP "") ;; Compute the destination layer context dynamically (setq targetLayer (cond ((= (strcase *OMPNL_Layer*) "CURRENT") (getvar "CLayer")) ((= (strcase *OMPNL_Layer*) "SOURCE") (cdr (assoc 8 (entget en)))) (t *OMPNL_Layer*) ) ) (setq ENTITY (entlast) ENTITY (entget ENTITY) ENTITY (subst (cons 8 targetLayer) (assoc 8 ENTITY) ENTITY) ) (entmod ENTITY) (setq newpoly (entlast)) (command "._area" "_object" newpoly) (setq area2 (getvar 'area)) ;; Outward bounce correction validation fallback logic (if (> area2 area1) (progn (setq vtx (entnext (entnext en))) (setq pt (trans (cdr (assoc 10 (entget vtx))) 0 1)) (command "._offset" (* 2.0 offdist) newpoly pt "") (setq ENTITY (entlast) ENTITY (entget ENTITY) ENTITY (subst (cons 8 targetLayer) (assoc 8 ENTITY) ENTITY) ) (entmod ENTITY) (entdel newpoly) ) ) ) ) (if ucsFlag (command "._ucs" "_p")) (setq n (1+ n)) ) ) ) (setvar "CmdEcho" echo) (command "._undo" "_end") (princ "\nOffset processing complete.") ) (princ "\nNo qualifying polylines selected.") ) ) ) (princ) ) (defun c:ompnl () (c:OffsetMultiplePolylinestoNewLayer) ) (princ "\nOffsetMultiplePolylinestoNewLayer loaded. Type OMPNL to run.") (princ)