Topic: Need help with change attributes location in block

[ziele_o2k]

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.

[roy_043]

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

[ziele_o2k]

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.

[ronjonp]

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

Code - Auto/Visual Lisp: [Select]

1. (defun c:foo (/ _getatt r o n ss)
2.   (defun _getatt (blk tag)
3.     (car (vl-remove-if-not '(lambda (att) (= (strcase tag) (strcase (vla-get-tagstring att))))
4.             (vlax-invoke blk 'getattributes)
5.     )
6.     )
7.   )
8.   (if (setq ss (ssget ":L" '((0 . "insert") (2 . "GT-SP-TYP2") (66 . 1))))
9.     (foreach blk (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
10.       (if (and (setq r (_getatt blk "number"))
11.           (setq o (_getatt blk "separator"))
12.           (setq n (_getatt blk "level"))
13.      )
14.    (progn (vla-put-textstring
15.        r
16.        (strcat (vla-get-textstring r) (vla-get-textstring o) (vla-get-textstring n))
17.           )
18.           (vla-put-textstring o "")
19.           (vla-put-textstring n "")
20.    )
21.       )
22.     )
23.   )
24.   (princ)
25. )

& here's one that moves the attributes:

Code - Auto/Visual Lisp: [Select]

1. (defun c:foo (/ _clean _d _getatt r o n ss p a d)
2.   (defun _getatt (blk tag)
3.     (car (vl-remove-if-not '(lambda (att) (= (strcase tag) (strcase (vla-get-tagstring att))))
4.             (vlax-invoke blk 'getattributes)
5.     )
6.     )
7.   )
8.   (defun _d (e / r)
9.     (if   (setq r (textbox (entget e)))
10.       (caadr r)
11.     )
12.   )
13.   (defun _clean (str) (vl-string-left-trim " " (vl-string-right-trim " " str)))
14.   (if (setq ss (ssget ":L" '((0 . "insert") (2 . "GT-SP-TYP2") (66 . 1))))
15.     (foreach blk (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
16.       (if (and (setq r (_getatt blk "number"))
17.           (setq o (_getatt blk "separator"))
18.           (setq n (_getatt blk "level"))
19.      )
20.    (progn (vla-put-textstring r (_clean (vla-get-textstring r)))
21.           (vla-put-textstring o (_clean (vla-get-textstring o)))
22.           (vla-put-textstring n (_clean (vla-get-textstring n)))
23.           (vlax-invoke o
24.              'move
25.              (vlax-get o 'insertionpoint)
26.              (polar (setq p (vlax-get r 'insertionpoint))
27.                (setq a (vla-get-rotation r))
28.                (setq d (_d (vlax-vla-object->ename r)))
29.              )
30.           )
31.           (vla-put-rotation o a)
32.           (vlax-invoke n
33.              'move
34.              (vlax-get n 'insertionpoint)
35.              (polar p a (+ d (_d (vlax-vla-object->ename o))))
36.           )
37.           (vla-put-rotation n a)
38.    )
39.       )
40.     )
41.   )
42.   (princ)
43. )

[ziele_o2k]

Here is mine but without cleaning spaces

Code - Auto/Visual Lisp: [Select]

1. ;;ziele_o2k
2. ;;v20160615-1802
3. (defun c:final ( / *error* ss in blkent attentlst Att-0 Att-1 Att-2 box os)
4.   (defun *error* (msg / so)
5.     (cond
6.       ((not msg))
7.       ((member msg '("Function cancelled" "quit / exit abort")))
8.       (
9.         (princ (strcat "\n  <!>  Error: " msg "  <!> "))
10.         (cond (T (vl-bt)))
11.       )
12.     )  
13.     (princ)
14.   )
15.   (if(setq ss (ssget '((0 . "INSERT") (2 . "GT-SP-TYP2") (66 . 1))))
16.     (progn
17.       (repeat (setq in (sslength ss))
18.         (setq blkent (ssname ss (setq in (1- in))))
19.         (setq attentlst (cd:BLK_GetAttEntity blkent))
20.         (foreach %1 attentlst
21.           (
22.             (lambda (%2)
23.               (cond
24.                 ((eq (cdr (assoc 2 (entget %2))) "NUMBER") (setq Att-0 (entget %2)))
25.                 ((eq (cdr (assoc 2 (entget %2))) "SEPARATOR") (setq Att-1 (entget %2)))
26.                 ((eq (cdr (assoc 2 (entget %2))) "LEVEL") (setq Att-2 (entget %2)))
27.               )
28.             )
29.             %1
30.           )
31.         )
32.         (if (and Att-0 Att-1 Att-2)
33.           (progn
34.             (setq box (PZ:TextBox Att-0))
35.             (setq os (/ (cdr (assoc 40 Att-1)) 8))
36.             (setq  
37.               Att-1
38.               (subst
39.                 (cons  
40.                   10
41.                   (polar
42.                     (cdr (assoc 10 Att-0))
43.                     (cdr (assoc 50 Att-0))
44.                     (+ (caadr box) os)
45.                   )
46.                 )
47.                 (assoc 10 Att-1)
48.                 Att-1
49.               )
50.               Att-1 (subst (assoc 50 Att-0)(assoc 50 Att-1)Att-1)
51.             )
52.             (entmod Att-1)
53.             (setq box (PZ:TextBox Att-1))
54.             (setq
55.               Att-2
56.               (subst
57.                 (cons  10
58.                   (polar
59.                     (cdr (assoc 10 Att-1))
60.                     (cdr (assoc 50 Att-1))
61.                     (+ (caadr box) os)
62.                   )
63.                 )
64.                 (assoc 10 Att-2)
65.                 Att-2
66.               )
67.               Att-2 (subst (assoc 50 Att-1)(assoc 50 Att-2)Att-2)
68.             )
69.             (entmod Att-2)
70.             (entupd blkent)
71.           )
72.           (princ "\nNo atts.")
73.         )
74.       )
75.     )
76.   )
77.   (princ)
78. )
79.  
80. ;;ziele_o2k
81. ;;20160615-1622
82. ;;elist - An entity definition list defining a text object, in the format returned by entget.
83. ;     (textbox (entget (car (entsel))))
84. ;     (PZ:TextBox (entget (car (entsel))))
85. (defun PZ:TextBox ( elist / str in SpaceCount SpaceLength)
86.   (setq
87.     str (cdr (assoc 1 elist))
88.     in 0
89.     SpaceCount 0
90.   )
91.   ;Count Spaces at begining of string
92.   (while (eq (nth in (vl-string->list str)) 32)
93.     (setq
94.       SpaceCount (1+ SpaceCount)
95.       in (1+ in)
96.     )
97.   )
98.   ;Count Spaces at end of string
99.   (setq in 0)
100.   (while (eq (nth in (reverse (vl-string->list str))) 32)
101.     (setq
102.       SpaceCount (1+ SpaceCount)
103.       in (1+ in)
104.     )
105.   )
106.   ;Calculate space length
107.   (setq
108.     SpaceLength
109.     (-
110.       ;String with space
111.       (caadr
112.         (textbox
113.           (entmod
114.             (subst
115.                 (cons 1 "A A")
116.                 (assoc 1 elist)
117.                 elist
118.             )
119.           )
120.         )
121.       )
122.       ;String without space
123.       (caadr
124.         (textbox
125.           (entmod
126.             (subst
127.                 (cons 1 "AA")
128.                 (assoc 1 elist)
129.                 elist
130.             )
131.           )
132.         )
133.       )
134.     )
135.   )
136.   ;Restore string value to default
137.   (entmod
138.    (subst
139.       (cons 1 str)
140.       (assoc 1 elist)
141.       elist
142.     )
143.   )
144.   ;return list with textbox coordinates
145.   (list
146.     (car (textbox elist))
147.     (list
148.       (+ (caadr (textbox elist)) (* SpaceLength SpaceCount))
149.       (cadr (cadr (textbox elist)))
150.       (caddr (cadr (textbox elist)))
151.     )
152.   )
153. )

[ronjonp]

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

[roy_043]

@ ziele-o2k:
As I tried to explain in your thread on the other forum, 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 ...))

[ziele_o2k]

@ ziele-o2k:
As I tried to explain in your thread on the other forum, 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]

1. ; =========================================================================================== ;
2. ;  DATA  [LIST] - An entity definition list defining a text object,                           ;
3. ;                 in the format returned by entget                                            ;
4. ;  Mode [T/nil] - nil = standard textbox function procedure                                   ;
5. ;                       (ignore spaces at start and end of string)                            ;
6. ;                 T   = extended textbox function                                             ;
7. ;                       (do not ignore spaces at start and end of string)                     ;
8. ; =========================================================================================== ;
9. (defun TextBoxExt (Data Mode / _SpaceStr _SpacesI _SpaceLen s i e r)
10.   (setq s (cdr (assoc 1 Data)) r (textbox Data))
11.   (defun _SpaceStr (s / l)  
12.     (setq l (vl-string->list s))(or (= 32 (car l))(= 32 (last l)))
13.   )
14.   (defun _SpacesI (s / l)
15.     (setq l (vl-string->list s))
16.     (-
17.       (length l)
18.       (length (vl-string->list (vl-string-left-trim " " (vl-string-right-trim " " s))))
19.     )
20.   )
21.   (defun _SpaceLen (d)
22.     (-
23.       (caadr (textbox (subst (cons 1 "A A")(assoc 1 d) d)))
24.       (caadr (textbox (subst (cons 1 "AA")(assoc 1 d) d)))
25.     )
26.   )
27.   (if Mode
28.     (if
29.       (_SpaceStr s)
30.       (progn
31.         (setq i (_SpacesI s) e (_SpaceLen Data))
32.         (list
33.           (car r)
34.           (list
35.             (+ (caadr r) (* e i))
36.             (cadr (cadr r))
37.             (caddr (cadr r))
38.           )
39.         )
40.       )
41.       r
42.     )
43.     r
44.   )
45. )

[roy_043]

Great! Much better!

The post 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.

[ziele_o2k]

Three functions that may be usefull:

Code: [Select]

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

Next version

Code - Auto/Visual Lisp: [Select]

1. ; =========================================================================================== ;
2. ;  DATA  [LIST] - An entity definition list defining a text object,                           ;
3. ;                 in the format returned by entget                                            ;
4. ;  Mode [T/nil] - nil = standard textbox function procedure                                   ;
5. ;                       (ignore spaces at start and end of string)                            ;
6. ;                 T   = extended textbox function                                             ;
7. ;                       (do not ignore spaces at start and end of string)                     ;
8. ; =========================================================================================== ;
9. (defun TextBoxExt (Data Mode / _SpacesI _SpaceLen s i e r)
10.   (setq s (cdr (assoc 1 Data)) r (textbox Data))
11.   (defun _SpacesI (s / l)
12.     (-
13.       (strlen s)
14.       (strlen (vl-string-trim " " s))
15.     )
16.   )
17.   (defun _SpaceLen (d)
18.     (-
19.       (caadr (textbox (subst (cons 1 "A A")(assoc 1 d) d)))
20.       (caadr (textbox (subst (cons 1 "AA")(assoc 1 d) d)))
21.     )
22.   )
23.   (if Mode
24.     (if
25.       (wcmatch s " *,* ")
26.       (progn
27.         (setq i (_SpacesI s) e (_SpaceLen Data))
28.         (list
29.           (car r)
30.           (list
31.             (+ (caadr r) (* e i))
32.             (cadr (cadr r))
33.             (caddr (cadr r))
34.           )
35.         )
36.       )
37.       r
38.     )
39.     r
40.   )
41. )

[roy_043]

Nice work ziele-o2k.

[Lee Mac]

Good coding ziele-o2k 

Here is my version to offer an alternative approach:

Code - Auto/Visual Lisp: [Select]

1. (defun textboxext ( enx flg )
2.     (if (and flg (wcmatch (cdr (assoc 1 enx)) " *,* "))
3.         (   (lambda ( a b ) (list (car a) (cons (- (caadr a) (caadr b)) (cdadr a))))
4.             (textboxs enx (strcat "-" (cdr (assoc 1 enx)) "-"))
5.             (textboxs enx "--")
6.         )
7.         (textbox enx)
8.     )
9. )
10. (defun textboxs ( enx str )
11.     (textbox (subst (cons 1 str) (assoc 1 enx) enx))
12. )