Lisp for sorting detailed points "DP"

January 13

Greetings and all the best in 2024!

Apologies for the English language, I'm using a translator!

After a long unsuccessful search on the internet and various attempts with Lisp, I decided to turn to the forum.

I use the “DP” (Detailed Point) block whose first attribute (TAG “NUMBER”) represents the number “DP”.
The main drawing consists of several inserted drawings in which “DP” are located that need to be renumbered.

Lisp should have the following options:

- choose from which “DP” to start renumbering, but if there are “DP” with the same number, start renumbering from the “DP” that was first created in the main drawing
(Is it possible to sort “DP”, i.e., blocks with attributes, by the time of creation-insertion in the main drawing and then assign them a serial number?)

- choose-write how much to increase the next number (increment)

- the possibility of adding a prefix and suffix
(If “DP” already has a prefix or suffix, remember which ones and return them to “DP” after renumbering, if you want.)

For example, if sorting is selected from the detailed point “A1”, i.e., from the detailed point 1 and only numerical display.

Final drawing

One of the biggest problems is when there are “DP” with the same number, I have not been able to find a way to sort it as I need it.

Thanks in advance for the answers, help!

January 14

So:

Select a block (DP) to get the current start point for the numbering

Get user input for prefix, suffix and increment / increase.

Change the attribute value of any DP block that was subsequently inserted incrementally from the first block selected?

How many blocks are you needing to change at once? Lee Macs CTX / STX (copy / swap text) functions might be a starting point, and to add an increment ability if you only have a few to do at once (easier to code perhaps, I have similar in my LISP library, select initial text value, select next text to be as before + a value)

I'd have to do some reading if it is possible to sort entities by their insertion time - have you found anything that does that that you can post or post link to? Once we know how to do that there are a lot of LISPs out there to read or modify an attribute.

Second, if you have any LISPs that you have made that are nearly there, post them with notes as to where they go wrong

January 14

Thank you for your interest!

The change in blocks varies from drawing to drawing, it can be 50, 100, 1500, or more blocks.
The number of blocks is not a problem, in some old Lisp tests (I have to find them), I would sort 2000 blocks within 2-3 seconds (it was a classic sorting, only numbers, vl-sort-i).

Unfortunately, I have not found an answer about sorting entities by insertion time,
that is one of my ideas with which I thought to solve the problem of sorting duplicate block-points.

Another idea was to sort duplicates “DP” using multiple lists.
Save “DP” in the first list, separate duplicates “DP” in the second list, when the first list is renumbered, renumber the second list with the serial number of the first list
and merge everything into the third list. (For now, I have not been able to do that, I am a beginner in programming with Lisp).

I have various Lisp tests that I have tried, I have to find them because I almost gave up on everything.

We will talk soon, just let me dig through old disks!

Thank you again for your interest!

Edited January 14 by Deki

January 15

"sort entities by their insertion time " dont think that exists, when using ssget not sure 100% but may be in creation order, issue is when you delete A13 and add it say back in its now at end of creation order.

Steven my take "Select a block (DP) to get the current start point for the numbering" rather select object say pline near block can then find that block and the rest of the blocks at vertices, looking at images can have 3 blocks at 1 point. Creating new labels at pline vertices may be the way to go, can check does "A1" exist ? So look for highest "A" number.

I think we need a dwg not images with before and after even if multi steps so its clear what is changing.

January 15

14 hours ago, BIGAL said:

"sort entities by their insertion time " don't think that exists,

Thought that was the case, but wasn't sure. I'm thinking just now that the OP wants the points sorted by location rather than by when the block was inserted, and the creation time is more to do with which drawing was inserted when.

Probably, yes, a drawing showing before and after might help (rather than images)

SSGET will be in selection order, select them individually and that is the list order for example

Edited January 15 by Steven P

January 15

Here is something quick for the first case where you have A1...B1...C1... blocks. I changed the block and attribute names because I assume you are working with these...but edit them if needed.

(defun c:test ( / str_sort LM:getattributevalue LM:setattributevalue ssDT n ent broj lista lista_sort)
(defun str_sort	(l)
  (vl-sort l
	   '(lambda (a b)
	      (cond
		((numberp (read (car a))))
		((numberp (read (car b))) nil)
		((< (car a) (car b)))
	      )
	    )
  )
);defun
(defun LM:getattributevalue ( blk tag / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (cdr (assoc 1 (reverse enx)))
            (LM:getattributevalue blk tag)
        )
    )
);defun
(defun LM:setattributevalue ( blk tag val / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
                (progn
                    (entupd blk)
                    val
                )
            )
            (LM:setattributevalue blk tag val)
        )
    )
);defun
(setq ssDT (ssget '((0 . "INSERT") (2 . "DT"))))
(setq  n 0)
(while (< n (sslength ssDT))
  (setq ent (ssname ssDT n))
  (setq broj (LM:getattributevalue ent "BROJ"))
  (setq lista (cons (list broj ent) lista))
  (setq n (1+ n))
  );while
(setq lista_sort (str_sort lista))
(setq n 0)
(while (< n (length lista_sort))
  (setq ent (cadr (nth n lista_sort)))
  (LM:setattributevalue ent "BROJ" (rtos (+ n 1) 2 0))
  (setq n (1+ n))
  );while
);defun

Like said above, for the second case, you have to have some kind of value to determine which set of points is from main drawing, csv or drawing 2, insertion time doesn't exists.

Osobno, razdvojio bi točke prema boji, ili slojevima, glavni crtez jedna boja ili sloj, csv druga itd. Pa dalje obrada po potrebi, lakse je onda numerirati tako razdvojene setove blokova. Iako mozda nisam skuzio glavnu poantu zasto to hoces bas na ovakav nacin.

January 15

Thank you for your interest!

The change in blocks varies from drawing to drawing, it can be 50, 100, 1500, or more blocks.
The number of blocks is not a problem, in some old Lisp tests (I have to find them), I would sort 2000 blocks within 2-3 seconds (it was a classic sorting, only numbers, vl-sort-i).

Unfortunately, I have not found an answer about sorting entities by insertion time,
that is one of my ideas with which I thought to solve the problem of sorting duplicate block-points.

Another idea was to sort duplicates “DP” using multiple lists.
Save “DP” in the first list, separate duplicates “DP” in the second list, when the first list is renumbered, renumber the second list with the serial number of the first list
and merge everything into the third list. (For now, I have not been able to do that, I am a beginner in programming with Lisp).

I have various Lisp tests that I have tried, I have to find them because I almost gave up on everything.

We will talk soon, just let me dig through old disks!

Thank you again for your interest!

January 15

Thank you!

I sent a post yesterday, but it looks like I made a mistake when sending the post!

Tonight I will show some lisp, so maybe some things will be clearer .

January 15

Thinking about this today, entity name increases with each entity you create, a hexadecimal number

Test below will display the hex number as decimal (I reckon most of us work in decimal - easier for our minds), and from that can order and rename the attributes as needed?

Putting the code below as an example of getting the entity number, MyString, and displaying this as a decimal number

(defun c:test ( / MySS MyEnt acount)
;;https://www.cadtutor.net/forum/topic/79150-lisp-for-sorting-detailed-points-dp/#comment-627414
  (defun c:hex2dec ( / a b c e i l s x )
    (if (setq s (ssget "_:L" '((0 . "INSERT") (2 . "RS") (66 . 1))))
      (repeat (setq i (sslength s))
           (setq e (entnext (ssname s (setq i (1- i))))
                 x (entget e)
           )
           (while (= "ATTRIB" (cdr (assoc 0 x)))
               (setq l (cons (list (strcase (cdr (assoc 2 x))) (cdr (assoc 1 x)) x) l)
                     e (entnext e)
                     x (entget  e)
               )
           )
           (if (and (setq a (assoc "AC" l))
                    (setq b (assoc "ADDRESS" l))
                    (setq c (assoc "DEV" l))
                    (entmod
                        (subst
                            (cons  1 (itoa (+ (LM:base->dec (cadr a) 16) (LM:base->dec (cadr b) 16))))
                            (assoc 1 (caddr c))
                            (caddr c)
                        )
                    )
               )
               (entupd (cdr (assoc -1 (caddr c))))
           )
       )
    )
    (princ)
  )               

;; Base to Decimal  -  Lee Mac
;; Converts an number in an arbitrary base to decimal.
;; n - [str] string representing number to convert
;; b - [int] base of input string
;; Returns: [int] Decimal representation of supplied number

  (defun LM:base->dec ( n b / l )
   (if (= 1 (setq l (strlen n)))
       (- (ascii n) (if (< (ascii n) 65) 48 55))
       (+ (* b (LM:base->dec (substr n 1 (1- l)) b)) (LM:base->dec (substr n l) b))
   )
  )



;;end defuns

  (princ "Select Entities")
  (setq MySS (ssget))
  (setq acount 0)
  (while (< acount (sslength MySS))
    (setq MyString (substr (vl-princ-to-string (ssname MySS acount)) 15 11) )

    (princ "\n")
    (princ (LM:base->dec MyString 16))

    (setq acount (+ acount 1))
  ) ; end while
  (princ)

)

Leaving this up here to test later and for a sample drawing to apply it to

Edited January 15 by Steven P

January 15

Greeting!

Thank you for your effort!

I recently found this code on the internet and tried to modify it a bit, I haven’t finished yet!
This code subscribes well as long as there are no duplicate points, i.e. with the same number.
So far I have not been able to add the possibility of adding-recognizing prefixes and suffixes.

I also like the code written by “lastknownuser”, I think I will borrow some solutions from that code!
The code works ok, I’m still playing with it, I tried to turn “Lista sort” and other tests to get the result I’m looking for, thank you!

I am attaching three drawings;

01_Main_Drawing

02_Drawing_2

03_Drawing_3 (the drawing has duplicate points 1 and 2, as in the drawing “Main_Drawing”)

01_Main_Drawing.dwg 02_Drawing_2.dwg 03_Drawing_3.dwg Test_01.lsp

Test_01.lsp

(defun C:TEST01 (/ renum sort_car ss e lst start_num new_num)

;-----------------------------------------------------------

 ;; Parse Numbers  -  Lee Mac
 ;; Parses a list of numerical values from a supplied string.

(defun LM:parsenumbers ( str )
    (   (lambda ( l )
            (read
                (strcat                           ;;"("   <-- brackets removed
                    (vl-list->string
                        (mapcar
                           '(lambda ( a b c )
                                (if (or (< 47 b 58)
                                        (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                        (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                    )
                                    b 32
                                )
                            )
                            (cons nil l) l (append (cdr l) '(()))
                        )
                    )
                                                  ;;")"   <-- brackets removed
                )
            )
        )
        (vl-string->list str)
    )
)

;-----------------------------------------------------------

  (defun RENUM (x / i)
   (setq i (car x))
   (vla-put-TextString
    (cdr x)
     (strcat
      (cond ((< i 10) "")    ;;  <-- These deleted and insert code for prefix and suffix
            ((< i 100) "")
            ("")
      )
       (itoa i)
     )
   )
  )

;-----------------------------------------------------------

  (defun SORT_CAR (lst)
   (mapcar '(lambda (x) (nth x lst))
    (vl-sort-i lst '(lambda (x1 x2) (< (car x1) (car x2))))
   )
  )


;-----------------------------------------------------------


 (if (setq ss (ssget '((0 . "INSERT") (2 . "tocke"))))
    (while (> (sslength ss) 0)
      (foreach n (vlax-invoke
                   (vlax-ename->vla-object (setq e (ssname ss 0)))
                   'getAttributes
                 )
       (if (eq (strcase (vla-get-TagString n)) "TOCKA")
         (setq lst (cons (cons (LM:parsenumbers (vla-get-TextString n)) n) lst))    ;;(setq lst (cons (cons (atoi (vla-get-TextString n)) n) lst))  <-- Original code
       )
      )
      (ssdel e ss)
   )
 )
   (if lst
    (progn
      (setq lst (SORT_CAR lst))
      (princ (strcat "\nObjects found: " (itoa (length lst))))
      (initget 6)
      (or (setq start_num (getint "\nModify all attributes starting with <1>: "))
          (setq start_num 1)
      )
      (initget 6)
      (or (setq new_num (getint "\nNew starting number <1>: "))
          (setq new_num 1)
      )
;insert code for prefix and suffix 
;;(setq pref (getstring "\nEnter Prefix: "))
;;(setq suff (getstring "\nEnter Sufix: "))
      (setq lst     (vl-remove-if-not '(lambda (x) (<= start_num (car x))) lst)
            new_num (1- new_num)
      )
      (mapcar
        'RENUM
        (mapcar '(lambda (x) (cons (setq new_num (1+ new_num)) (cdr x)))
                lst
        )
      )
    )
  )
  (princ (strcat "\n...DONE Renumbered points: " (itoa (length lst))))
  (princ)
 )

In “Main_Drawing” insert “Drawing_2” and run lisp Test_01 (test01). Sorts well!
In “Main Drawing” insert “Drawing_3” and run lisp Test_01 (test01). Does not sort well!

I simplified the drawing and now “tocke” blocks are used with the first attribute “TOCKA”, these are original blocks!

Here is the code (from cadtutor.net) that gave me another idea.
It should be changed to compare the first attribute, if it is duplicate save it in the “MyRemoved” list
and later renumber with the teaching number from the list, e.g. “MyResult”.

(defun c:test ( / Points_List SS acount MyEnt NewEnt MyCount MyResult MyRemoved Mycount )
  (setq Points_List (list))
  (setq SS (ssget '((0 . "POINT"))))
  (setq acount 0)
  (while (< acount (sslength SS))
    (setq MyEnt (entget (ssname SS acount)))
    (setq NewEnt (list (assoc 0 MyEnt) (assoc 67 MyEnt) (assoc 8 MyEnt) (assoc 10 MyEnt)))
    (setq Points_List (append Points_List (list NewEnt)) )
    (setq acount (+ acount 1))
  ) ; end while

  (setq MyCount (length Points_List))
  (setq MyResult (list))
  (setq MyRemoved (list))
  (while (> MyCount 0)
    (setq Mycount (- MyCount 1))
    (if (member (nth MyCount Points_List) MyResult)
      (setq MyRemoved (append (list (nth MyCount Points_List)) MyRemoved))
      (setq MyResult (append (list (nth MyCount Points_List)) MyResult))
    ) ; end if
  ) ; end while

(princ "\n")(princ MyRemoved)
(princ "\n")(princ MyResult)
(princ)

)

By the way, Steven, I remembered where I got the idea for sorting entities by insertion time!
I read a book by AutoCAD author Dan Abbott a long time ago, who wrote that he proved, in court,
by the time of creation of the entity which company is the real author of a drawing.
Hmm, did I mess up a bit, but it would help us a lot if we could sort like that!?!

February 3

Greeting!

After some time of thinking (learning Lisp) and asking wrong questions, and something was lost in translation (sorry guys, thanks again),
I “composed” this small program that solves my problem. Of course, thanks to Lee Mac and others for the finished functions!

(defun C:TEST02 (/ ssTocke opcija opX noviBroj BrojInc pre suf kolikoTocaka ent tocka)

;---------------------------------------------------------------------------------------------

(defun LM:setattributevalue ( blk tag val / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
                (progn
                    (entupd blk)
                    val
                )
            )
            (LM:setattributevalue blk tag val)
        )
    )
)

;---------------------------------------------------------------------------------------------

(defun LM:getattributevalue ( blk tag / val enx )
    (while
        (and
            (null val)
            (setq blk (entnext blk))
            (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
        )
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (setq val (cdr (assoc 1 (reverse enx))))
        )
    )
)

;----------------------------------------------------------------------------------------------

(defun extract (s / i prefix number suffix)
  (setq i 0 prefix "" number "" suffix "")
  (repeat (strlen s)
     (setq c (substr s (setq i (1+ i)) 1))
     (cond
        (  (and (wcmatch c "#")
                (eq suffix ""))
           (setq number (strcat number c)))
        (  (and (wcmatch c "#*")
                (= suffix number "")
                (wcmatch
                  (substr s (1+ i) 1) "#"))
           (setq number (strcat number c)))
        (  (eq number "")
           (setq prefix (strcat prefix c)))
        (t (setq suffix (strcat suffix c)))))
  (if (not (zerop (strlen number)))           
       (setq pre prefix suf suffix)
  )
)

;----------------------------------------------------------------------------------------------

  (if (setq ssTocke (ssget "X" '((0 . "INSERT") (2 . "tocke"))))
    (progn
      (initget "Prve Zadnje")
      (setq opcija (getkword "\nPrenumerirajte tocke od [Prve/Zadnje] ubacene u crtez <Prve>: ")
            opcija (if opcija opcija "Prve")
      )
      (initget 6)
      (or (setq noviBroj (getint "\nUpisite novi broj pocetne tocke <1>: "))
          (setq noviBroj 1)          
      )
      (initget 6) 
      (or (setq BrojInc (getint  "\nUvecajte brojeve tocaka za <1>: "))
          (setq BrojInc 1)          
      )
      (initget "Staro Novo Brojevi")
      (setq opX (getkword "\nPrefiks - Sufiks [ostavi Staro/upisi Novo/samo Brojevi] <Brojevi>: ")
            opX (if opX opX "Brojevi")
      )
      (if (= opX "Novo")
        (progn
          (setq pre (getstring "\nUpisite prefiks ili <Enter> bez prefiksa: "))
          (setq suf (getstring "\nUpisite sufiks ili <Enter> bez sufiksa: "))
        )
      )
      (setq kolikoTocaka (itoa (sslength ssTocke)))
      (while (> (sslength ssTocke) 0)
        (if (= opcija "Prve") (setq ent (ssname ssTocke (- (sslength ssTocke) 1))) (setq ent (ssname ssTocke 0)))
        (if (= opX "Staro")
          (progn
            (setq tocka (LM:getattributevalue ent "TOCKA"))
            (extract tocka)
          )
        )
        (if (= opX "Brojevi") 
          (LM:setattributevalue ent "TOCKA" (itoa noviBroj)) 
          (LM:setattributevalue ent "TOCKA" (strcat pre (itoa noviBroj) suf)))
        (setq noviBroj (+ noviBroj BrojInc))
        (ssdel ent ssTocke)
      );end while
    )
    (progn
      (princ "Blok TOCKE nije pronaden, izlazim iz programa!")
      (exit)
    )
  );end if
  (princ (strcat "\n...GOTOVO prenumerirano tocaka: " kolikoTocaka))
  (princ)
)

February 5

To find the order of creation I would use the handle of the entity. (cdr (assoc 5 (entget (car (entsel))))) or (vla-get-handle (vlax-ename->vla-object (car (entsel))))
Indeed when creating an object, it acquires a hexadecimal number which is incremented automatically. This numbering remains unchanged from one session to another.
If an object is deleted the handle is lost and will no longer be used, but the others will not be affected by this deletion; they retain their original handle.
So it is easy to sort from the smallest handle to the largest even if the sequence has holes.
The smallest will be the first object created, the largest the last...

And thanks to the function (handent "Hexadecimal Number") you will obtain the name of the entity which you can then query.

February 11

Entity identifier (assoc 5) is a good idea because it remains unchanged in the drawing, but it changes if another drawing is inserted.
My head is a bit mixed up as I’ve just started learning Lisp and DXF group codes. Nevertheless, thank you for the idea!

Sign In

Lisp for sorting detailed points "DP"

Recommended Posts

Deki

Steven P

Deki

BIGAL

Steven P

lastknownuser

Deki

Deki

Steven P

Deki

Deki

Tsuky

Deki

Join the conversation

Tutorials

Forums

Activity