Trim to Layer

[kieren]

Hi Guys!
Found this little beauty a few days ago, and it is proving really useful (author unknown, sorry).
However, I have a few problems with it and I'm asking for help!
i. I cannot get it to run from the command prompt using "trim2lay", but have to load it each time I want to use it. How do I overcome this?
ii. What code is needed to allow an entity selection for the desired destination layer?

Hope someone can help.
Many thanks,
KIEREN

;     This macro performs a "TRIM" om selected entities
;    an transfers the "EXCESS" section of the entity onto
;    a user defined layer. This can be used with a layer
;    with a "hidden" linetype to illustrate a section of a
;    part obscured from view.

;    If an entity is selected that does not intersect
;    a boundary, it is "CHANGED" to the transfer layer.

;    The macro will only work with LINES,ARCS and CIRCLES.
;    All other entities will be ignored.

;    Enter a null reponse to the entity selection prompt
;    to terminate the command.


; Function to store system variables
(defun MODES (a)
   (setq MLST '())
   (repeat (length a)
      (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
      (setq a (cdr a)))
)

; Function to reset system variables
(defun MODER ()
   (repeat (length MLST)
      (setvar (caar MLST) (cadar MLST))
      (setq MLST (cdr MLST))
   )
)


; Function to conceal arcs
(defun XARC (/ cen r)
    (command "LAYER" "S" $ln "")
    (setq a (cdr (assoc 50 e1)))
    (setq b (cdr (assoc 51 e1)))
    (setq cen (cdr (assoc 10 e1)))
    (setq r (cdr (assoc 40 e1)))
    (command "TRIM" ss "" (cadr e) "")
    (setq e2 (entget (car e)))
    (setq c (cdr (assoc 50 e2)))
    (setq d (cdr (assoc 51 e2)))
    (cond ((equal e1 e2)
           (command "CHANGE" (cdar e1) "" "P" "LA" $ln "")
          )
          ((and (equal a c) (/= b d) (equal el (entlast)))
           (command "ARC" (polar cen d r)
                          "c" cen
                          (polar cen b r)
           )
          )
          ((and (equal b d) (/= a c) (equal el (entlast)))
           (command "ARC" (polar cen a r)
                          "c" cen
                          (polar cen c r)
           )
          )
          (T
           (setq x (cdr (assoc 50 (entget (entlast)))))
           (setq y (cdr (assoc 51 (entget (entlast)))))
           (cond ((and (equal a c) (equal b y))
                  (command "ARC" (polar cen d r)
                                 "c" cen
                                 (polar cen x r)
                  )
                 )
           )
          )
    )
    (command "LAYER" "S" cl "")
)

; Function to conceal circles
(defun XCIRCLE (/ cen r)
    (command "LAYER" "S" $ln "")
    (setq el (entlast))
    (setq cen (cdr (assoc 10 e1)))
    (setq r (cdr (assoc 40 e1)))
    (command "TRIM" ss "" (cadr e) "")
    (setq e2 (entget (car e)))
    (cond  ((equal e1 e2)
            (command "CHANGE" (cdar e1) "" "P" "LA" $ln "")
           )
           ((= (cdr (assoc 0 e2)) "ARC")
            (setq r (cdr (assoc 40 e2)))
            (setq cen (cdr (assoc 10 e2)))
            (setq a (polar cen (cdr (assoc 50 e2)) r))
            (setq b (polar cen (cdr (assoc 51 e2)) r))
            (command "ARC" b "C" cen A)
           )
    )
    (command "LAYER" "S" cl "")
)

; Function to conceal lines
(defun XLINE ()
    (command "LAYER" "S" $ln "")
    (setq a (cdr (assoc 10 e1)))
    (setq b (cdr (assoc 11 e1)))
    (command "TRIM" ss "" (cadr e) "")
    (setq e2 (entget (car e)))
    (setq c (cdr (assoc 10 e2)))
    (setq d (cdr (assoc 11 e2)))
    (cond ((equal e1 e2)
           (command "CHANGE" (cdar e1) "" "P" "LA" $ln "")
          )
          ((and (equal a c) (/= b d) (equal el (entlast)))
           (command "LINE" d b "")
          )
          ((and (equal b d) (/= a c) (equal el (entlast)))
           (command "LINE" a c "")
          )
          (T
           (setq x (cdr (assoc 10 (entget (entlast)))))
           (setq y (cdr (assoc 11 (entget (entlast)))))
           (cond ((and (equal a c) (equal b y))
                  (command "LINE" d x "")
                 )
           )
          )
    )
    (command "LAYER" "S" cl "")
)

(defun c:trim2lay (/ cen r e el e1 e2 a b c cl d ln ss yn x y)

  (modes '("CMDECHO" "BLIPMODE" "HIGHLIGHT"))
  (setvar "CMDECHO" 0)
  (setvar "BLIPMODE" 0)
  (setq cl (getvar "CLAYER"))
;;prompt for layer
(if (setq e (car (entsel "\nPick Destination Layer, or <return> to Type It: ")))
    (setq ilayer (cdr (assoc 8 (entget e))))
)      
(if (not ilayer)
  (progn
    (setq ilayer (getstring "\nLayer: <Return> to Use Current Layer: "))
    (if (not (tblsearch "LAYER" ln))
             (progn
              (initget "Yes No")
              (setq prmpt (strcat "\nLayer "
                                  (strcase ln t)
                                  " does not exist. Create? <N>: "
                          )
              )
              (setq yn (getkword prmpt))
              (if (= yn "Yes")
                  (command "LAYER" "n" ln "")
                  (setq ln nil)
              )
             )
         )
    )
  )
)    
(if (= ilayer "") (setq ilayer (getvar "CLAYER")))
(princ (strcat "\nOffsetting to layer " ilayer "."))

  (prompt "\nSelect trim boundaries: ")
  (setq ss (ssget))
  (setvar "HIGHLIGHT" 0)
  (setq e (entsel "\nSelect entity to transfer "))
  (while e
    (setq e1 (entget (car e)))
    (setq el (entlast))
    (cond  ((= (cdr (assoc 0 e1)) "LINE")
            (xline)
           )
           ((= (cdr (assoc 0 e1)) "ARC")
            (xarc)
           )
           ((= (cdr (assoc 0 e1)) "CIRCLE")
            (xcircle)
           )
           (T (prompt "\nUnsuitable entity selected. "))
    )
    (setq e (entsel "\nSelect entity to transfer "))
  )
  (moder)
  (princ)
)

[RobertB]

#1, add the .lsp file to your Startup Suite (or load it in AcadDoc.lsp or your custom menu's .mnl file).

#2, no time for at the moment.

[CAB2k]

Or add this to your AcadDoc.lsp

(AUTOLOAD "trim2lay" '("trim2lay"))

And the very first prompt allows you so select the destination layer.

"Pick Destination Layer, or <return> to Type It:"

[kieren]

File atached is modified to work.
Hope it is of use to others.

Command prompt = trim2lay

Enjoy,