Topic: increase number of attribute block along a polyline

[pedroantonio]

Hi,Is it possible to increase number of attribute block along a polyline allways in clockwise direction. Look the attach test2.dwg

Thanks

[reltro]

Hey...
its possible for sure...

Start with PseudoCode:
1. Select Polyline
2. Pick the Point
3. Get the Vertices of the Polyline
4. Sort them, so that the vertices nearest to the Point in 2. is the first.
5. reverse or not the list from step 4. to be clockwise
6. insert BlockReference on each vertex
7. change Attribute value

An approach...

Code: [Select]

(defun From1to4 ( / vertices entselOut PickPoint dist StartIndex)
   (vl-load-com)
   (setq   entselOut   (entsel "Pick a polyline near to the startpoint")
         PickPoint   (cadr entselOut)
         vertices   (mapcar
                     'cdr
                     (vl-remove-if-not
                        '(lambda (a / )
                           (= (car a) 10)
                        )
                        (entget (car entselOut))
                     )
                  )
         StartIndex   (vl-position
                     (apply
                        'min
                        (setq dist
                           (mapcar
                              '(lambda (a / )
                                 (distance PickPoint a)
                              )
                              vertices
                           )
                        )
                     )
                     dist
                  )
   )
   
   (repeat StartIndex (setq vertices (reverse (cons (car vertices) (reverse (cdr vertices))))))
)

Greets reltro

[pedroantonio]

Hi reltro

1. Select Polyline
2. Pick the Point
3. Get the Vertices of the Polyline
4. Sort them, so that the vertices nearest to the Point in 2. is the first.
5. reverse or not the list from step 4. to be clockwise
6. insert BlockReference on each vertex
7. change Attribute value

this is exactly what i am looking for , but this code after select the polyline stops ....

Thanks

[reltro]

sure it stops, all has to have an end

look at his name! its called: "From1to4"
its just a Part...

Try coding yourself!

[pedroantonio]

Thanks you for your time reltro

[pedroantonio]

Can anyone help

Thanks

[CAB]

Use the search feature.

http://www.theswamp.org/index.php?topic=20106.0

http://www.theswamp.org/index.php?topic=41670.0

[ChrisCarlson]

Where have you left off? What part are you stuck on?

[pedroantonio]

The polyline have allready attribiute blocks on it .The only thing i want to do is to increase the value of attribute block along a polyline clockwise all the times like this

1,2,3,4,5,6,7,8,...............
Or
Giving a letter first like
K1,K2,K3,K4,..........................
T1,T2,T3,.............................

1) first select the polyline .(The polyline have allready attribiuts on it)
2) Give or not a letter
3)Pick the first point (the point that will have the number 1 or K1 etc...)
4) increase the value of attribute block along a polyline clockwise 

[ChrisCarlson]

I'm not sure how to gather the coordinates in a clockwise fashion but if it's not many attributes you can just manually select them one at a time?

Code: [Select]

(setq num_seq
    (getint
      (strcat "\nStarting number <"
         (itoa num_seq)">: ")))
(car (nentsel "\n--- SELECT ATTRIBUTE ---- ")))
(if (and curText ;
                 (setq curData (entget curText))
                 (= (cdr (assoc 0 curData)) "ATTRIB")
)
         (progn
            (vla-put-TextString
(vlax-ename->vla-object curText)curStr)
(setq num_seq(1+ num_seq))
         )
        (princ "\n--- THIS IS NOT AN ATTRIBUTE ---- ")


[pedroantonio]

Thank you ChrisCarlson but i want to  increase the value of attribute block along a polyline clockwise  automaticaly all. Select only the first ,because i have a lot of points to rename...

[pedroantonio]

is it possible to  increase the value of attribute block along a polyline clockwise  automaticaly. and how?

[ronjonp]

is it possible to  increase the value of attribute block along a polyline clockwise  automaticaly. and how?

Perhaps a bit of searching will lead you in the right direction
http://goo.gl/M9O64C
http://goo.gl/GhIaYY

[pedroantonio]

can anyone help with the code ?

[ronjonp]

is it possible to  increase the value of attribute block along a polyline clockwise  automaticaly. and how?

Perhaps a bit of searching will lead you in the right direction
http://goo.gl/M9O64C
http://goo.gl/GhIaYY

[pedroantonio]

I find this lisp but renale all attribiute poins radom. CAn any one help?

Code - Auto/Visual Lisp: [Select]

1. (defun c:AutoInc (/ _x _y _gbn _ss2l _0 r ss i lat long)
2.   ;; Alan J. Thompson, 03.26.10
3.  
4.   (vl-load-com)
5.  
6.   (setq _x (lambda (e) (car (cdr (assoc 10 (entget e))))))
7.   (setq _y (lambda (e) (cadr (cdr (assoc 10 (entget e))))))
8.   (setq _gbn (lambda (L # / n g f)
9.                (setq n -1)
10.                (while (> (1- (length L)) n)
11.                  (repeat # (setq g (cons (nth (setq n (1+ n)) L) g)))
12.                  (setq f (cons (reverse g) f)
13.                        g nil
14.                  ) ;_ setq
15.                ) ;_ while
16.                (reverse f)
17.              ) ;_ lambda
18.   ) ;_ setq
19.   (setq _ss2l (lambda (x / e i l)
20.                 (if (eq (type x) 'PICKSET)
21.                   (progn (setq i -1)
22.                          (while (setq e (ssname x (setq i (1+ i))))
23.                            (setq l (cons e l))
24.                          ) ;_ while
25.                          l
26.                   ) ;_ progn
27.                 ) ;_ if
28.               ) ;_ lambda
29.   ) ;_ setq
30.   (setq _0 (lambda (l) (vl-position (cdr (assoc 0 (entget x))) l)))
31.  
32.   (or *AI:LR* (setq *AI:LR* "Right"))
33.   (or *AI:TB* (setq *AI:TB* "Top"))
34.  
35.   (cond
36.     ((and (setq r (getint "\nSpecify number of rows: "))
37.           (not (initget 0 "Left Right"))
38.           (setq *AI:LR* (cond
39.                           ((getkword (strcat "\nSort from Left or Right? [Left/Right] <"
40.                                              *AI:LR*
41.                                              ">: "
42.                                      ) ;_ strcat
43.                            ) ;_ getkword
44.                           )
45.                           (*AI:LR*)
46.                         ) ;_ cond
47.           ) ;_ setq
48.           (not (initget 0 "Top Bottom"))
49.           (setq *AI:TB* (cond
50.                           ((getkword (strcat "\nSort from Top or Bottom? [Top/Bottom] <"
51.                                              *AI:TB*
52.                                              ">: "
53.                                      ) ;_ strcat
54.                            ) ;_ getkword
55.                           )
56.                           (*AI:TB*)
57.                         ) ;_ cond
58.           ) ;_ setq
59.           (setq ss (_ss2l (ssget "_:L"
60.                                  '((-4 . "<OR")
61.                                    (0 . "MTEXT,TEXT")
62.                                    (-4 . "<AND")
63.                                    (0 . "INSERT")
64.                                    (66 . 1)
65.                                    (-4 . "AND>")
66.                                    (-4 . "OR>")
67.                                   )
68.                           ) ;_ ssget
69.                    ) ;_ _ss2l
70.           ) ;_ setq
71.  
72.      ) ;_ and
73.  
74.      (setq lat  (if (eq *AI:LR* "Left")
75.                   <
76.                   >
77.                 ) ;_ if
78.            long (if (eq *AI:TB* "Top")
79.                   >
80.                   <
81.                 ) ;_ if
82.      ) ;_ setq
83.  
84.      (setq i 0)
85.      (foreach x
86.               (apply
87.                 (function append)
88.                 (mapcar
89.                   (function (lambda (l) (vl-sort l (function (lambda (a b) (long (_y a) (_y b)))))))
90.                   (mapcar (function (lambda (y) (vl-remove nil y)))
91.                           (_gbn (vl-sort ss (function (lambda (a b) (lat (_x a) (_x b))))) r)
92.                   ) ;_ mapcar
93.                 ) ;_ mapcar
94.               ) ;_ apply
95.  
96.        (cond
97.          ((_0 '("MTEXT" "TEXT"))
98.           (vl-catch-all-apply
99.             (function vla-put-textstring)
100.             (list (vlax-ename->vla-object x) (itoa (setq i (1+ i))))
101.           ) ;_ vl-catch-all-apply
102.          )
103.          ((_0 '("INSERT"))
104.           (vl-catch-all-apply
105.             (function vla-put-textstring)
106.             (list (car (vlax-invoke (vlax-ename->vla-object x) (function GetAttributes)))
107.                   (itoa (setq i (1+ i)))
108.             ) ;_ list
109.           ) ;_ vl-catch-all-apply
110.          )
111.        ) ;_ cond
112.  
113.  
114.      ) ;_ foreach
115.     ) ;_ cond
116.   ) ;_ cond
117.   (princ)
118. ) ;_ defun
119.  
120.  

Thanks

[pedroantonio]

any other options

Thanks

[pedroantonio]

Any ideas

Code - Auto/Visual Lisp: [Select]

1. (defun c:AutoInc (/ _x _y _gbn _ss2l _0 r ss i lat long)
2.   ;; Alan J. Thompson, 03.26.10
3.  
4.   (vl-load-com)
5.  
6.   (setq _x (lambda (e) (car (cdr (assoc 10 (entget e))))))
7.   (setq _y (lambda (e) (cadr (cdr (assoc 10 (entget e))))))
8.   (setq _gbn (lambda (L # / n g f)
9.                (setq n -1)
10.                (while (> (1- (length L)) n)
11.                  (repeat # (setq g (cons (nth (setq n (1+ n)) L) g)))
12.                  (setq f (cons (reverse g) f)
13.                        g nil
14.                  ) ;_ setq
15.                ) ;_ while
16.                (reverse f)
17.              ) ;_ lambda
18.   ) ;_ setq
19.   (setq _ss2l (lambda (x / e i l)
20.                 (if (eq (type x) 'PICKSET)
21.                   (progn (setq i -1)
22.                          (while (setq e (ssname x (setq i (1+ i))))
23.                            (setq l (cons e l))
24.                          ) ;_ while
25.                          l
26.                   ) ;_ progn
27.                 ) ;_ if
28.               ) ;_ lambda
29.   ) ;_ setq
30.   (setq _0 (lambda (l) (vl-position (cdr (assoc 0 (entget x))) l)))
31.  
32.   (or *AI:LR* (setq *AI:LR* "Right"))
33.   (or *AI:TB* (setq *AI:TB* "Top"))
34.  
35.   (cond
36.     ((and (setq r (getint "\nSpecify number of rows: "))
37.           (not (initget 0 "Left Right"))
38.           (setq *AI:LR* (cond
39.                           ((getkword (strcat "\nSort from Left or Right? [Left/Right] <"
40.                                              *AI:LR*
41.                                              ">: "
42.                                      ) ;_ strcat
43.                            ) ;_ getkword
44.                           )
45.                           (*AI:LR*)
46.                         ) ;_ cond
47.           ) ;_ setq
48.           (not (initget 0 "Top Bottom"))
49.           (setq *AI:TB* (cond
50.                           ((getkword (strcat "\nSort from Top or Bottom? [Top/Bottom] <"
51.                                              *AI:TB*
52.                                              ">: "
53.                                      ) ;_ strcat
54.                            ) ;_ getkword
55.                           )
56.                           (*AI:TB*)
57.                         ) ;_ cond
58.           ) ;_ setq
59.           (setq ss (_ss2l (ssget "_:L"
60.                                  '((-4 . "<OR")
61.                                    (0 . "MTEXT,TEXT")
62.                                    (-4 . "<AND")
63.                                    (0 . "INSERT")
64.                                    (66 . 1)
65.                                    (-4 . "AND>")
66.                                    (-4 . "OR>")
67.                                   )
68.                           ) ;_ ssget
69.                    ) ;_ _ss2l
70.           ) ;_ setq
71.  
72.      ) ;_ and
73.  
74.      (setq lat  (if (eq *AI:LR* "Left")
75.                   <
76.                   >
77.                 ) ;_ if
78.            long (if (eq *AI:TB* "Top")
79.                   >
80.                   <
81.                 ) ;_ if
82.      ) ;_ setq
83.  
84.      (setq i 0)
85.      (foreach x
86.               (apply
87.                 (function append)
88.                 (mapcar
89.                   (function (lambda (l) (vl-sort l (function (lambda (a b) (long (_y a) (_y b)))))))
90.                   (mapcar (function (lambda (y) (vl-remove nil y)))
91.                           (_gbn (vl-sort ss (function (lambda (a b) (lat (_x a) (_x b))))) r)
92.                   ) ;_ mapcar
93.                 ) ;_ mapcar
94.               ) ;_ apply
95.  
96.        (cond
97.          ((_0 '("MTEXT" "TEXT"))
98.           (vl-catch-all-apply
99.             (function vla-put-textstring)
100.             (list (vlax-ename->vla-object x) (itoa (setq i (1+ i))))
101.           ) ;_ vl-catch-all-apply
102.          )
103.          ((_0 '("INSERT"))
104.           (vl-catch-all-apply
105.             (function vla-put-textstring)
106.             (list (car (vlax-invoke (vlax-ename->vla-object x) (function GetAttributes)))
107.                   (itoa (setq i (1+ i)))
108.             ) ;_ list
109.           ) ;_ vl-catch-all-apply
110.          )
111.        ) ;_ cond
112.  
113.  
114.      ) ;_ foreach
115.     ) ;_ cond
116.   ) ;_ cond
117.   (princ)
118. ) ;_ defun
119.  
120.  
121.  

[pedroantonio]

Hi .I am looking for a lisp to do this

The polyline have allready attribiute blocks on it .The only thing i want to do is to increase the value of attribute block along a polyline clockwise all the times like this

1,2,3,4,5,6,7,8,...............
Or
Giving a letter first like
K1,K2,K3,K4,..........................
T1,T2,T3,.............................

1) first select the polyline .(The polyline have allready attribiuts on it)
2) Give or not a letter
3)Pick the first point (the point that will have the number 1 or K1 etc...)
4) increase the value of attribute block along a polyline clockwise 

Any ideas ?

[ribarm]

Try this simple one :

Code: [Select]

(defun c:pblinclw ( / ListClockwise-p osm ss lw vl pt n pr k v bl att )

  (defun ListClockwise-p ( lst / z vlst )
    (vl-catch-all-apply 'minusp
      (list
        (if
          (not
            (equal 0.0
              (setq z
                (apply '+
                  (mapcar
                    (function
                      (lambda (u v)
                        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
                      )
                    )
                    (setq vlst
                      (mapcar
                        (function
                          (lambda (a b) (mapcar '- b a))
                        )
                        (mapcar (function (lambda (x) (car lst))) lst)
                        (cdr (reverse (cons (car lst) (reverse lst))))
                      )
                    )
                    (cdr (reverse (cons (car vlst) (reverse vlst))))
                  )
                )
              ) 1e-6
            )
          )
          z
          (progn
            (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
            nil
          )
        )
      )
    )
  )

  (setq osm (getvar 'osmode))
  (setvar 'osmode 8)
  (prompt "\nPick 2D LWPOLYLINE that has blocks with attributes to increment at its vertices...")
  (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
  (setq lw (ssname ss 0))
  (setq vl (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget lw))))
  (if (not (ListClockwise-p vl)) (setq vl (reverse vl)))
  (setq pt (getpoint "\nPick starting point : "))
  (setq n (length vl))
  (setq pr (getstring "\nSpecify prefix : "))
  (setq vl (vl-member-if '(lambda (x) (equal (list (car pt) (cadr pt)) x 1e-6)) (reverse (cdr (vl-member-if '(lambda (x) (equal (list (car pt) (cadr pt)) x 1e-6)) (reverse (append vl vl)))))))
  (setq k 0)
  (repeat n
    (setq k (1+ k))
    (setq v (car vl))
    (setq bl (ssname (ssget v '((0 . "INSERT") (66 . 1))) 0))
    (setq att (entnext bl))
    (entmod (subst (cons 1 (strcat pr (itoa k))) (assoc 1 (entget att)) (entget att)))
    (entupd att)
    (setq vl (cdr vl))
  )
  (setvar 'osmode osm)
  (princ)
)

[EDIT : LWPOLYLINE and its ATTRIBUTED BLOCKS set at each vertex must be completely visible on screen for routine to operate as should...]

[pedroantonio]

hi ribarm. I think that works fine. I will test it for a few day .If i find any bug i will tell you.

Thanks   

[pedroantonio]

hi ribarm. Same times gives me this error message and the lisp stop
; error: bad argument type: lselsetp nil

Why ?

Look the test file . Why in this file the code didn't work?

[ronjonp]

hi ribarm. Same times gives me this error message and the lisp stop
; error: bad argument type: lselsetp nil

Why ?

Look the test file . Why in this file the code didn't work?

http://www.lee-mac.com/debugvlide.html

[pedroantonio]

Hi ronjonp . In vlisp editor the code have no errors ...

But in the test,dwg file didn't work properly. Look the test.dwg file and test the code and you will understand.

Thanks

[ronjonp]

You have to make sure that you don't miss your selection the way the code is written. Generally an if statement is included to verify that all items needed exist before actually executing the code.

(setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))

[MORITZK]

The code works without failure with test dwg.
Moritz

[pedroantonio]

The code works without failure with test dwg.
Moritz

I use Autocad 2010. When i run the code rename 2 or 3 first points and then stop. The example is the test.dwg

You have to make sure that you don't miss your selection the way the code is written. Generally an if statement is included to verify that all items needed exist before actually executing the code.

(setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))

I load all my lisp files when the autocad start , but i try to load the lisp file after i draw the points and the polyline and i have the same problem
When i run the code rename 2 or 3 first points and then stop. The example is the test.dwg

Any ideas?

Thanks

[roy_043]

Four ideas. All related to this line of code:

Code: [Select]

(setq bl (ssname (ssget v '((0 . "INSERT") (66 . 1))) 0))1.
If some of the blocks are off-screen ssget will/may not work.
2.
Since there is no entity in the center of the circle inside the block, and a single point is used to select the block, the current pickbox and zoom settings will influence the result of ssget.
3.
The draworder may also play a part. If the polyline is 'on top' ssget will return nil.
4.
For the last two reasons and to allow for tolerances, using a small crossing to select the blocks is better. Alternatively a fence could be used to select all the blocks at once.

It would of course be much easier and more reliable to change the atributes while the blocks are being inserted...

[pedroantonio]

thank you roy_043 for the help.

To avoid all this problem is it possible to add two lines to this code
when select the polyline
a)zoom extend the drawing
b)sent back the polyline ,and then rename the blocks

thanks

[ronjonp]

Of course it's possible. Let's see if you can help yourself a bit.
Here are the lines of code you need, plug them in where you need them.

Code: [Select]

(command "_.zoom" "_extents")
(command "_.draworder" (ssget "_X" '((0 . "~Insert"))) "" "_back")

[roy_043]

Replacing this line:

Code: [Select]

(setq bl (ssname (ssget v '((0 . "INSERT") (66 . 1))) 0))With:

Code: [Select]

(setq bl
  (ssname
    (ssget
      "_X"
      (list
        '(0 . "INSERT")
        '(66 . 1)
        '(-4 . "<,<,*")
        (list 10 (+ (car v) 1e-6) (+ (cadr v) 1e-6) 0.0)
        '(-4 . ">,>,*")
        (list 10 (- (car v) 1e-6) (- (cadr v) 1e-6) 0.0)
      )
    )
    0
  )
)May solve all issues I have mentioned. But the program will probably be slower.

BTW: there actually is an entity in the center of the circle.

[pedroantonio]

Thanks you roy_043 and ronjonp and the two solutions works fine

A) With zoom extend

Code: [Select]

(defun c:pblinclw ( / ListClockwise-p osm ss lw vl pt n pr k v bl att )

  (defun ListClockwise-p ( lst / z vlst )
    (vl-catch-all-apply 'minusp
      (list
        (if
          (not
            (equal 0.0
              (setq z
                (apply '+
                  (mapcar
                    (function
                      (lambda (u v)
                        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
                      )
                    )
                    (setq vlst
                      (mapcar
                        (function
                          (lambda (a b) (mapcar '- b a))
                        )
                        (mapcar (function (lambda (x) (car lst))) lst)
                        (cdr (reverse (cons (car lst) (reverse lst))))
                      )
                    )
                    (cdr (reverse (cons (car vlst) (reverse vlst))))
                  )
                )
              ) 1e-6
            )
          )
          z
          (progn
            (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
            nil
          )
        )
      )
    )
  )

  (setq osm (getvar 'osmode))
  (setvar 'osmode 8)
  (prompt "\nPick 2D LWPOLYLINE that has blocks with attributes to increment at its vertices...")
  (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
  (setq lw (ssname ss 0))
  (setq vl (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget lw))))
  (if (not (ListClockwise-p vl)) (setq vl (reverse vl)))
  (setq pt (getpoint "\nPick starting point : "))
  (setq n (length vl))
(command "_.zoom" "_extents")
(command "_.draworder" (ssget "_X" '((0 . "~Insert"))) "" "_back")
  (setq pr (getstring "\nSpecify prefix : "))
  (setq vl (vl-member-if '(lambda (x) (equal (list (car pt) (cadr pt)) x 1e-6)) (reverse (cdr (vl-member-if '(lambda (x) (equal (list (car pt) (cadr pt)) x 1e-6)) (reverse (append vl vl)))))))
  (setq k 0)
  (repeat n
    (setq k (1+ k))
    (setq v (car vl))
    (setq bl (ssname (ssget v '((0 . "INSERT") (66 . 1))) 0))
    (setq att (entnext bl))
    (entmod (subst (cons 1 (strcat pr (itoa k))) (assoc 1 (entget att)) (entget att)))
    (entupd att)
    (setq vl (cdr vl))
  )
  (setvar 'osmode osm)
  (princ)
)

b) Change (setq bl (ssname (ssget v '((0 . "INSERT") (66 . 1))) 0))

Code: [Select]

(defun c:pblinclw ( / ListClockwise-p osm ss lw vl pt n pr k v bl att )

  (defun ListClockwise-p ( lst / z vlst )
    (vl-catch-all-apply 'minusp
      (list
        (if
          (not
            (equal 0.0
              (setq z
                (apply '+
                  (mapcar
                    (function
                      (lambda (u v)
                        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
                      )
                    )
                    (setq vlst
                      (mapcar
                        (function
                          (lambda (a b) (mapcar '- b a))
                        )
                        (mapcar (function (lambda (x) (car lst))) lst)
                        (cdr (reverse (cons (car lst) (reverse lst))))
                      )
                    )
                    (cdr (reverse (cons (car vlst) (reverse vlst))))
                  )
                )
              ) 1e-6
            )
          )
          z
          (progn
            (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
            nil
          )
        )
      )
    )
  )

  (setq osm (getvar 'osmode))
  (setvar 'osmode 8)
  (prompt "\nPick 2D LWPOLYLINE that has blocks with attributes to increment at its vertices...")
  (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
  (setq lw (ssname ss 0))
  (setq vl (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget lw))))
  (if (not (ListClockwise-p vl)) (setq vl (reverse vl)))
  (setq pt (getpoint "\nPick starting point : "))
  (setq n (length vl))
  (setq pr (getstring "\nSpecify prefix : "))
  (setq vl (vl-member-if '(lambda (x) (equal (list (car pt) (cadr pt)) x 1e-6)) (reverse (cdr (vl-member-if '(lambda (x) (equal (list (car pt) (cadr pt)) x 1e-6)) (reverse (append vl vl)))))))
  (setq k 0)
  (repeat n
    (setq k (1+ k))
    (setq v (car vl))
(setq bl
  (ssname
    (ssget
      "_X"
      (list
        '(0 . "INSERT")
        '(66 . 1)
        '(-4 . "<,<,*")
        (list 10 (+ (car v) 1e-6) (+ (cadr v) 1e-6) 0.0)
        '(-4 . ">,>,*")
        (list 10 (- (car v) 1e-6) (- (cadr v) 1e-6) 0.0)
      )
    )
    0
  )
)
    (setq att (entnext bl))
    (entmod (subst (cons 1 (strcat pr (itoa k))) (assoc 1 (entget att)) (entget att)))
    (entupd att)
    (setq vl (cdr vl))
  )
  (setvar 'osmode osm)
  (princ)
)
Thank you ...