lisp modifica valore dentro blocchi con attributo

lisp modifica valore dentro blocchi con attributo

oberti-carlo
Contributor Contributor
329 Views
1 Reply
Message 1 of 2

lisp modifica valore dentro blocchi con attributo

oberti-carlo
Contributor
Contributor

Buongiorno, non ho mai programmato in lisp quindi ho chiesto a chatGPT di farlo, allego il risultato, che funziona.

 

Una volta caricato, con il comando "numatt" si esegue il lisp.

 

In aggiunta sarebbe comodo se dopo aver aver selazionato i blocchi riportasse un elenco di tutti gli attributi all'interno del blocco, ho provato a farlo fare a chatGPT ma non riesce e continua a darmi errore, voi sapreste come fare?

 

Di seguito il tentativo andato a male:

 

 

(defun c:NumAttr (/ ss tag startNum sortedList i ent d pt y count pair att attData newVal tagList tagVal firstBlock)
  (vl-load-com)
  
  ;; Seleziona tutti gli INSERT (blocchi) presenti
  (setq ss (ssget '((0 . "INSERT"))))
  (if (null ss)
    (progn
      (princ "\nNessun blocco selezionato.")
      (exit)
    )
  )

  ;; Recupera il primo blocco per estrarre i tag degli attributi
  (setq firstBlock (ssname ss 0))
  (setq tagList '())
  (setq att (entnext firstBlock))
  (while (and att (eq (cdr (assoc 0 (entget att))) "ATTRIB"))
    (setq attData (entget att))
    (setq tagVal (cdr (assoc 2 attData)))
    (if (not (member tagVal tagList))
      (setq tagList (cons tagVal tagList))
    )
    (setq att (entnext att))
  )
  
  (if (null tagList)
    (progn
      (princ "\nIl blocco selezionato non contiene attributi.")
      (exit)
    )
  )
  
  ;; Visualizza la lista dei tag attributo disponibili (in ordine di lettura)
  (princ "\nTag attributo disponibili nel blocco:")
  (foreach t (reverse tagList)
    (princ (strcat "\n - " t))
  )
  
  ;; Chiede all'utente di scegliere il tag da modificare
  (setq tag (getstring "\nInserisci il tag dell'attributo da modificare: "))
  
  ;; Richiede il numero iniziale per la numerazione
  (setq startNum (getint "\nInserisci il numero iniziale: "))
  (setq count startNum)
  
  ;; Crea una lista dei blocchi con le relative coordinate Y
  (setq sortedList '())
  (setq i 0)
  (while (< i (sslength ss))
    (setq ent (ssname ss i))
    (setq d (entget ent))
    (setq pt (assoc 10 d))  ;; La coordinata d'inserimento è nel gruppo 10
    (if pt
      (progn
        (setq y (cadr pt))   ;; Y è il secondo elemento della lista
        (setq sortedList (cons (list y ent) sortedList))
      )
    )
    (setq i (1+ i))
  )
  
  ;; Ordina la lista in base alla coordinata Y (dal basso verso l’alto)
  (setq sortedList (vl-sort sortedList (function (lambda (a b)
                                                    (< (car a) (car b))))))
  
  ;; Scorre ciascun blocco ordinato e modifica il valore dell'attributo scelto
  (foreach pair sortedList
    (setq ent (cadr pair))
    ;; Gli attributi del blocco sono generalmente immediatamente dopo l'INSERT
    (setq att (entnext ent))
    (while (and att (equal (cdr (assoc 0 (entget att))) "ATTRIB"))
      (setq attData (entget att))
      ;; Se il tag (gruppo 2) corrisponde a quello scelto (case insensitive)
      (if (equal (strcase (cdr (assoc 2 attData))) (strcase tag))
        (progn
          (setq newVal (itoa count))
          (setq attData (subst (cons 1 newVal) (assoc 1 attData) attData))
          (entmod attData)
          (entupd att)
        )
      )
      (setq att (entnext att))
    )
    (setq count (1+ count))
  )
  
  (princ "\nAttributi aggiornati.")
  (princ)
)

 

0 Likes
330 Views
1 Reply
Reply (1)
Message 2 of 2

Sea-Haven
Mentor
Mentor

I had to convert to english to work out what was being asked, but found this problem, there may be more.

 

 

(setq d (entget ent))
    (setq pt (assoc 10 d)) ;; The insertion coordinate is in group 
this returns (10 9832.123 5038.456 0.0)


(setq pt (cdr (assoc 10 d)))
returns (9832.123 5038.456 0.0) which is what you want.

 

 

0 Likes