Print Page - Need help with change attributes location in block

Title: Need help with change attributes location in block
Post by: ziele_o2k on June 14, 2016, 06:09:02 PM

Hi,

I have block with attributes. Based on location and rotation of main attribute I want to change location of the other atts.
To this moment I was working with block/attributes with rotation = 0. I was using some BoudingBox lips routines in UCS or WCS.
But now I don't know how to do.
I was thinking that maybe I should set UCS for every block I'm processing and get bounding box in UCS, but I don't know how to do this in lisp routine (without command "_UCS" which is slow).

To visualize problem, please see attached file.

Also I was thinking about trying to modify Lee Mac MinimumBoudingBox routine, but after my modifications it don't work for atts.

for every advice I will be grateful.

Title: Re: Need help with change attributes location in block
Post by: roy_043 on June 15, 2016, 04:39:24 AM

This problem was also posted here:
http://www.cadtutor.net/forum/showthread.php?97195-Lisp-Minimum-bounding-box-for-rotated-attribute-block

Title: Re: Need help with change attributes location in block
Post by: ziele_o2k on June 15, 2016, 06:20:16 AM

Quote from: roy_043 on June 15, 2016, 04:39:24 AM

This problem was also posted here:
http://www.cadtutor.net/forum/showthread.php?97195-Lisp-Minimum-bounding-box-for-rotated-attribute-block

I know, that was my post, here is solution,

Code: [Select]

;;ziele_o2k
;;v20160615-1216
(defun c:final ( / *error* ss in blkent attentlst Att-0 Att-1 Att-2 box os)
  (defun *error* (msg / so)
    (cond 
      ((not msg))
      ((member msg '("Function cancelled" "quit / exit abort")))
      (
        (princ (strcat "\n  <!>  Error: " msg "  <!> "))
        (cond (T (vl-bt)))
      )
    )  
    (princ)
  )
  (if(setq ss (ssget '((0 . "INSERT") (2 . "GT-SP-TYP2") (66 . 1))))
    (progn
      (repeat (setq in (sslength ss))
        (setq blkent (ssname ss (setq in (1- in))))
        (setq attentlst (cd:BLK_GetAttEntity blkent))
        (foreach %1 attentlst
          (
            (lambda (%2)
              (cond
                ((eq (cdr (assoc 2 (entget %2))) "NUMBER") (setq Att-0 (entget %2)))
                ((eq (cdr (assoc 2 (entget %2))) "SEPARATOR") (setq Att-1 (entget %2)))
                ((eq (cdr (assoc 2 (entget %2))) "LEVEL") (setq Att-2 (entget %2)))
              )
            )
            %1
          )
        )
        (if (and Att-0 Att-1 Att-2)
          (progn
            (setq box (textbox Att-0))
            (setq os (/ (cdr (assoc 40 Att-1)) 8))
            (setq  
              Att-1
              (subst
                (cons  
                  10
                  (polar
                    (cdr (assoc 10 Att-0))
                    (cdr (assoc 50 Att-0))
                    (+ (caadr box) os)
                  )
                )
                (assoc 10 Att-1)
                Att-1
              )
              Att-1 (subst (assoc 50 Att-0)(assoc 50 Att-1)Att-1)
            )
            (entmod Att-1)
            (setq box (textbox Att-1))
            (setq
              Att-2
              (subst
                (cons  10
                  (polar
                    (cdr (assoc 10 Att-1))
                    (cdr (assoc 50 Att-1))
                    (+ (caadr box) os)
                  )
                )
                (assoc 10 Att-2)
                Att-2
              )
              Att-2 (subst (assoc 50 Att-1)(assoc 50 Att-2)Att-2)
            )
            (entmod Att-2)
            (entupd blkent)
          )
          (princ "\nNo atts.")
        )
      )
    )
  )
)

There is still problem when we have spaces in begining or end of attribute string. Textbox function ignores that spaces.
But this problem is my future problem.

Title: Re: Need help with change attributes location in block
Post by: ronjonp on June 15, 2016, 10:03:05 AM

Does not move attributes, but gives similar end results ( minus the difference in text height ).

Code - Auto/Visual Lisp: [Select]

(defun c:foo (/ _getatt r o n ss)
  (defun _getatt (blk tag)
    (car (vl-remove-if-not '(lambda (att) (= (strcase tag) (strcase (vla-get-tagstring att))))
            (vlax-invoke blk 'getattributes)
    )
    )
  )
  (if (setq ss (ssget ":L" '((0 . "insert") (2 . "GT-SP-TYP2") (66 . 1))))
    (foreach blk (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (if (and (setq r (_getatt blk "number"))
          (setq o (_getatt blk "separator"))
          (setq n (_getatt blk "level"))
     )
   (progn (vla-put-textstring
       r
       (strcat (vla-get-textstring r) (vla-get-textstring o) (vla-get-textstring n))
          )
          (vla-put-textstring o "")
          (vla-put-textstring n "")
   )
      )
    )
  )
  (princ)
)

& here's one that moves the attributes:

Code - Auto/Visual Lisp: [Select]

(defun c:foo (/ _clean _d _getatt r o n ss p a d)
  (defun _getatt (blk tag)
    (car (vl-remove-if-not '(lambda (att) (= (strcase tag) (strcase (vla-get-tagstring att))))
            (vlax-invoke blk 'getattributes)
    )
    )
  )
  (defun _d (e / r)
    (if   (setq r (textbox (entget e)))
      (caadr r)
    )
  )
  (defun _clean (str) (vl-string-left-trim " " (vl-string-right-trim " " str)))
  (if (setq ss (ssget ":L" '((0 . "insert") (2 . "GT-SP-TYP2") (66 . 1))))
    (foreach blk (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (if (and (setq r (_getatt blk "number"))
          (setq o (_getatt blk "separator"))
          (setq n (_getatt blk "level"))
     )
   (progn (vla-put-textstring r (_clean (vla-get-textstring r)))
          (vla-put-textstring o (_clean (vla-get-textstring o)))
          (vla-put-textstring n (_clean (vla-get-textstring n)))
          (vlax-invoke o
             'move
             (vlax-get o 'insertionpoint)
             (polar (setq p (vlax-get r 'insertionpoint))
               (setq a (vla-get-rotation r))
               (setq d (_d (vlax-vla-object->ename r)))
             )
          )
          (vla-put-rotation o a)
          (vlax-invoke n
             'move
             (vlax-get n 'insertionpoint)
             (polar p a (+ d (_d (vlax-vla-object->ename o))))
          )
          (vla-put-rotation n a)
   )
      )
    )
  )
  (princ)
)

Title: Re: Need help with change attributes location in block
Post by: ziele_o2k on June 15, 2016, 11:59:08 AM

Here is mine but without cleaning spaces

Code - Auto/Visual Lisp: [Select]

;;ziele_o2k
;;v20160615-1802
(defun c:final ( / *error* ss in blkent attentlst Att-0 Att-1 Att-2 box os)
  (defun *error* (msg / so)
    (cond 
      ((not msg))
      ((member msg '("Function cancelled" "quit / exit abort")))
      (
        (princ (strcat "\n  <!>  Error: " msg "  <!> "))
        (cond (T (vl-bt)))
      )
    )  
    (princ)
  )
  (if(setq ss (ssget '((0 . "INSERT") (2 . "GT-SP-TYP2") (66 . 1))))
    (progn
      (repeat (setq in (sslength ss))
        (setq blkent (ssname ss (setq in (1- in))))
        (setq attentlst (cd:BLK_GetAttEntity blkent))
        (foreach %1 attentlst
          (
            (lambda (%2)
              (cond
                ((eq (cdr (assoc 2 (entget %2))) "NUMBER") (setq Att-0 (entget %2)))
                ((eq (cdr (assoc 2 (entget %2))) "SEPARATOR") (setq Att-1 (entget %2)))
                ((eq (cdr (assoc 2 (entget %2))) "LEVEL") (setq Att-2 (entget %2)))
              )
            )
            %1
          )
        )
        (if (and Att-0 Att-1 Att-2)
          (progn
            (setq box (PZ:TextBox Att-0))
            (setq os (/ (cdr (assoc 40 Att-1)) 8))
            (setq  
              Att-1
              (subst
                (cons  
                  10
                  (polar
                    (cdr (assoc 10 Att-0))
                    (cdr (assoc 50 Att-0))
                    (+ (caadr box) os)
                  )
                )
                (assoc 10 Att-1)
                Att-1
              )
              Att-1 (subst (assoc 50 Att-0)(assoc 50 Att-1)Att-1)
            )
            (entmod Att-1)
            (setq box (PZ:TextBox Att-1))
            (setq
              Att-2
              (subst
                (cons  10
                  (polar
                    (cdr (assoc 10 Att-1))
                    (cdr (assoc 50 Att-1))
                    (+ (caadr box) os)
                  )
                )
                (assoc 10 Att-2)
                Att-2
              )
              Att-2 (subst (assoc 50 Att-1)(assoc 50 Att-2)Att-2)
            )
            (entmod Att-2)
            (entupd blkent)
          )
          (princ "\nNo atts.")
        )
      )
    )
  )
  (princ)
)
 
;;ziele_o2k
;;20160615-1622
;;elist - An entity definition list defining a text object, in the format returned by entget.
;     (textbox (entget (car (entsel))))
;     (PZ:TextBox (entget (car (entsel))))
(defun PZ:TextBox ( elist / str in SpaceCount SpaceLength)
  (setq 
    str (cdr (assoc 1 elist))
    in 0
    SpaceCount 0
  )
  ;Count Spaces at begining of string
  (while (eq (nth in (vl-string->list str)) 32)
    (setq 
      SpaceCount (1+ SpaceCount)
      in (1+ in)
    )
  )
  ;Count Spaces at end of string
  (setq in 0)
  (while (eq (nth in (reverse (vl-string->list str))) 32)
    (setq 
      SpaceCount (1+ SpaceCount)
      in (1+ in)
    )
  )
  ;Calculate space length
  (setq 
    SpaceLength
    (-
      ;String with space
      (caadr
        (textbox 
          (entmod
            (subst 
                (cons 1 "A A")
                (assoc 1 elist)
                elist
            )
          )
        )
      )
      ;String without space
      (caadr
        (textbox 
          (entmod
            (subst 
                (cons 1 "AA")
                (assoc 1 elist)
                elist
            )
          )
        )
      )
    )
  )
  ;Restore string value to default
  (entmod
   (subst 
      (cons 1 str)
      (assoc 1 elist)
      elist
    )
  )
  ;return list with textbox coordinates
  (list 
    (car (textbox elist))
    (list 
      (+ (caadr (textbox elist)) (* SpaceLength SpaceCount))
      (cadr (cadr (textbox elist)))
      (caddr (cadr (textbox elist)))
    )
  )
)

Title: Re: Need help with change attributes location in block
Post by: ronjonp on June 15, 2016, 01:14:46 PM

You need to include the function CD:BLK_GETATTENTITY.
Nice to see someone coding & not asking for a handout .. Welcome to TheSwamp. :)

Title: Re: Need help with change attributes location in block
Post by: roy_043 on June 15, 2016, 04:36:41 PM

@ ziele-o2k:
As I tried to explain in your thread on the other forum (http://www.cadtutor.net/forum/showthread.php?97195-Lisp-Minimum-bounding-box-for-rotated-attribute-block&p=663680&viewfull=1#post663680), there is no need to actually change an entity for the (textbox) function. You can completely remove entmod (3x) from your PZ:TextBox function.

Code: [Select]

(textbox (entmod (subst ...)))Can become:

Code: [Select]

(textbox (subst ...))

Title: Re: Need help with change attributes location in block
Post by: ziele_o2k on June 16, 2016, 05:12:54 AM

Quote from: roy_043 on June 15, 2016, 04:36:41 PM

@ ziele-o2k:
As I tried to explain in your thread on the other forum (http://www.cadtutor.net/forum/showthread.php?97195-Lisp-Minimum-bounding-box-for-rotated-attribute-block&p=663680&viewfull=1#post663680), there is no need to actually change an entity for the (textbox) function. You can completely remove entmod (3x) from your PZ:TextBox function.

Code: [Select]
(textbox (entmod (subst ...)))Can become:
Code: [Select]
(textbox (subst ...))

New version of textbox.

Code - Auto/Visual Lisp: [Select]

; =========================================================================================== ;
;  DATA  [LIST] - An entity definition list defining a text object,                           ;
;                 in the format returned by entget                                            ;
;  Mode [T/nil] - nil = standard textbox function procedure                                   ;
;                       (ignore spaces at start and end of string)                            ;
;                 T   = extended textbox function                                             ;
;                       (do not ignore spaces at start and end of string)                     ;
; =========================================================================================== ;
(defun TextBoxExt (Data Mode / _SpaceStr _SpacesI _SpaceLen s i e r)
  (setq s (cdr (assoc 1 Data)) r (textbox Data))
  (defun _SpaceStr (s / l)  
    (setq l (vl-string->list s))(or (= 32 (car l))(= 32 (last l)))
  )
  (defun _SpacesI (s / l)
    (setq l (vl-string->list s))
    (- 
      (length l)
      (length (vl-string->list (vl-string-left-trim " " (vl-string-right-trim " " s))))
    )
  )
  (defun _SpaceLen (d)
    (-
      (caadr (textbox (subst (cons 1 "A A")(assoc 1 d) d)))
      (caadr (textbox (subst (cons 1 "AA")(assoc 1 d) d)))
    )
  )
  (if Mode
    (if
      (_SpaceStr s)
      (progn
        (setq i (_SpacesI s) e (_SpaceLen Data))
        (list
          (car r)
          (list 
            (+ (caadr r) (* e i))
            (cadr (cadr r))
            (caddr (cadr r))
          )
        )
      )
      r
    )
    r
  )
)

Title: Re: Need help with change attributes location in block
Post by: roy_043 on June 16, 2016, 05:34:55 AM

Great! Much better!

The post (http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/textbox-lisp-function-does-not-recognize-trailing-spaces-in-2006/m-p/1366356#M184115) you have linked to in your other thread suggests that only trailing spaces are an issue. Your code also looks at leading spaces. I can't test this myself as the (textbox) function in BricsCAD measures all characters (which makes more sense IMO).

Three functions that may be useful:

Code: [Select]

(strlen "abc")
(vl-string-trim " " "  A  ")
(wcmatch " abc " " *,* ")

EDIT: Spelling.

Title: Re: Need help with change attributes location in block
Post by: ziele_o2k on June 16, 2016, 07:36:49 AM

Quote from: roy_043 on June 16, 2016, 05:34:55 AM

Three functions that may be usefull:
Code: [Select]
(strlen "abc") (vl-string-trim " " " A ") (wcmatch " abc " " *,* ")

Next version :)

Code - Auto/Visual Lisp: [Select]

; =========================================================================================== ;
;  DATA  [LIST] - An entity definition list defining a text object,                           ;
;                 in the format returned by entget                                            ;
;  Mode [T/nil] - nil = standard textbox function procedure                                   ;
;                       (ignore spaces at start and end of string)                            ;
;                 T   = extended textbox function                                             ;
;                       (do not ignore spaces at start and end of string)                     ;
; =========================================================================================== ;
(defun TextBoxExt (Data Mode / _SpacesI _SpaceLen s i e r)
  (setq s (cdr (assoc 1 Data)) r (textbox Data))
  (defun _SpacesI (s / l)
    (- 
      (strlen s)
      (strlen (vl-string-trim " " s))
    )
  )
  (defun _SpaceLen (d)
    (-
      (caadr (textbox (subst (cons 1 "A A")(assoc 1 d) d)))
      (caadr (textbox (subst (cons 1 "AA")(assoc 1 d) d)))
    )
  )
  (if Mode
    (if
      (wcmatch s " *,* ")
      (progn
        (setq i (_SpacesI s) e (_SpaceLen Data))
        (list
          (car r)
          (list 
            (+ (caadr r) (* e i))
            (cadr (cadr r))
            (caddr (cadr r))
          )
        )
      )
      r
    )
    r
  )
)

Title: Re: Need help with change attributes location in block
Post by: roy_043 on June 16, 2016, 07:59:33 AM

Nice work ziele-o2k. 8-)

Title: Re: Need help with change attributes location in block
Post by: Lee Mac on June 16, 2016, 09:33:57 AM

Good coding ziele-o2k :-)

Here is my version to offer an alternative approach:

Code - Auto/Visual Lisp: [Select]

(defun textboxext ( enx flg )
    (if (and flg (wcmatch (cdr (assoc 1 enx)) " *,* "))
        (   (lambda ( a b ) (list (car a) (cons (- (caadr a) (caadr b)) (cdadr a))))
            (textboxs enx (strcat "-" (cdr (assoc 1 enx)) "-"))
            (textboxs enx "--")
        )
        (textbox enx)
    )
)
(defun textboxs ( enx str )
    (textbox (subst (cons 1 str) (assoc 1 enx) enx))
)

TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ziele_o2k on June 14, 2016, 06:09:02 PM