Selezionare elementi ed aggiungere dei file estesi

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#1
Salve a tutti,
ho davanti a me un disegno aperto con diversi elementi, vorrei selezionare solo i cerchi di colore rosso ed attaccare a questi diversi, dico io, records comunque delle stringhe di dati.

Ho letto che è possibile ottenere questo risultato tramite i file estesi, ne so poco in materia, cerco un aiuto!

P.S: ho cominciato con questo : (setq a (ssget "_X" '((0 . "CIRCLE"))))

Grazie.
 

Cristallo

Utente Standard
Professione: Leggo e confronto
Software: Lettura critica
Regione: Fuori dalla cerchia
#2
comincia con questo:
(setq RED_circle (ssget "_X" '((0 . "CIRCLE")(62 . 1))))

O queto se vuoi associare più tipi di elemento
(setq RED_circleorline (ssget "X" '((-4 . "<OR") (0 . "circle")(0 . "line")(-4 . "OR>")(62 . 1))))
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#3
Grazie,
da come ho compreso "ssget" si occupa di selezionare tutti i di colore rosso (62.1).
Immagino che l'istruzione crei il gruppo "RED_circle"
Ora, agli elementi del gruppo, devo associare delle stringhe del tipo "Nome", "Coordinata", ........
Vorrei che poi selezionando una entità del gruppo creato, possa riavere le stringhe associate.
Questa seconda parte mi è più chiara, la prima .....
Grazie.
.
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#4
Il file <xData testo.lsp> contiene due funzioni di base per inserire o leggere una stringa da "file estesi" o preferibilmente chiamati xdata.

(if (not (tblsearch "APPID" "miaApp"))
(regapp "miaApp")
)
questa serve a definire il nome dell'applicazione a cui faranno riferimento le due funzioni; è anche il nome dell'app memorizzata nelle entità; più app possono aggiungere dati alla stessa entità. Per ora non perderci troppo tempo e parti da questo presupposto, con la pratica sarà più semplice.

(AddxData NomeEntità StringaDiTesto)
richiamando la funzione e passando i due parametri memorizzerai la stringa.

(setq testo (fnReadxData NomeEntità))
memorizzi nella variabile testo il contenuto di xdata.

Queste routine sono fatte per scrivere o leggere una sola stringa di testo; è possibile espandere la quantità di dati a più stringhe, numeri, coordinate, etc.

Bye
 

Allegati

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#5
Grazie rpor66,
ho letto i tuoi files, avevo appena scritto questi
Codice:
(defun C:CREXT (/)

    (setq Gruppo (getstring "\nNome dek Gruppo >> : "))
      
    (regapp Gruppo)

    (setq oldlist (entget (car (entsel))))     

)

-------------------------

(defun C:DEFINISCIEXT (/)

    (setq oldlist (entget (car (entsel))))

    ;(setq thedata '((-3 ("AFRALISP" (1000 . "Kenny is handsome") (1000 . "And intelligent")))))
    (setq thedata '((-3 (Gruppo (1000 . "Primo") (1000 . "Secondo")))))

    (entmod newlist)

)

-------------------------

(defun C:ESTRAIEXT (/)

    (setq elist (entget (car (entsel))))

)
Il mio problema consiste nel selezionare tutte le entità (cerchi di colore rosso) presenti nel DWG col programmino "DEFINISCIEXT".
Grazie.
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#6
Ho tralasciato di dire che le stringhe da associare (definite Primo e Secondo nel programmino) sono presenti nel DWG accanto ai cerchi di colore rosso (sono state definite da un "dxf")
Quindi dovrei estrarre dalla stringa, le sottostringhe.
Penso che la cosa migliore sia includere nella stringa le coordinate del cerchio, quindi selezionare le stringhe anziché i cerchi.
Oppure estrarre le coordinate del cerchio conoscendo la sua posizione rispetto alla stringa o il contrario.
Se arrivo alla selezione multipla delle entità, penso sia poi abbastanza semplice (!).
Grazie
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#7
Il file <xData testo.lsp> contiene due funzioni di base per inserire o leggere una stringa da "file estesi" o preferibilmente chiamati xdata.

(if (not (tblsearch "APPID" "miaApp"))
(regapp "miaApp")
)
questa serve a definire il nome dell'applicazione a cui faranno riferimento le due funzioni; è anche il nome dell'app memorizzata nelle entità; più app possono aggiungere dati alla stessa entità. Per ora non perderci troppo tempo e parti da questo presupposto, con la pratica sarà più semplice.

(AddxData NomeEntità StringaDiTesto)
richiamando la funzione e passando i due parametri memorizzerai la stringa.

(setq testo (fnReadxData NomeEntità))
memorizzi nella variabile testo il contenuto di xdata.

Queste routine sono fatte per scrivere o leggere una sola stringa di testo; è possibile espandere la quantità di dati a più stringhe, numeri, coordinate, etc.

Bye
Grazie rpor66,
ho proseguito nel cercare di scrivere il codice giusto e sono arrivato a questo :

Codice:
    (defun C:CREAEXTGRUPPO (/ TTT)

        (setvar "OSMODE" 0)

        (setq Oggetto "Gruppo")
        (regapp Oggetto)
        (setq TTT (ssget "_X" '((0 . "TEXT,MTEXT")(1 . "P*"))))

        (repeat (setq n (sslength TTT))
            (setq TT (ssname TTT (setq n (1- n))))

            (setq string (entget TT))
            (setq txt1 (assoc 1 string))
            (setq txt1 (cdr txt1))
            (setq lungh (- (strlen txt1) 60))

            (setq cxy (assoc 10 string))
            (setq cox (cadr cxy))
            (setq coy (caddr cxy))
            ;(command "_erase" TT "")
            (setq coox (rtos cox))
            (setq cooy (rtos coy))
            (setq indirizzo (strcat coox "," cooy))

            (setq NomePunto (substr txt1 2 lungh))
            (setq Ecef (substr txt1 (+ 3 lungh) 34))
            (setq GaussBoaga (substr txt1 (+ 38 lungh) 23))
            (setq oldlist (entget TT))

            (setq thedata '((-3 (Oggetto (1000 . NomePunto) (1000 . Ecef) (1000 . GaussBoaga)))))

            (setq newlist (append oldlist thedata))
            (entmod newlist)
        ); repeat
    ); defun
C'è qualcosa di errato perché quando arriva all'istruzione "(entmod newlist)" , ottengo il messaggio di errore : " ; errore: gruppo DXF errato: (-3 (OGGETTO (1000 . NOMEPUNTO) (1000 . ECEF) (1000 . GAUSSBOAGA)))"

Grazie.
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#8
(setq thedata (list -3 (list Oggetto (cons 1000 nomepunto) (cons 1000 ecef) (cons 1000 gaussboaga))))

Così dovrebbe andare.

Sforzati di assegnare alle variabili nomi che identificano il contenuto:
(setq TT (ssname TTT (setq n (1- n)))) ssname ritorna il nome dell'entita, NomeEntita è preferibile
(setq string (entget TT)) magari sarebbe meglio (setq entita (entget TT)), string sembra contenere del testo

Buon lavoro
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#9
Ho applicato i tuoi suggerimenti, va tutto bene sino all'ultima riga (entmod newlist)
Codice:
(defun C:CREAEXTGRUPPO (/ TTT)

        (setvar "OSMODE" 0)

        (setq Oggetto "Gruppo")
        (regapp Oggetto)
        (setq Stringa (ssget "_X" '((0 . "TEXT,MTEXT")(1 . "P*"))))

        (repeat (setq n (sslength Stringa))
            (setq Entita (ssname Stringa (setq n (1- n))))

            (setq str (entget Entita))
            (setq txt1 (assoc 1 str))
            (setq txt1 (cdr txt1))
            (setq lungh (- (strlen txt1) 60))

            (setq cxy (assoc 10 str))
            (setq cox (cadr cxy))
            (setq coy (caddr cxy))
            ;(command "_erase" Entita "")
            (setq coox (rtos cox))
            (setq cooy (rtos coy))
            (setq indirizzo (strcat coox "," cooy))

            (setq NomePunto (substr txt1 2 lungh))
            (setq Ecef (substr txt1 (+ 3 lungh) 34))
            (setq GaussBoaga (substr txt1 (+ 38 lungh) 23))
            (setq oldlist (entget Entita))

            (setq thedata (list -3 (list Oggetto (cons 1000 NomePunto) (cons 1000 Ecef) (cons 1000 GaussBoaga))))

            (setq newlist (append oldlist thedata))
            (entmod newlist)
        ); repeat
    ); defun
Grazie ancora.
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#10
(setq newlist (append oldlist (list thedata)))
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#11
Ora non dà più errore ma i riferimenti esterni non vengono aggiunti, l'interrogazione del punto con :
Codice:
(defun C:ESTRAIEXT (/)

    (setq elist (entget (car (entsel))))

)
restituisce questo :

Selezionare oggetto: ((-1 . <Nome entità: 18a2e4fde90>) (0 . "TEXT") (330 . <Nome entità: 18a2e4fcef0>) (5 . "E1") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "testo") (62 . 1) (100 . "AcDbText") (10 1.49854e+06 5.04247e+06 0.0) (40 . 0.4) (1 . "Pr4 (165.70)-4420582.301,698643.144,4529392.219#1498537.710,5042473.117") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0))

come vedi la voce 1000 non compare, tanto meno "Gruppo".

Codice:
(defun C:CREAEXTGRUPPO (/ TTT)

        (setvar "OSMODE" 0)

        (setq Oggetto "Gruppo")
        (regapp Oggetto)
        (setq Stringa (ssget "_X" '((0 . "TEXT,MTEXT")(1 . "P*"))))

        (repeat (setq n (sslength Stringa))
            (setq Entita (ssname Stringa (setq n (1- n))))

            (setq str (entget Entita))
            (setq txt1 (assoc 1 str))
            (setq txt1 (cdr txt1))
            (setq lungh (- (strlen txt1) 60))

            (setq cxy (assoc 10 str))
            (setq cox (cadr cxy))
            (setq coy (caddr cxy))
            ;(command "_erase" Entita "")
            (setq coox (rtos cox))
            (setq cooy (rtos coy))
            (setq indirizzo (strcat coox "," cooy))

            (setq NomePunto (substr txt1 2 lungh))
            (setq Ecef (substr txt1 (+ 3 lungh) 34))
            (setq GaussBoaga (substr txt1 (+ 38 lungh) 23))
            (setq oldlist (entget Entita))

            (setq thedata (list -3 (list Oggetto (cons 1000 NomePunto) (cons 1000 Ecef) (cons 1000 GaussBoaga))))

            (setq newlist (append oldlist (list thedata)))
            (entmod newlist)
        ); repeat
    ); defun
Non finirò mai di ringraziarti!
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#12
Scusa l'assenza, casini con nuovo pc, un po' di sfiga non guasta mai.
Per valutare la validità della routine devi allegare uno stralcio del dwg che usi.
Bye
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#15
Ciao rpor66 e ciao a tutti,
leggendo e rileggendo il codice e imparando sempre un po' di più, ho corretto i programmini, ed ora, tutto sembra funzionare come volevo.
Codice di creazione del Gruppo >>> :
Codice:
(defun C:CREAEXTGRUPPO (/ TTT)

        (setvar "OSMODE" 0)

        (setq Oggetto "Gruppo")
        (regapp Oggetto)
        (setq Stringa (ssget "_X" '((0 . "TEXT,MTEXT")(1 . "P*"))))

        (repeat (setq N (sslength Stringa))
            (setq Entita (ssname Stringa (setq N (1- N))))

            (setq Testo (entget Entita))
            (setq Txt1 (assoc 1 Testo))
            (setq Txt1 (cdr Txt1))
            (setq Lungh (- (strlen Txt1) 60))

            (setq NomePunto (substr Txt1 2 Lungh))
            (setq Ecef (substr Txt1 (+ 3 Lungh) 34))
            (setq GaussBoaga (substr Txt1 (+ 38 Lungh) 23))
            (setq OldList (entget Entita))

            (setq TheData (list -3 (list Oggetto (cons 1000 NomePunto) (cons 1000 Ecef) (cons 1000 GaussBoaga))))

            (setq NewList (append Testo (list TheData)))
            (entmod NewList)
        ); repeat
    ); defun
Codice di estrazione dei dati attaccati al Gruppo >>> :
Codice:
(defun C:ESTRAIEXT (/)

    (setq Lista (entget (car (entsel)) '("Gruppo")))
    (setq Xlist (assoc -3 Lista))
    (setq TxtData (car (cdr Xlist)))
    (setq NomePunto (cdr (nth 1 TxtData)))
    (setq Ecef (cdr (nth 2 TxtData)))
    (setq GaussBoaga (cdr (nth 3 TxtData)))

    (princ "\n")
    (princ NomePunto)
    (princ "\n")
    (princ Ecef)
    (princ "\n")
    (princ GaussBoaga)
    (princ "\n")

)
Sono sicuro che avrò ancora bisogno di Voi tutti, grazie.
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#16
Ho verificato usando dwg e lisp da te creati, funziona.
Non ho capito però il senso, associare al testo delle informazioni già presenti nel testo; le devi associare ai cerchi?
Memorizzi le coordinate come stringhe, usando il 1011 puoi memorizzarlo come coordinata.
Questo è un riepilogo dei codici utilizzabili:
;Data Type Code Description
;String 1000 A string of up to 255 characters.
;Application Name 1001 An Application Name.
;Layer Name 1003 The name of a Layer.
;DataBase Handle 1005 The handle of an entity.
;3D Point 1010 A 3D Coordinate value.
;Real 1040 A real value.
;Integer 1070 A 16 bit integer (signed or unsigned).
;Long 1071 A 32 bit signed (long) integer.
;Control String 1002 A control code to set off nested list.
;World Space Position 1011 A 3D coordinate point that is moved, scaled rotated, streched and mirrored along with the entity.
;World Space Displacement 1012 A 3D coordinate point that is scaled, rotated or mirrored along with the entity. It cannot be stretched.
;World Space Direction 1013 A 3D coordinate point that is rotated or mirrored along with the entity. It cannot be scaled, streched or moved.
;Distance 1041 A real value that is scaled along with the entity. Used for distance.
;Scale Factor 1042 A real value that is scaled along with the entity. Used as a scale factor.


Bye
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#17
Ho seguito il tuo suggerimento, ora estraggo le coordinate piane dalla selezione ma non riesco a modificare il testo selezionato, :
Codice:
(defun C:PUNTOGp (/ Oggetto Stringa N Entita Testo Txt1 Lungh TheData NewList NP)

        (setvar "OSMODE" 0)
        (setq StatoRilievo 0)

        (setq Oggetto "Gruppo")
        (regapp Oggetto)
        (setq Stringa (ssget "_X" '((0 . "TEXT,MTEXT")(1 . "P*"))))

        (repeat (setq N (sslength Stringa))
            (setq Entita (ssname Stringa (setq N (1- N))))

            (setq Testo (entget Entita))
            (setq Txt1 (assoc 1 Testo))
            (setq Txt1 (cdr Txt1))
            (setq Lungh (- (strlen Txt1) 36))
            (setq XYZ (assoc 10 Testo))
            (setq PrimoDato ???????)

            (princ "Testo >>>>>>>>>>>>>  ")
            (princ Testo)
            (princ "\n")
            (princ "Txt1 >>>>>>>>>>>>>  ")
            (princ Txt1)

            (setq GaussBoaga (strcat (rtos (cadr XYZ)) "," (rtos (caddr XYZ))))
            (princ GaussBoaga)
            (princ "\n")
            (princ Testo)
            (princ "\n")                   

            (setq NomePunto (substr Txt1 2 (- Lungh 1)))
            (princ NomePunto)
            (princ "\n")
            (setq Ecef (substr Txt1 (+ 2 Lungh) 35))
            (princ Ecef)
            (princ "\n")
            (setq ControlloStz ".")
            (setq ControlloPt ".")

            (setq OldList (entget Entita))
            (setq TheData (list -3 (list Oggetto (cons 1000 NomePunto) (cons 1000 Ecef) (cons 1000 GaussBoaga) (cons 1000 ControlloStz) (cons 1000 ControlloPt))))
            (princ "TheData >>>>>> ")
            (princ TheData)
            (princ "\n")
            (princ "---------------------")
            (princ "\n")

            (setq NewList (append OldList (list TheData)))
            (entmod NewList)

            (command "_change" PrimoDato "" "" "" "" "" "" NomePunto)
       );repeat

        (setq StatoRilievo 1)
        (command "_STYLE" "ARIAL" "ARIAL.TTF" 0 1 0 "" "")
        (alert "Impostazione rilievo eseguita")

    ); defun
Ho messo dei punti interrogativi dove mana l'istruzione.
Grazie.
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#18
Problema risolto!
Questo è il nuovo codice :
Codice:
(defun C:PUNTOGp (/ Oggetto Stringa N Entita Testo Txt1 Txt2 Lungh TheData NewList NP)

        (setvar "OSMODE" 0)
        (setq StatoRilievo 0)

        (setq Oggetto "Gruppo")
        (regapp Oggetto)
        (setq Stringa (ssget "_X" '((0 . "TEXT,MTEXT")(1 . "P*"))))

        (repeat (setq N (sslength Stringa))
            (setq Entita (ssname Stringa (setq N (1- N))))

            (setq Testo (entget Entita))
            (setq Txt1 (assoc 1 Testo))
            (setq Txt2 (cdr Txt1))
            (setq Lungh (- (strlen Txt2) 36))
            (setq XYZ (assoc 10 Testo))

            (princ "Testo >>>>>>>>>>>>>  ")
            (princ Testo)
            (princ "\n")
            (princ "Txt1 >>>>>>>>>>>>>  ")
            (princ Txt1)

            (setq GaussBoaga (strcat (rtos (cadr XYZ)) "," (rtos (caddr XYZ))))
            (princ "\n")
            (princ GaussBoaga)
            (princ "\n")
            (princ Testo)
            (princ "\n")                   

            (setq NomePunto (substr Txt2 2 (- Lungh 1)))
            (princ NomePunto)
            (princ "\n")
            (setq Ecef (substr Txt2 (+ 2 Lungh) 35))
            (princ Ecef)
            (princ "\n")
            (setq CStz "1")
            (setq CPt "2")

            (setq OldList (entget Entita))
            (setq TheData (list -3 (list Oggetto (cons 1000 NomePunto) (cons 1000 Ecef) (cons 1000 GaussBoaga) (cons 1000 CStz) (cons 1000 CPt))))
            (princ "TheData >>>>>> ")
            (princ TheData)
            (princ "\n")
            (princ "---------------------")
            (princ "\n")

            (setq NewList (append OldList (list TheData)))
            (entmod NewList)

            (command "_change" Entita "" "" "" "" "" "" NomePunto)
       );repeat

        (setq StatoRilievo 1)
        (command "_STYLE" "ARIAL" "ARIAL.TTF" 0 1 0 "" "")
        (alert "Impostazione rilievo eseguita")

    ); defun
Ora ho un nuovo quesito :
Vorrei sostituire il 4° ed il 5° elemento della Lista, ora definiti rispettivamente come "1" e "2" in "Ok1" e "OK2".
Ho tentato con questa istruzione (e molte altre) ma non funziona :
Codice:
(defun C:FINALE (/ FC3 Controllo7 Controllo5 Lista Txt1 NomeEntita Xlist PrimoDato TxtData NomePunto Ecef GaussBoaga Controllo2 fp2)

    (if (= Primariga nil)
        (progn
        (alert "Devi prima definire il Vertice Iniziale (Baseline)")
            (exit)
        )
    )

    (setq FC3 (findfile "C:\\AutocadSupporto\\Note\\Nota.dat"))

    (if FC3
        (vl-file-delete "C:\\AutocadSupporto\\Note\\Nota.dat")
    )

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

    (setq Controllo7 nil)
    (setq Controllo7 (findfile "C:\\AutocadSupporto\\Contatori\\Counter.dat"))

    (if (= Controllo7 "C:\\AutocadSupporto\\Contatori\\Counter.dat")
        (progn
            (setq fp4 (open "C:\\AutocadSupporto\\Contatori\\Counter.dat" "r"))
                (setq Count (read-line fp4))
                (setq Passo (read-line fp4))
            (close fp4)
        )
    )

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

    (setq Controllo5 nil)

    (setq Controllo5 (findfile "C:\\AutocadSupporto\\Dati\\DatiRilievo.dat"))

    (if (= Controllo5 "C:\\AutocadSupporto\\Dati\\DatiRilievo.dat")
        (progn
            (setq fp3 (open "C:\\AutocadSupporto\\Dati\\DatiRilievo.dat" "r"))
                (setq DataOdierna (read-line fp3))
                (setq Ora1 (read-line fp3))
                (setq Ora2 (read-line fp3))
                (setq Pdop (read-line fp3))
            (close fp3)
        )
    )

    (startapp "C:\\AutocadSupporto\\Liberty\\Punto.exe " "C:\\AutoCadSupporto\\Liberty\\Punto.tkn")

    (setq Lista nil)
    (while
        (= Lista nil)
        (setq Lista (entget (car (entsel)) '("Gruppo")))
    )

    (princ "\n")
    (princ "Lista  >>>>> ")
    (princ Lista)

    (setq Txt1 (assoc 1 Lista))
    (princ "\n")
    (princ Txt1)
    (princ "\n")

    (setq NomeEntita (assoc -1 Lista))
    (princ "\n")
    (princ NomeEntita)
    (princ "\n")

    (setq Xlist (assoc -3 Lista))
    (princ "\n")
    (princ "Xlist >>>>>>>>> ")
    (princ Xlist)
    (princ "\n")

    (setq PrimoDato (car Txt1))
    (setq TxtData (car (cdr Xlist)))
    (princ "\n")
    (princ "TxtData >>>>>>>>> ")
    (princ TxtData)
    (princ "\n")

    (setq NomePunto (cdr (nth 1 TxtData)))
    (setq Ecef (cdr (nth 2 TxtData)))
    (setq GaussBoaga (cdr (nth 3 TxtData)))
    (setq ControlloStz (cdr (nth 4 TxtData)))
    (setq ControlloPto (cdr (nth 5 TxtData)))

    (princ "\n")
    (princ NomePunto)
    (princ "\n")
    (princ Ecef)
    (princ "\n")
    (princ GaussBoaga)
    (princ "\n")

    (setq Punto nil)
    (setq NotaY nil)

    (setq Controllo2 nil)

    (while (= Controllo2 nil)
         (setq Controllo2 (findfile "C:\\AutocadSupporto\\Note\\Nota.dat"))
    )

    (setq fp2 (open "C:\\AutocadSupporto\\Note\\Nota.dat" "r"))
        (setq Punto (read-line fp2))
        (setq NotaY (read-line fp2))
    (close fp2)

    (princ "\n")
    (princ Punto)
    (princ "\n")
    (princ NotaY)
    (princ "\n")

    (setq CxP (substr Ecef 1 11))
    (setq CyP (substr Ecef 13 11))     ; qui  11
    (setq CzP (substr Ecef 24 11))
    (setq CxPP (atof CxP))
    (setq CyPP (atof CyP))
    (setq CzPP (atof CzP))

    (princ "\n")
    (princ "CxP >>>>>>>>>>> ")
    (princ "\n")
    (princ CxP)
    (princ "\n")
    (princ "CyP >>>>>>>>>>> ")
    (princ "\n")
    (princ CyP)
    (princ "\n")
    (princ "CzP >>>>>>>>>>> ")
    (princ "\n")
    (princ CzP)
    (princ "\n")

    (princ "\n")
    (princ "CxBB >>>>>>>>>>> ")
    (princ "\n")
    (princ CxBB)
    (princ "\n")
    (princ "CyBB >>>>>>>>>>> ")
    (princ "\n")
    (princ CyBB)
    (princ "\n")
    (princ "CzBB >>>>>>>>>>> ")
    (princ "\n")
    (princ CzBB)

    (setq DiffX (* -1 (- CxBB CxPP)))
    (setq DiffY (* -1 (- CyBB CyPP)))
    (setq DiffZ (* -1 (- CzBB CzPP)))

    (setq DiffXX (rtos DiffX))
    (setq DiffYY (rtos DiffY))
    (setq DiffZZ (rtos DiffZ))
    (setq xxyyzz (strcat DiffXX "," DiffYY "," DiffZZ))

    (setq Nota2 (strcat NomePunto " - " NotaY " - " Punto))
    (setq Riga (strcat "2|" Punto "|" xxyyzz "|0,0,0,0,0,0|PDOP=" Pdop "|0.000|" Nota2 "|"))

    (setq fp1 (open "C:\\AutocadSupporto\\Libretto\\LibrettoPregeo.dat" "a"))
        (write-line Riga fp1)
    (close fp1)

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

    (command "_circle" GaussBoaga "0.15")
    (setq NewText (strcat " " Punto " - " NomePunto))   
    (command "_change" PrimoDato "" "" "" "" "" "" NewText)

    (princ "\n")
    (princ "Count >>>>>>>>>>> ")
    (princ Count)
    (princ "\n")
    (princ "Passo >>>>>>>>>>> ")
    (princ Passo)
    (princ "\n")
    (princ "Punto >>>>>>>>>>> ")
    (princ Punto)
    (princ "\n")

    (setq Count1 (atoi Count))
    (setq PuntoN (atoi Punto))

    (if (= PuntoN (+ Count1 (atoi Passo)))
        (progn
            (setq Count2 (+ Count1 10))
            (setq Count3 (itoa Count2))
        )
        (setq Count3 Count)
    )

    (setq fp4 (open "C:\\AutocadSupporto\\Contatori\\Counter.dat" "w"))
        (write-line Count3 fp4)
        (write-line Passo fp4)
    (close fp4)

    (setq Indice (strcat Indice NomePunto))

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

    (subst "OK"  ControlloStz Xlist)
    (subst "OK"  ControlloPto Xlist)
    (entmod Lista)

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

    (alert "Dati del Vertice Finale salvati")

    ) ; fine procedura FINALE
Le linee (subst "OK" ControlloStz Xlist) e (subst "OK" ControlloPto Xlist) sono state oggetto di innumerevoli variazioni, nessuna cambia il 4° ed il 5° elemento rispettivamente (1000 . 1) e (1000 . 2).
Grazie.
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#19
(setq lista (subst (cons 10 NewPt) (cons 10 OldPt) lista))
Questo è la sintassi da utilizzare nella sostituzione.
Appena ho un attimo vedo di postarti il codice relativo al tuo programma.
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#20
Grazie rpot66,
preciso come sempre!
Nell'ultimo codice che ho postato, c'è la funzione
Codice:
(setq NewText (strcat " " Punto " - " NomePunto))   
    (command "_change" PrimoDato "" "" "" "" "" "" NewText)
che dovrebbe cambiare il contenuto della stringa esistente con quello nuovo, dovrebbe perché, dopo un periodo in cui funzionava, ora non funziona più, io non ho cambiato il codice!
Voglio cambiare il contenuto della stringa e non sostituirlo per non perdere i dati estesi ad esso associati,
in alternativa potrei sostituirla con quella nuova ed associare a quest'ultima i dati estesi.
Trovo, se funzionasse, più semplice cambiare e mantenere.
Grazie, Angelo2449.