Jump to content

Recommended Posts

Posted

Hi guys,

I'm looking for a data extraction routine for my irrigation guy. He wants to be able to calculate his GPM, (gallons per minute), by just clicking on the irrigation head blocks and have the routine add up the GPM and output the total.

 

Here it is in the simplest terms:

 

There are blocks in the drawing which represent the various irrigation heads.

Each block contains one attribute which is the GPM for that head. It will be a number, such as 0.20 or 0.75 or whatever. And it will be on a layer that's frozen in the viewport.

The routine will need to keep adding up the GPM as he clicks on all the blocks on the line.

When he's finished selecting blocks, the routine will need to output the total to wherever he clicks on screen.

 

I know this is dead simple but I'm not a programmer. I can't even figure out how to get to the attribute inside the block. If someone could write this in Autolisp, I would appreciate it. Then I could at least pick it apart and see how it's working. If you write it in Visual Lisp, you may as well write it in Chinese because I won't have a clue what it's doing.

 

Thanks, and let me know if the explanation was not clear.

Posted

Updated :

 

(defun c:gpm ( / *error* _StartUndo _EndUndo Dxf MText doc )
 (vl-load-com)
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   
   (if doc (_EndUndo doc))
   (if l   (mapcar '(lambda ( e ) (redraw e 4)) l))
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )

 (defun Dxf ( k l ) (cdr (assoc k l)))

 (defun MText ( pt str )
   (entmakex
     (list
       (cons 0 "MTEXT")
       (cons 100 "AcDbEntity")
       (cons 100 "AcDbMText")
       (cons 10 pt)
       (cons 1 str)
     )
   )
 )

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (
   (lambda ( total / e gpm pt l )
     (while
       (setq e
         (LM:SelectIf
           (lambda ( x )
             (and
               (eq "INSERT" (dxf  0 (entget x)))
               (=   1       (dxf 66 (entget x)))
             )
           )
           entsel "\nSelect GPM Block <Done> : "
         )
       )
       (if
         (setq gpm
           (vl-some
             (function
               (lambda ( attrib )
                 (distof (vla-get-TextString attrib))
               )
             )
             (vlax-invoke (vlax-ename->vla-object e) 'GetAttributes)
           )
         )
         (progn
           (redraw (car (setq l (cons e l))) 3)
           (princ (strcat "\n:: Total: " (rtos (setq total (+ total gpm))) " ::"))
         )
         (princ "\n** Unable to Ascertain GPM Value **")
       )
     )
     (if (and (< 0 total) (setq pt (getpoint "\nSpecify Point for Result: ")))
       (progn
         (_StartUndo doc)
         (MText (trans pt 1 0) (rtos total))
         (_EndUndo doc)
       )
     )
     (mapcar '(lambda ( e ) (redraw e 4)) l)
   )
   0
 )

 (princ)
)

(defun c:gpmf ( / *error* _StartUndo _EndUndo Dxf doc )
 (vl-load-com)
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   
   (if doc (_EndUndo doc))
   (if l   (mapcar '(lambda ( e ) (redraw e 4)) l))
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )

 (defun Dxf ( k l ) (cdr (assoc k l)))

 (LM:ActiveSpace 'doc 'spc)

 (
   (lambda ( total fstr / e gpm gpmo pt l )
     (while
       (setq e
         (LM:SelectIf
           (lambda ( x )
             (and
               (eq "INSERT" (dxf  0 (entget x)))
               (=   1       (dxf 66 (entget x)))
             )
           )
           entsel "\nSelect GPM Block <Done> : "
         )
       )
       (if
         (and
           (setq gpmo
             (vl-some
               (function
                 (lambda ( attrib )
                   (if (distof (vla-get-TextString attrib))
                     attrib
                   )
                 )
               )
               (vlax-invoke (vlax-ename->vla-object e) 'GetAttributes)
             )
           )
           (setq gpm (distof (vla-get-TextString gpmo)))
         )
         (progn
           (redraw (car (setq l (cons e l))) 3)
           (princ (strcat "\n:: Total: " (rtos (setq total (+ total gpm))) " ::"))
           (setq fstr
             (strcat fstr " %<\\AcObjProp Object(%<\\_ObjId "
               (LM:GetObjectID doc gpmo) ">%).TextString>% +"
             )
           )
         )
         (princ "\n** Unable to Ascertain GPM Value **")
       )
     )
     (if (and (< 0 total) (setq pt (getpoint "\nSpecify Point for Result: ")))
       (progn
         (_StartUndo doc)
         (vla-AddMText spc (vlax-3D-point (trans pt 1 0)) 0 (strcat (substr fstr 1 (1- (strlen fstr))) "\\f \"%lu6\">%"))
         (_EndUndo doc)
       )
     )
     (mapcar '(lambda ( e ) (redraw e 4)) l)
   )
   0 "%<\\AcExpr"
 )

 (princ)
)

;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - optional predicate function taking ename argument   ;;
;;  fun - selection function to invoke                        ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:Selectif ( foo fun str / e )
 ;; © Lee Mac 2010
 (while
   (progn (setvar 'ERRNO 0) (setq e (car (fun str)))
     (cond
       ( (= 7 (getvar 'ERRNO)) (princ "\n** Missed, Try Again **"))
       ( (eq 'ENAME (type e))

         (if (and foo (not (foo e)))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 e
)

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol other than *doc                      ;;
;;  *spc - quoted symbol other than *spc                      ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (set *doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace (eval *doc)))
     )
     (vla-get-ModelSpace (eval *doc))
     (vla-get-PaperSpace (eval *doc))
   )
 )
)

;;-------------------=={ Get ObjectID }==---------------------;;
;;                                                            ;;
;;  Returns the ObjectID string for the supplied VLA-Object   ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  doc - VLA Document Object (req'd for 64-bit systems)      ;;
;;  obj - VLA Object to query                                 ;;
;;------------------------------------------------------------;;
;;  Returns:  ObjectID string for VLA-Object                  ;;
;;------------------------------------------------------------;;

(defun LM:GetObjectID ( doc obj )
 (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
   (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
   (itoa (vla-get-Objectid obj))
 )
)

Posted

This thread has been cleaned up and closed.

 

Thank you

Guest
This topic is now closed to further replies.
×
×
  • Create New...