read dimension value

[Gaszto]

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

[Lee Mac]

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

[Gaszto]

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?

[Lee Mac]

type "dVal" at the command line.

http://www.cadtutor.net/forum/showthread.php?t=1390

[Gaszto]

Thanks a lot.

With this i can finish my work within a hour

[Lee Mac]

Thanks a lot.

With this i can finish my work within a hour

 

Excellent - Glad to have saved you some time

[Phiphi]

 

(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.

[Lee Mac]

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))

[Phiphi]

Thank a lot, Lee.

Cheers, PP.

[Lee Mac]

You're welcome