Can you help me to write this lispDo you want help, or do you want the code written for you ?
The offset command worked , but the fillet command didn't work . :-( .
Thanks you so much , Kerry! :-)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
;;; 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! ***|;
For me in ac2015 test1 works , test2 throws an error.
(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" "_Polyline" "_Radius" *filletDist* (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! ***|;
I change the code , but it doesn't work !Command: test1
Select object: _Fillet
Current settings: Mode = TRIM, Radius = 5.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
; error: Function cancelled
Select 2D polyline:
2 lines were filleted
Command: test2
Select object: _Fillet
Current settings: Mode = TRIM, Radius = 5.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Radius Specify
fillet radius <5.0000>: 123
Command: Polyline Unknown command "POLYLINE". Press F1 for help.
Command: <Entity name: FFEE30C0>
TEST2 Unknown command "TEST2". Press F1 for help.
Command: nil
Command: TEST2
Select object: *Cancel*
; error: Function cancelled
Command: f
FILLET
Current settings: Mode = TRIM, Radius = 123.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: poly
Select 2D polyline: r
*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
Select 2D polyline:
1 line was filleted
1 was too short
Command: f
FILLET
Current settings: Mode = TRIM, Radius = 123.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: r
Specify fillet radius <123.0000>: 5
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: poly
Select 2D polyline:
2 lines were filleted
The fillet command work when i specify fillet radius then poly