;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
;;; kwb 20021103
;;; KDUB:getdist (msg def bit kwd bpt
;;;
;;; Arguments:
;;; msg : The prompt string.
;;; def : Value to return if response is <enter>.
;;; bit : initget bit
;;; kwd : Initget keywords string.
;;; bpt : Base point
;;;
;;; Note : Arguments may be set to nil
(defun kdub:getdist (msg def bit kwd bpt / returnvalue)
(or kwd (setq kwd ""))
(or bit (setq bit 1))
(setq msg (strcat "\n"
(cond (msg)
("Specify Distance")
)
)
)
(if def
(setq msg (strcat "\n" msg " <<" (rtos def) ">>: ")
bit (logand bit (~ 1))
;; drop the 1 bit if def used
)
(setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq returnvalue
(if bpt
(getdist msg bpt)
(getdist msg)
)
)
(if returnvalue
returnvalue
def
)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
;;; kwb 20021103
;;; KDUB:getpoint (msg def bit kwd bpt
;;; Arguments:
;;; msg : The prompt string.
;;; def : Value to return if response is <enter>.
;;; bit : initget bit
;;; kwd : Initget keywords string.
;;; bpt : Base point
;;;
;;; requires KDUB:ptos
;;;
(defun kdub:getpoint (promptmsg ; The prompt string.
default ; return Value if <user enter> in UCS
initbit ; Initget bit
keywordlist ; Initget keywords List of strings
basepoint ; Base point < or nil > in UCS
;
/ promptmessage initstring
keywordstring returnvalue parameterlist
)
;;------------------------------
(or initbit (setq initbit 0))
;;------------------------------
(if keywordlist
(setq initstring (substr
(apply 'strcat
(mapcar '(lambda (item) (strcat " " item)) keywordlist)
)
2
)
keywordstring (strcat " [" (vl-string-translate " " "/" initstring) "]")
)
(setq initstring ""
keywordstring ""
)
)
;;------------------------------
(setq promptmessage
(strcat
"\n"
(cond (promptmsg)
("Specify Point")
)
keywordstring
(if default
(progn (setq initbit (logand initbit (~ 1)))
(if (= (type default) 'str)
(strcat " <<" default ">>")
;;
;; else, assume it is a point .. user beware
(strcat " <<" (kdub:ptos default nil nil) ">>")
)
)
""
)
": "
)
)
;;------------------------------
(initget initbit initstring)
(if (vl-catch-all-error-p
(setq returnvalue
(vl-catch-all-apply
'getpoint
(if basepoint ; in ucs
(list promptmessage basepoint)
(list promptmessage)
)
)
)
)
;; ESC was pressed.
(setq returnvalue nil
default nil
)
)
(if returnvalue
returnvalue
default
)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
;;; kwb 20021103
;;; KDUB:ptos (pt xmode xprec
;; Return a point formatted as a string
;; Arguments :
;; pt : point list
;; xmode : Units to use , can be nil
;; xprec : display precision to use , can be nil
(defun kdub:ptos (pt xmode xprec)
(or xmode (setq xmode (getvar "LUNITS")))
(or xprec (setq xprec (getvar "LUPREC")))
(if pt
(strcat (rtos (car pt) xmode xprec)
", "
(rtos (cadr pt) xmode xprec)
", "
(rtos (caddr pt) xmode xprec)
)
)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
(defun kdub:draw_lightweightpolyline
(VertexList la closeflag / modelspace ucsZNormal elev PolyObj)
(setq ucsZNormal (trans '(0 0 1) 1 0 t)
elev (caddr (trans (car VertexList) 1 ucsZNormal))
modelspace (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
)
(setq PolyObj (vlax-invoke
modelspace
'addLightWeightPolyline
(apply 'append
(mapcar '(lambda (pt)
(setq pt (trans pt 1 ucsZNormal))
(list (car pt) (cadr pt))
)
VertexList
)
)
)
)
(vla-put-elevation PolyObj elev)
(if la
(vla-put-layer PolyObj la)
)
(vla-put-normal PolyObj (vlax-3d-point ucsZNormal))
(vla-put-closed PolyObj closeflag)
PolyObj
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
(defun draw_pline (/ PointList dynamicPoint)
(setq PointList (list (setq dynamicPoint
(kdub:getpoint "Start point.." nil 1 nil nil)
)
)
)
(while (setq dynamicPoint
(kdub:getpoint
"Specify next point.. (ESC) to cancel"
nil 1
nil dynamicPoint
)
)
(setq PointList (cons dynamicPoint PointList))
)
(kdub:draw_lightweightpolyline
(reverse PointList)
(getvar "CLAYER")
:vlax-false
)
)
(defun c:doit (/ *error* plineObj offsetDist)
(defun *error* (msg /)
;;----- Cancel any Active Commands -----------------------------
(while (< 0 (getvar "cmdactive")) (command))
;;----- Display error message if applicable _-------------------
(cond
((not msg))
((member (strcase msg t)
'("console break" "function cancelled" "quit / exit abort")
)
)
((princ (strcat "\nApplication Error: " (itoa (getvar "errno")) " :- " msg)
)
;;----- Display backtrace ---------------------
(vl-bt)
)
)
(setvar "errno" 0)
(princ)
)
;;-------------------------------------
;;-------------------------------------
(setq plineObj (draw_pline)
*offsetDist* (if *offsetDist*
*offsetDist*
200.0
)
*filletDist* (if *filletDist*
*filletDist*
100.0
)
offsetDist (kdub:getdist "Offset Distance" *offsetDist* nil nil nil)
filletDist (kdub:getdist "Fillet Distance" *filletDist* nil nil nil)
)
(if offsetDist
(setq *offsetDist* offsetDist)
)
(if filletDist
(setq *filletDist* filletDist)
)
(if (and offsetDist filletDist)
(progn (vla-offset plineObj offsetDist)
(command "_Fillet" "_Radius" *filletDist* "_Polyline" (entlast))
(vla-delete plineObj)
)
)
(*error* nil)
(princ)
)
(prompt "\nFile loaded. Command to run:- DOIT\n")
(princ)
;|«Visual LISP© Format Options»
(80 2 45 2 nil "end of " 80 9 1 0 0 nil nil nil T)
;*** DO NOT add text below the comment! ***|;
and the message :
Command: doit
Start point..:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Invalid point.
Specify next point.. (ESC) to cancel: *Cancel*
Offset Distance <<500.0000>>:
Fillet Distance <<500.0000>>:
_Fillet
Current settings: Mode = TRIM, Radius = 500.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: _Polyline Select
2D polyline: _Radius
*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
Select 2D polyline: