AutoLISP: Continue Line on Layer…

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.

Here’s how:

  • 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)
)
Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, AutoLISP: Creating, Layers, Modifying. Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s