;; My-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
;;
;; NOTE: This app is still in BETA so here is a rev. log.
;; Revison log: 0.1 -- initial trial
;; 0.2 -- Removed xrefs from becoming ``objects''.
;; 0.3 -- Cleaned up a variable left declaired.
;;
;; Author Notes:
;; o A Known limitation of this code is that the use
;; of transparent commands while in line command is
;; limited.
( /
;; variables
lay
x
;; procedures...
line-vl-Put-ActiveLayer
line-GetPointObj
line-vl-put-ObjLayerCurrent
AweSh0t
)
(
;; get the point from the user.
(princ "\nYou did not select a point, please try again. ")) x
) )
;;
;; set up error handler.
;;
(defun AweSh0t
(s
/ line
-vl
-Put
-ActiveLayer
line-GetPointObj
line-vl-put-ObjLayerCurrent
AweSh|t)
olderr nil)
(setq olderr
*error* *error* AweSh0t
)
;; and some other routines we will need.
(defun line
-vl
-Put
-ActiveLayer
(Name
/ x
) ;; (setq obj (getpointobj pnt))
(name
(defun line
-GetPointObj
(pt
/ obj pt
) ;; disable xref objects from the list of items.
;; if we get any further objects to eliminate, redo
;; entire lisp.
;; otherwise just create an object from picked point.
obj )
(defun line
-vl
-put
-ObjLayerCurrent
(obj
)
;; Now that we have support procedures set up, we can now get on with the work.
(line
-vl
-put
-ObjLayerCurrent
(setq obj
(line
-getpointobj x
))) (AweSh0t nil)
)