MikeP Posted April 16, 2009 Posted April 16, 2009 I have this lisp that I got from this forum but I want it a little different. Rather than using leaders with numbers. I would like the command to work that where ever I click it adds a new number. ;; ============ NumCur.lsp =============== ;; ;; FUNCTION: ;; Will sequentially place numerical ;; text at the end of a leader, upon ;; mouse click. ;; ;; SYNTAX: numCur ;; ;; AUTHOR: ;; Copyright (c) 2009, Lee McDonnell ;; (Contact Lee Mac, CADTutor.net) ;; ;; PLATFORMS: ;; No Restrictions, ;; only tested in ACAD 2004. ;; ;; VERSION: ;; 1.0 ~ 05.04.2009 ;; ;; ======================================= (defun c:numCur (/ *error* vlst ovar doc spc dVars tmpVars cObj tBox GLst mPos cPt cDis EnPt ArPt1 ArPt2 AngCor vCol Verts VertVar ) (vl-load-com) (defun *error* (msg) (redraw) (if ovar (mapcar 'setvar vlst ovar)) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " (strcase msg))) (princ "\n<<-- cancelled -->>")) (princ)) (setq vlst '("OSMODE" "CLAYER") ovar (mapcar 'getvar vlst)) (setvar "OSMODE" 0) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or (tblsearch "LAYER" "Num-Text") (vla-put-color (vla-add (vla-get-layers doc) "NumText") acYellow)) (setq dVars '(sNum inNum Pref Suff)) (mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 1 "" "")) (setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: ")) (getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: ")) (getstring t (strcat "\nSpecify Prefix <" (if (eq "" Pref) "-None-" Pref) ">: ")) (getstring t (strcat "\nSpecify Suffix <" (if (eq "" Suff) "-None-" Suff) ">: ")))) (mapcar '(lambda (x y) (or (or (not x) (eq "" x)) (set y x))) tmpVars dVars) (while (and (setq cEnt (car (entsel "\nSelect Curve to Label: "))) (member (cdr (assoc 0 (entget cEnt))) '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "ELLIPSE" "CIRCLE"))) (vla-EndUndoMark doc) (vla-StartUndomark doc) (setq cObj (vlax-ename->vla-object cEnt) tBox (textbox (list (cons 1 (setq tStr (strcat Pref (rtos sNum 2 0) Suff)))))) (princ "\nSelect Location for Leader... ") (while (= (car (setq GLst (grread T 1))) 5) (redraw) (if (= (type (setq mPos (cadr GLst))) 'list) (progn (setq cPt (vlax-curve-getClosestPointto cObj mPos) cAng (angle cPt mPos) cDis (distance cPt mPos) EnPt (polar cPt cAng (/ cDis 1.5)) ArPt1 (polar cPt (+ cAng (/ pi 12)) (/ cDis 8.0)) ArPt2 (polar cPt (- cAng (/ pi 12)) (/ cDis 8.0)) AngCor (fix (rem (abs (* 10.0 (fix (* 18.0 (/ cAng pi))))) 255.0))) (or (and (< AngCor 1.0) (setq vCol 1)) (setq vCol AngCor)) (grvecs (list vCol cPt EnPt vCol cPt ArPt1 vCol cPt ArPt2))))) (princ "\nSelect Leader Size & Angle...") (while (= (car (setq GLst (grread T 1))) 5) (redraw) (if (= (type (setq mPos (cadr GLst))) 'list) (progn (setq cAng (angle cPt mPos) cDis (distance cPt mPos) ArPt1 (polar cPt (+ cAng (/ pi 12)) (/ cDis 8.0)) ArPt2 (polar cPt (- cAng (/ pi 12)) (/ cDis 8.0))) (grvecs (list vCol cPt mPos vCol cPt ArPt1 vCol cPt ArPt2))))) (setq Verts (apply 'append (list cPt mPos)) VertVar (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length Verts)))) Verts))) (vla-addleader spc VertVar (vla-addMText spc (vlax-3d-Point (polar mPos 0 (/ (getvar "TEXTSIZE") 2.0))) (- (caadr tBox) (caar tBox)) tStr) acLineWithArrow) (redraw) (setq sNum (+ sNum inNum))) (mapcar 'setvar vlst ovar) (redraw) (princ)) Quote
Lee Mac Posted April 16, 2009 Posted April 16, 2009 Why not just use my other LISP: http://www.cadtutor.net/forum/showthread.php?t=34914 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.