Increment Attributes inserting block again

Increment Attributes inserting block again

C.Utzinger
Collaborator Collaborator
4,243 Views
63 Replies
Message 1 of 64

Increment Attributes inserting block again

C.Utzinger
Collaborator
Collaborator

HI

 

First of all: Happy New Year!!!

 

OK! I wrote this little Code, but i want to use Chars with numbers. For example EG001... EG002... EG003

 

How can i do that...????

 

 

(defun C:<Test5 ( / Pnummer)
	(princ "\nEinfügepunkt angeben: ")
	(command "_-insert" "SPI-Datenextraktionspunkt-CM" pause "1" "1" "" (setq Pnummer (getint "\nPunktnummer angeben (01): ")) "")
	(repeat 1000
	(setq Pnummer (+ Pnummer 1))
	(command "_-insert" "SPI-Datenextraktionspunkt-CM" pause "1" "1" "" Pnummer ""))	
	(prin1)
) ; end of defun
0 Likes
4,244 Views
63 Replies
Replies (63)
Message 61 of 64

C.Utzinger
Collaborator
Collaborator

WOW. I like the future!!!!

 

Nice new functions!!!

 

I fixed for the old format.

 

  (defun :AttMaxValues (/ i en em att val num lst)
    (if (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "SPI-Datenextraktionspunkt-CM") (cons 410 (getvar 'CTAB)))))
      (repeat (setq i (sslength ss))
        (setq en (ssname ss (setq i (1- i))))
        (while (/= (cdr (assoc 0 (setq em (entget (setq en (entnext en)))))) "SEQEND")
          (and (eq (cdr (assoc 0 em)) "ATTRIB")
               (setq att (cdr (assoc 1 (reverse em))))
               (setq pre (vl-string-right-trim "0123456789" att)
                     pre (if (wcmatch pre "*;*") (substr pre (+ 2 (vl-string-search ";" pre))) pre))
               (setq num (:getNumFromRight att))
               (setq lst (if (setq a (assoc pre lst))
                           (subst (cons pre (if (> (atoi num) (atoi (cdr a)))
                                              num
                                              (cdr a)))
                                  a
                                  lst)
                           (cons (cons pre num) lst)))))))
    (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))))

 

I found just one little issue. I don´t think it could happen, but i always expect a DAU! 

 

"DAU" : Dümmster anzunehmender user.

In English it is something like "SEU": Stupiest expected user.

 

If you have OG5003, and the user types for the *<Koordpunkt-g* = OG5, then the value is not found, and it starts at 1.

 

But i'm thinking to let it like this!!!

 

Thank you very much!

 

 

Nice weekend

0 Likes
Message 62 of 64

C.Utzinger
Collaborator
Collaborator

 

I tried something, but i made a mess!

 

Tomorrow again!!!

 

Kind regards

0 Likes
Message 63 of 64

ВeekeeCZ
Consultant
Consultant
Accepted solution

Yeah, I know the kind. In czech forums (especially IT) is widespread the english acronym 'BFU'. But no confusion, it's czech made. We found that there are two kinds... the Brain Free User and the Bloody F*cking User, which may be aggressive.
The common czech interpetation of a non-aggressive type is Běžný Franta Uživatel, which can be translated to english as Frankie, the ordinary user.

 

Anyway, back to the topic. You should not try to fix every possible wrong user input. Just don't allow that. Here is the example of how to do that... and some minor impovements as well. The only exception may be if you force the user to use a delimiter. Then I would add that programmally if the user didn't.

 

 

(defun c:<Koordpunkt ( / *error* lay cmd :MaxAttValue :AddLeadingZeros txt enl enlast amvs)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CLAYER lay)
    (princ "\nLetzte Punktnummer gespeichert!")
    (terpri)
    (princ))


  (defun :getNumFromRight (str / idx val char)
    (setq idx (strlen str)
          val "")
    (while (and (> idx 0)
                (setq char (substr str idx 1))
                (wcmatch char "#"))
      (setq val (strcat char val)
            idx (1- idx)))
    val)

  
  (defun :AttMaxValues (/ i en em att val num lst a)
    (if (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "SPI-Datenextraktionspunkt-CM") (cons 410 (getvar 'CTAB)))))
      (repeat (setq i (sslength ss))
        (setq en (ssname ss (setq i (1- i))))
        (while (/= (cdr (assoc 0 (setq em (entget (setq en (entnext en)))))) "SEQEND")
          (and (eq (cdr (assoc 0 em)) "ATTRIB")
               (setq att (cdr (assoc 1 (reverse em))))
	       (setq pre (vl-string-right-trim "0123456789" att)
                     pre (if (wcmatch pre "*;*") (substr pre (+ 2 (vl-string-search ";" pre))) pre)) ; the old format 
               (setq num (:getNumFromRight att))
               (setq lst (if (setq a (assoc pre lst))
                           (subst (cons pre (if (> (atoi num) (atoi (cdr a)))
                                              num
                                              (cdr a)))
                                  a
                                  lst)
                           (cons (cons pre num) lst)))))))
    (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))))

  (defun :AttMaxValue (pre / a)
    (if (setq a (assoc pre (:AttMaxValues)))
      (cdr a)
      "0"))  

  (defun :AddLeadingZeros (a d / b) ;add zeros to 'd' many digits  ;a string
    (strcat (substr "000000000" 1 (if (>= d (setq b (strlen (itoa (fix (atof a)))))) (- d b) 0)) a))
  
  
  ; ------------------------------------------------------------------------------------------------------
  
  (setq lay (getvar 'CLAYER))
  
  (command "_.-LAYER" "_m" "-I-Koordinatenpunkte" "_co" "3" "-I-Koordinatenpunkte" "")
  
  (setq oATTREQ (getvar 'ATTREQ)
        oATTDIA (getvar 'ATTDIA))
  (setvar 'ATTREQ 1)
  (setvar 'ATTDIA 0)
  
  (or *<Koordpunkt-g*
      (setq *<Koordpunkt-g* ""))

  (if (setq amvs (:AttMaxValues))
    (princ (strcat "\nUsed prefixes with MAX: " (apply 'strcat (mapcar '(lambda (x) (strcat (car x) (cdr x) " # ")) amvs)))))
  
  (while (progn
	   (initget 128)
	   (setq *<Koordpunkt-g* (strcase (cond ((getkword (strcat "\nGeschoss angeben (zB. \"1U-\", \"EG-\" oder \"\" für Ohne) <" (if (= "" *<Koordpunkt-g*) "Ohne" *<Koordpunkt-g*) ">: ")))
						(*<Koordpunkt-g*)))
		 *<Koordpunkt-g* (if (= "\"\"" *<Koordpunkt-g*)
				   ""
				   *<Koordpunkt-g*))
	   (cond ((wcmatch *<Koordpunkt-g* "*#")
		  (alert "The prefix can't finish with a number. Use a dash if necessary.")
		  (setq *<Koordpunkt-g* ""))
		 ((wcmatch *<Koordpunkt-g* "*;*")
		  (alert "The prefix cannot contain a semicolon.")
		  (setq *<Koordpunkt-g* ""))))) 
  
  (setq *<Koordpunkt-i* (1+ (atoi (setq *<Koordpunkt-z* (:AttMaxValue *<Koordpunkt-g*))))
	*<Koordpunkt-z* (strlen *<Koordpunkt-z*)
        *<Koordpunkt-i* (cond ((getint (strcat "\nPunktnummer angeben <" (:AddLeadingZeros (itoa *<Koordpunkt-i*) *<Koordpunkt-z*) ">: ")))
                              (*<Koordpunkt-i*)))

  (setq *<Koordpunkt-z* (cond ((getint (strcat "\nFill up with leading zeros up to <" (itoa *<Koordpunkt-z*) "> place: "))) (*<Koordpunkt-z*))) ; uncomment this line to ask the user

    
  (setq enlast (entlast))
  
  (while (progn
           (initget "Undo")
           (setq pnt (getpoint (strcat "\nEinfügepunkt angeben für '" (setq txt (strcat *<Koordpunkt-g* (:AddLeadingZeros (itoa *<Koordpunkt-i*) *<Koordpunkt-z*))) "' [Undo] <exit>: "))))
    (if (= pnt "Undo")
      (progn
        (if (equal enlast (entlast))
          (alert "Alle eingefügten Punkte gelöscht!")
          (progn
            (setq enl (entlast))
            (command "_.UNDO" 1)
            (if (not (equal enl (entlast)))
              (setq *<Koordpunkt-i* (1- *<Koordpunkt-i*))))))
      (progn
        (command "_.-INSERT" "SPI-Datenextraktionspunkt-CM" "_none" pnt 1 1 "" txt "")
        (setq *<Koordpunkt-i* (1+ *<Koordpunkt-i*)))))
  ) ; end of defun

 

Message 64 of 64

C.Utzinger
Collaborator
Collaborator

Thank you very much!

 

It took me a while to incorporate it in the main Routine, but now it's perfect!

 

BFU Smiley LOL, very good!

 

 

Best regards!

0 Likes