Similar to the previous post [found here] that continues a polyline one whatever layer it is on, the featured routine for today lets you snap to entity and sets that layer current and then starts the line command. Pretty simple, yet very useful.
- CLINE <enter> to start
- Snap to an object – The object that you snap to will do 2 things 1) set its layer current and 2) start the line command from where you snapped to.
- Place your lines as needed
- After you have finished, notice that the current layer was reset to what it was before the LISP routine started.
(defun c:Cline ;; CLine - Continue line ;; ;; This procedure is ment to be a replacement for the line command. ;; Although it uses the defualt line command for its core opperation ;; it changes the current layer to that of an entity selected. ;; If an object is not detected, the current layer is used. ;; ;; UPDATE: See revisions. I removed the selection of an xref. ;; ;; By: John Kaul ;; Date: 05.14.06 ;; ;; Revison log: 0.1 ;; 0.2 -- Removed xrefs from becoming ``objects''. ;; 0.3 -- Cleaned up a variable left declaired. ;; 0.4 -- Fixed a major boo-boo when I changed ;; to a diff error trap. (04.30.07) ( / ;; variables lay x ;; procedures... vl-Put-ActiveLayer GetPointObj vl-put-ObjLayerCurrent AweSh0t ) (vl-load-com) ( (lambda () ;; get the point from the user. (while (not (setq x (getpoint "\nSelect Point: "))) (princ "\nYou did not select a point, please try again. ")) x) ) ;; if we've came this far in the routine... ;; set up error handler. ;; ;; NOTE: Leave as seperate proced for now. (defun AweSh0t (s) (setq *error* olderr olderr nil) (setvar 'clayer lay) (princ) ) (setq olderr *error* *error* AweSh0t) ;; and some other routines we will need. (defun vl-Put-ActiveLayer (Name / x) ;; (setq obj (getpointobj pnt)) (cond (name (and (setq x (vla-get-activedocument (vlax-get-acad-object))) (vla-put-ActiveLayer x (vla-add (vla-get-layers x ) Name))))) ) (defun GetPointObj (pt / obj pt) (setvar "LASTPOINT" pt) (cond ((ssget pt) (setq pt (ssname (ssget pt) 0)) (cond ;; disable xref objects from the list of items. ;; if we get any further objects to eliminate, redo ;; entire lisp. ((assoc 2 (entget pt)) (not (assoc 1 (tblsearch "BLOCK" (cdr (assoc 2 (entget pt))))))) ;; otherwise just create an object from picked point. ((setq obj (vlax-ename->vla-object pt)))))) obj ) (defun vl-put-ObjLayerCurrent (obj) (cond (obj (vl-put-ActiveLayer (vlax-get-property obj 'Layer)))) ) ;; Now that we have support procedures set up, we can now get on with the work. (setq lay (getvar 'clayer)) (vl-put-ObjLayerCurrent (setq obj (getpointobj x))) (princ "\n ") (command "_line" x) (while (eq (getvar 'cmdactive) 1) (command PAUSE)) (AweSh0t nil) )