Topic: Can I pull data from a map grid of lines to feed a number to an Attribute

[ronjonp]

Krushert,

Pick upper left corner of grid:  Is this very top left A 01?
Yes.
Pick bottom right corner of cell: Is the cell that inserted block resides in?
Bottom right corner of cell A1
Enter # of sub-cells wide (& high):  Okay this is throwing me even more.
With the grid posted you'd enter 30 for number of sub-cells wide and 20 for number of sub-cells tall.

Let me know if you need more help.

[Krushert]

Sweet.  It work. 

I have some questions and modifications but I have to go pick up kids and go see the mall Santa.
I will be back tomorrow

[Krushert]

I have not forgotten this.  It is just that the blocks are getting complicated with nuances.  :realmad: :pissed:

[CAB]

Turned my routine into a subroutine:

Code: [Select]

;;  CAB 12.16.2009
;;  Returns Encoded string or "ERROR"
;;    For example  -E06-458 would be location number
;;  Base 0,0 from upper left
;;  Arguments Base Point of Grid (Upper Left Point)
;;            Point within cell
(defun GetGridCell (bp pt / Stepx Stepy SubX SubY x y xc yc err col row)

  (setq Stepx 1800.) ; default Cell width
  (setq Stepy 1200.) ; default Cell height

  (setq SubX 30)    ; default 30 wide
  (setq SubY 20)    ; by 20 tall

  (setq x   (- (car pt) (car bp))  ; relative offset x
        y   (- (cadr bp) (cadr pt)) ; relative offset y [note reverse direction]
        xc  (+ 65 (fix (/ x Stepx))) ; Cell Letter
        yc  (1+ (fix (/ y Stepy)))   ; Cell Number
  )
  (if (or (minusp x) (minusp y) (> (chr xc) "J")(> yc 12))
    "ERROR" ; point outside of grid
    (progn
      ;;  Set up the sub boxes  the fraction is the sub Cell reference
      (setq subXs (/ Stepx Subx)
            subYs (/ Stepy Suby)
            col   (fix (+ 0.99999 (/ (* (rem (/ X StepX) 1) Stepx) subXs)))
            row   (fix (+ 0.99999 (/ (* (rem (/ y Stepy) 1) Stepy) subYs)))
      )
      ;;  Return string -E06-458  less leading count number
      (strcat "-"(chr xc) (if (< yc 10) (strcat "0" (itoa yc)) (itoa yc))
              "-" (itoa (+ (* Subx (1- row)) col)))
    )
  )
)

Code: [Select]

(defun c:test (/ ss ename i ipt gbp)
  (defun padL (word len / zero)
    (repeat (- len (strlen word)) (setq zero (cons 48 zero)))
    (strcat (vl-list->string zero) word)
  )
  (setq lst nil)
  (and
  (setq gbp (getpoint "\nPick Upper Left Base point:"))
  (princ "\nSelect blocks:")
  (setq ss (ssget '((0 . "INSERT"))))
  (setq i -1)
  (while (setq ename (ssname ss (setq i (1+ i))))
    (setq ipt (cdr (assoc 10 (entget ename))))
    (setq lst (cons (strcat (padL (itoa (1+ i)) 3) (GetGridCell gbp ipt))
                    lst))
    (print (car lst))
  )
  )
  (princ)
) <edit: Changed test routine.>

[Krushert]

Thanks CAB.  I was looking to modify what was previously posted to your first code above. 
Maybe tomorrow I can get to code.  Fingers crossed.

[Krushert]

Whoa!!    I see what you did here CAB. 

Code: [Select]

  (princ "\nSelect blocks:")
  (setq ss (ssget '((0 . "INSERT"))))
  (setq i -1)
  (while (setq ename (ssname ss (setq i (1+ i))))
    (setq ipt (cdr (assoc 10 (entget ename))))
    (setq lst (cons (strcat (padL (itoa (1+ i)) 3) (GetGridCell gbp ipt))
                    lst))
    (print (car lst))

Select objects:
"001-D07-20"
"002-D06-560"
"003-D06-591"
"004-D07-51"

Now I have to feed this to the blocks lots of them, I could be looking at 200. Right now college intern had plunked in 99.    Your way is certainly faster than my way of selecting one at time run the routine and then moving on to the next.  MY concern is will autocad or this routine crash from trying to process to many blocks. 

Back to playing.  Thanks again

[ronjonp]

Whoa!!    I see what you did here CAB. 

Code: [Select]

  (princ "\nSelect blocks:")
  (setq ss (ssget '((0 . "INSERT"))))
  (setq i -1)
  (while (setq ename (ssname ss (setq i (1+ i))))
    (setq ipt (cdr (assoc 10 (entget ename))))
    (setq lst (cons (strcat (padL (itoa (1+ i)) 3) (GetGridCell gbp ipt))
                    lst))
    (print (car lst))

Select objects:
"001-D07-20"
"002-D06-560"
"003-D06-591"
"004-D07-51"

Now I have to feed this to the blocks lots of them, I could be looking at 200. Right now college intern had plunked in 99.    Your way is certainly faster than my way of selecting one at time run the routine and then moving on to the next.  MY concern is will autocad or this routine crash from trying to process to many blocks. 

Back to playing.  Thanks again

Only 200 blocks? I tested my routine with over a thousand  ...me thinks you're computer will be fine processing them  . Better send the intern home since the process will now take one second. 

[Krushert]

Only 200 blocks? I tested my routine with over a thousand   ...me thinks you're computer will be fine processing them  . Better send the intern home since the process will now take one second.  

Yeah I went tested it 456 blocks and it was fast.    posted to fast on that one

[Krushert]

*Here's the code to update an attribute value (the tagname needs to be modified to suit)

Code: [Select]

(defun c:gridloc2att (/ h letter num pp pt1 pt2 ss subn sub_tl w x_row x_subd x_subn
     y_row y_subd y_subn)
  (if (and (setq pt1 (getpoint "\nPick upper left corner of grid: "))
  (setq pt2 (getcorner pt1 "\nPick bottom right corner of cell: "))
  (setq x_subn (getint "\nEnter # of sub-cells wide: "))
  (setq y_subn (getint "\nEnter # of sub-cells high: "))
  (setq ss (ssget ":L" '((0 . "insert") (66 . 1))))
  (setq w (- (car pt1) (car pt2)))
  (setq h (- (cadr pt1) (cadr pt2)))
  (setq x_subd (/ w x_subn))
  (setq y_subd (/ h y_subn))
      )
    (foreach b (mapcar 'vlax-ename->vla-object
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      )
      (if
(and (setq pp (vlax-get b 'insertionpoint))
    (setq x_row (fix (/ (- (car pt1) (car pp)) w)))
    (setq y_row (fix (/ (- (cadr pt1) (cadr pp)) h)))
    (setq sub_tl (list (- (car pt1) (* x_row w)) (- (cadr pt1) (* y_row h))))
    (setq letter (chr (+ 65 x_row)))
    (setq num (rtos (1+ y_row) 2 0))
    (setq subn
   (itoa (1+ (+ (fix (/ (- (car sub_tl) (car pp)) x_subd))
(* (fix (/ (- (cadr sub_tl) (cadr pp)) y_subd)) x_subn)
     )
 )
   )
    )
)
(foreach att (vlax-invoke b 'getattributes)
  ;;Change attribute tag name to name needed
  (if (eq "TEST" (vla-get-tagstring att))
    (vla-put-textstring
      att
      (strcat letter
      (if (= (strlen num) 1)
(strcat "0" num)
num
      )
      "-"
      (cond ((= (strlen subn) 1) (strcat "00" subn))
    ((= (strlen subn) 2) (strcat "0" subn))
    (subn)
      )
      )
    )
  )
)
      )
    )
  )
  (princ)
)

Holly Carposals  And I see what you did there too.  And yes it is fast too.  However I went back to Intern and told him he can stop inputting the information; his reply was "I only have 3 more and then this floor is done."     But he can use in the other 4 floors for just this piece of project.  Then it will be a rinse and repeat for other pieces of the project.   This is a major time saver. 

[Atook]

...However I went back to Intern and told him he can stop inputting the information; his reply was "I only have 3 more and then this floor is done."     But he can use in the other 4 floors for just this piece of project.  Then it will be a rinse and repeat for other pieces of the project.   This is a major time saver. 

That's good experience for an intern, pretty soon instead of wondering "how can I do this in CAD?" He'll be wondering, "How do I code this in LISP?". Those are the kinds of people I want to work with..

[Lee Mac]

Those are the kinds of people I want to work with..

There are enough of them around here.. that's for sure

[Krushert]

Just to close out the thread and to throw in another round of thanks to you guys, I am posting the final version.

Code: [Select]

;;; GridLoc-2-Attribute.LSP
;;; 2009-12-17 = Ted Krush with a lots help from TheSwamp.org
;;; = Main Routine was written by RonJonp, Atook, CAB and others
;;; = Reference Thread Posted on TheSwamp.Org titled "Can I pull data from a map grid
;;;   of lines to feed a number to an Attribute" [Topic # 31265]
;;; = I tweaked to suit and added Prep/closing Settings
;;;
;;; Purpose: = Compares a inserted block symbol against it's location with MAP GRID that
;;; = Client uses to track location with in facility.
;;; = Routine then feeds the location to an attibute within block
;;;
;;; Sub-Functions:
;;; = None
;;;
;;; Notes to Users that are not within my firm:
;;; = None at this time
;;;
;;;            ++++  The above notes are there becuase this routine is developed  ++++
;;;                  ++++ around my company standards [or lack thereof :) ]  ++++
;;;
;;; Revisions: 01 = date - reason
;;;
;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


(defun c:G2A (/       h       num     pp      pt1     pt2     ss
      letter  subn    sub_tl  w       x_row   x_subd  x_subn
      y_row   y_subd  y_subn  FLRNO
     )

;;;  GATHERING CURRENT SETTINGS AND PRESETTING VARIABLES.
  (vl-load-com)
  (vl-cmdf ".undo" "begin")
  (setq ce (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)

  (if (and (setq pt1 (getpoint "\nPick upper left corner of grid: "))
   (setq pt2 (getcorner pt1 "\nPick bottom right corner of cell: "))
   (setq x_subn (getint "\nEnter # of sub-cells wide: "))
   (setq y_subn (getint "\nEnter # of sub-cells high: "))
   (SETQ FLRNO (GETSTRING "\nENTER FLOOR NUMBER: ")) ;Ted added
   (setq ss (ssget ":L" '((0 . "insert") (8 . "FIRE ALARM-N") (66 . 1)))) ;TED ADDED
   (setq w (- (car pt1) (car pt2)))
   (setq h (- (cadr pt1) (cadr pt2)))
   (setq x_subd (/ w x_subn))
   (setq y_subd (/ h y_subn))
      )
    (foreach b
     (mapcar 'vlax-ename->vla-object
     (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
     )
      (if
(and (setq pp (vlax-get b 'insertionpoint))
     (setq x_row (fix (/ (- (car pt1) (car pp)) w)))
     (setq y_row (fix (/ (- (cadr pt1) (cadr pp)) h)))
     (setq sub_tl (list (- (car pt1) (* x_row w))
(- (cadr pt1) (* y_row h))
  )
     )
     (setq letter (chr (+ 65 x_row)))
     (setq num (rtos (1+ y_row) 2 0))
     (setq subn
    (itoa
      (1+
(+ (fix (/ (- (car sub_tl) (car pp)) x_subd))
   (* (fix (/ (- (cadr sub_tl) (cadr pp)) y_subd)) x_subn)
)
      )
    )
     )
)
(foreach att (vlax-invoke b 'getattributes)
   ;;Change attribute tag name to name needed
   (if (eq "DEVICELOCATION" (vla-get-tagstring att))
     (vla-put-textstring
       att
       (strcat FLRNO ;Ted added
       "-"
       letter
       (if (= (strlen num) 1)
(strcat "0" num)
num
       )
       "-"
       (cond ((= (strlen subn) 1) (strcat "00" subn))
     ((= (strlen subn) 2) (strcat "0" subn))
     (subn)
       )
       )
     )
   )
)
      )
    )
  )
;;;RESTORE USERS SET VARIBLES.
  (setvar "CMDECHO" ce)
  (vl-cmdf ".undo" "end")
  (princ)
) ; END OF ROUTINE
I have one question.  What does this dxf code (66 . 1) in the ssgett do? 

Anyway thanks again. 

[CAB]

Filters OUT inserts without attributes.

[Krushert]

Filters OUT inserts without attributes.

I looked it up in help but it all it said was that "entities follows".       Oh Well Thanks Again.

[CAB]

You're looking at the wrong help.

Code: [Select]

INSERT
The following group codes apply to insert (block reference) entities. In addition to the group codes described here, see "Common Group Codes for Entities." For information about abbreviations and formatting used in this table, see "Formatting Conventions in This Reference."

Insert group codes

Group code Description
100 Subclass marker (AcDbBlockReference)
66 Variable attributes-follow flag (optional; default = 0); if the value of attributes-follow flag is 1, a series of attribute entities is expected to follow the insert, terminated by a seqend entity