MikeP Posted April 16, 2009 Share 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 Link to comment Share on other sites More sharing options...
Lee Mac Posted April 16, 2009 Share Posted April 16, 2009 Why not just use my other LISP: http://www.cadtutor.net/forum/showthread.php?t=34914 Quote Link to comment Share on other sites More sharing options...
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.