Gaszto Posted January 3, 2010 Posted January 3, 2010 Hi I need some help. I didn't use Autocad with VBA script, but for my problem i think it would be a good solution. I have some points on my drawing. I need these coordinates of points (i need only the x value) to copy a table. It's possible that I click to the dimension, and the VBA script copys this dimension's value to the clipboard? Can anybody make this script? Thanks Gaszto Quote
Lee Mac Posted January 3, 2010 Posted January 3, 2010 Try this Gaszto (defun c:dval (/ COL ENT I LST OBJ OBJLST PT ROW SS) ;; Place Dimension Value in Cell ~ Lee Mac 03.01.10 (vl-load-com) (if (setq i -1 ss (ssget "_X" '((0 . "ACAD_TABLE")))) (progn (while (setq ent (ssname ss (setq i (1+ i)))) (setq objLst (cons (vlax-ename->vla-object ent) objLst))) (while (progn (setq ent (car (entsel "\nSelect Dimension <Exit> : "))) (cond ( (eq 'ENAME (type ent)) (if (not (wcmatch (vla-get-ObjectName (setq obj (vlax-ename->vla-object ent))) "*Dimension")) (princ "\n** Object Must be a Dimension **") (while (progn (setq pt (getpoint "\nPick inside Cell to Place Text: ")) (cond ( (not pt)) ( (setq lst (car (vl-remove-if (function null) (mapcar (function (lambda (table) (if (eq :vlax-true (vla-HitTest table (vlax-3D-point (trans pt 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col)) (list table row col)))) ObjLst)))) (apply (function vla-SetText) (append lst (list (strcat (vla-get-TextPrefix obj) (rtos (vla-get-Measurement obj) (vla-get-UnitsFormat obj) (vla-get-PrimaryUnitsPrecision obj)) (vla-get-TextSuffix obj))))) nil) (t (princ "\n** Point must be inside Cell **")))))) t))))) (princ "\n** No Tables Found in Drawing **")) (princ)) PS> Welcome to the forums Quote
Gaszto Posted January 3, 2010 Author Posted January 3, 2010 Thanks for he quick answer One more question: I've loaded it, AutoCAD said "_appload tmp.lsp successfully loaded." but how can I run it? Quote
Lee Mac Posted January 3, 2010 Posted January 3, 2010 type "dVal" at the command line. http://www.cadtutor.net/forum/showthread.php?t=1390 Quote
Gaszto Posted January 3, 2010 Author Posted January 3, 2010 Thanks a lot. With this i can finish my work within a hour Quote
Lee Mac Posted January 3, 2010 Posted January 3, 2010 Thanks a lot. With this i can finish my work within a hour Excellent - Glad to have saved you some time Quote
Phiphi Posted January 5, 2010 Posted January 5, 2010 (defun c:dval (/ COL ENT I LST OBJ OBJLST PT ROW SS) ;; Place Dimension Value in Cell ~ Lee Mac 03.01.10 (vl-load-com) (if (setq i -1 ss (ssget "_X" '((0 . "ACAD_TABLE")))) (progn (while (setq ent (ssname ss (setq i (1+ i)))) (setq objLst (cons (vlax-ename->vla-object ent) objLst))) (while (progn (setq ent (car (entsel "\nSelect Dimension <Exit> : "))) (cond ( (eq 'ENAME (type ent)) (if (not (wcmatch (vla-get-ObjectName (setq obj (vlax-ename->vla-object ent))) "*Dimension")) (princ "\n** Object Must be a Dimension **") (while (progn (setq pt (getpoint "\nPick inside Cell to Place Text: ")) (cond ( (not pt)) ( (setq lst (car (vl-remove-if (function null) (mapcar (function (lambda (table) (if (eq :vlax-true (vla-HitTest table (vlax-3D-point (trans pt 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col)) (list table row col)))) ObjLst)))) (apply (function vla-SetText) (append lst (list (strcat (vla-get-TextPrefix obj) (rtos (vla-get-Measurement obj) (vla-get-UnitsFormat obj) (vla-get-PrimaryUnitsPrecision obj)) (vla-get-TextSuffix obj))))) nil) (t (princ "\n** Point must be inside Cell **")))))) t))))) (princ "\n** No Tables Found in Drawing **")) (princ)) Can you please update the Lisp to select Text/Mtext as well. Tkx. Quote
Lee Mac Posted January 5, 2010 Posted January 5, 2010 Can you please update the Lisp to select Text/Mtext as well. Tkx. Perhaps (defun c:dval (/ COL ENT I LST OBJ OBJLST PT ROW SS) ;; Place Dimension Value in Cell ~ Lee Mac 03.01.10 (vl-load-com) (if (setq i -1 ss (ssget "_X" '((0 . "ACAD_TABLE")))) (progn (while (setq ent (ssname ss (setq i (1+ i)))) (setq objLst (cons (vlax-ename->vla-object ent) objLst))) (while (progn (setq ent (car (entsel "\nSelect Dimension or Text <Exit> : "))) (cond ( (eq 'ENAME (type ent)) (if (not (wcmatch (vla-get-ObjectName (setq obj (vlax-ename->vla-object ent))) "*Dimension,*Text")) (princ "\n** Object Must be a Dimension or Text **") (while (progn (setq pt (getpoint "\nPick inside Cell to Place Text: ")) (cond ( (not pt)) ( (setq lst (car (vl-remove-if (function null) (mapcar (function (lambda (table) (if (eq :vlax-true (vla-HitTest table (vlax-3D-point (trans pt 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col)) (list table row col)))) ObjLst)))) (apply (function vla-SetText) (append lst (list (cond ( (wcmatch (vla-get-Objectname obj) "*Dimension") (strcat (vla-get-TextPrefix obj) (rtos (vla-get-Measurement obj) (vla-get-UnitsFormat obj) (vla-get-PrimaryUnitsPrecision obj)) (vla-get-TextSuffix obj))) ( (vla-get-TextString obj)))))) nil) (t (princ "\n** Point must be inside Cell **")))))) t))))) (princ "\n** No Tables Found in Drawing **")) (princ)) Quote
shortkrish Posted May 8 Posted May 8 jackie chan of lisp world, I used to wonder only my boss could do this 30 years ago.. 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.