Selezionare elementi ed aggiungere dei file estesi

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#21
Sono ancora qui,
ho applicato :
Codice:
(setq ListaUno (subst (cons 1000 "OK1") (cons 1000 "1") (cons 1000 "OK2") (cons 1000 "2") Lista))
    (entmod ListaUno)
e ottengo il messaggio di errore :"troppi argomenti".
Grazie.
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#22
(setq Lista (subst (cons 1000 "OK1") (cons 1000 "1") Lista))
(setq Lista (subst (cons 1000 "OK2") (cons 1000 "2") Lista))
(entmod Lista)

Uno alla volta
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#23
Avevo già provato questa soluzione ma non funziona il 4° e 5° dato non vengono cambiati, non c'è errore.
Succede poi che se inserisco le tre istruzioni, il nome del punto non viene cambiato altrimenti si!
Questo è il codice :
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 "PrimoDato >>>>>>>>> ")
    (princ PrimoDato)
    (princ "\n")
    (princ "NewText >>>>>>>>>>> ")
    (princ NewText)

    (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))

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

    (setq ListaUno (subst (cons 1000 "OK1") (cons 1000 "1") Lista))
    (setq ListaUno (subst (cons 1000 "OK2") (cons 1000 "2") Lista))
    (entmod ListaUno)

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

    (alert "Dati del Vertice Finale salvati")

    ) ; fine procedura FINALE
Succede anche che se la selezione del Punto avviene con uno zoom ravvicinato, il nome del Punto non viene cambiato.
Avevo inserito l'istruzione (setvar "osmode" 0) ma non influisce, il problema rimane.
Grazie.
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#24
Ho dimenticato di dire che ho inserto le istruzioni
Codice:
    (setq ListaUno (subst (cons 1000 "OK1") (cons 1000 "1") Lista))
    (setq ListaUno (subst (cons 1000 "OK2") (cons 1000 "2") Lista))
    (entmod ListaUno)
come
Codice:
    (setq Lista (subst (cons 1000 "OK1") (cons 1000 "1") Lista))
    (setq Lista (subst (cons 1000 "OK2") (cons 1000 "2") Lista))
    (entmod Lista)
ma il risultato è identico.
Ho anche tolto la variabile "Lista" dalla dichiarazione iniziale, niente!
Ti invio tutti i files compreso il file dwg.
Grazie
 

Allegati

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#25
Scusami, correndo non mi sono accorto che subst lo applicavi ai dati delle entità estese.
Per modificarle segui questi passi:

- Ti leggi i dati e memorizzi i dati estesi
(setq Lista (entget (car (entsel)) '("Gruppo")))
(setq xd_ent (cdr (assoc -3 Lista)))

- il tratto di codice
(setq Lista (subst (cons 1000 "OK1") (cons 1000 "1") Lista))
(setq Lista (subst (cons 1000 "OK2") (cons 1000 "2") Lista))

lo sostituisci con la riconfigurazione dei dati estesi; leggi i dati, modifichi i valori delle variabili e ricomponi la lista (è un esempio, non ho la tua parte di codice dove leggi i dati):
(setq nList (list (list "Gruppo" (cons 1000 txt1) (cons 1000 txt2) (cons 1040 dEL))))
(setq Lista (subst (cons -3 nList) (cons -3 xd_ent) Lista))
(entmod Lista)

praticamente modifichi in un colpo solo tutta la sottolista dei dati estesi, identificata da -3.
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#26
Grazie rpor66,
credo di non aver compreso bene, ho applicato, sicuramente sbagliando, i tuoi suggerimenti e ho problemi.
Ancora un po' di pazienza, per favore ;.
Codice:
(defun C:FINALE (/ FC3 Controllo7 Controllo5 Lista Xlist 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")))
        (setq xd_ent (cdr (assoc -3 Lista)))
    )

    (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 "PrimoDato >>>>>>>>> ")
    (princ PrimoDato)
    (princ "\n")
    (princ "NewText >>>>>>>>>>> ")
    (princ NewText)

    (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))

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

    (setq nList (list (list "Gruppo" (cons 1000 "Non definito") (cons 1000 NomePunto) (cons 1040 dEL))))
    (setq Lista (subst (cons -3 nList) (cons -3 xd_ent) Lista))
    (entmod Lista)

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

    (alert "Dati del Vertice Finale salvati")

    ) ; fine procedura FINALE
Vedi cosa puoi fare, voglio veramente capire dove sta il problema, grazie.
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#28
Ciao rpor66,
la procedura > Finale < finalmente funziona, ora sto scrivendo questo codice :
Codice:
    (defun C:ARIPO (/ PuntoA PuntoB Raggio Stringa GB GaussBoaga NP NomePunto)

    (setq Punto (car (entsel "\nSeleziona il Punto")))

        (setq Stringa (entget Punto))
        (setq NP (assoc 1 Stringa))
        (setq GB (assoc 10 Stringa))

    (setq GaussBoaga (cdr GB))
    (setq NomePunto (cdr NP))

        (setq Raggio 1.00)

        (setq Ecef "444444444.444,555555555.555,666666666.666")
        (setq Stazione "2000")

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

        (setq xd_ent (cdr (assoc -3 Stringa)))

        (setq Xlist (list (list "Gruppo" (cons 1000 NomePunto) (cons 1000 Ecef) (cons 1000 GaussBoaga) (cons 1000 Stazione) (cons 1000 "Non definito"))))
        (setq Lista (subst (cons -3 Xlist) (cons -3 xd_ent) Lista))

        (entmod Lista)

        ;; ----------------------------------------------------
        
    (princ "\n")
        (princ "Punto >>>>>>>>>> ")
    (princ Punto)
    (princ "\n")

        (princ "Stringa >>>>>>>>>> ")
    (princ Stringa)
    (princ "\n")

        (princ "GaussBoaga >>>>>>>>>> ")
    (princ GaussBoaga)
    (princ "\n")

        (princ "NomePunto >>>>>>>>>> ")
    (princ NomePunto)
    (princ "\n")

        (entdel Punto)
        (command "_erase" GaussBoaga "")
        (command "_circle" GaussBoaga Raggio)

        (setq PosTratt (vl-string-search "-" NomePunto))
        (setq NomePrimoPunto (substr NomePunto (+ PosTratt 3)))
        (princ "NomePrimoPunto >>>>>>>>>>> ")
        (princ NomePrimoPunto)
        (princ "\n")

        (command "_text" GaussBoaga 0.40 0 NomePrimoPunto)
)
Vorrei che il punto che viene selezionato, appartenesse a "Gruppo" e fossero associate le voci elencate in Xlist.
Vorrei, perché il codice, così, non funziona!
Grazie.
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#29
(setq xd_ent (cdr (assoc -3 Stringa)))

(setq Xlist (list (list "Gruppo" (cons 1000 NomePunto) (cons 1000 Ecef) (cons 1000 GaussBoaga) (cons 1000 Stazione) (cons 1000 "Non definito"))))
(setq Lista (subst (cons -3 Xlist) (cons -3 xd_ent) Lista))

1) Estrai la lista dei dati estesi prelevandoli da Stringa (che è la lista originale)
2) Crei la nuova lista
3) Sostituisci la lista dei dati estesi in Lista (che è nil); sostituiscilo con Stringa.
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#30
Grazie,
ora il programmino gira senza errori ma quello che poi mi estrae i dati non funziona, facile capire il perché ma non riesco a porvi rimedio :
Codice:
(defun C:ESTRAIEXT (/ FC3 Lista NomePunto Ecef GaussBoaga ControlloStz ControlloPt)

    (setq FC3 (findfile "C:\\AutocadSupporto\\Estesi\\Esteso.dat"))

    (if FC3
        (vl-file-delete "C:\\AutocadSupporto\\Estesi\\Esteso.dat")
    )

    (setq Lista (entget (car (entsel)) '("Gruppo")))
    (setq Xlist (assoc -3 Lista))

    (if (= Xlist nil)
    (alert "La stringa selezionata non è idonea, non sono associati dati estesi!")
    )

    (setq Ylist (assoc 1 Lista))
    (setq TxtData (car (cdr Xlist)))

    (princ "\n")
    (princ "Xlist   >>>>>> ")
    (princ Xlist)
    (princ "\n")
    (princ "Ylist >>>>>> ")
    (princ Ylist)
    (princ "\n")
    (princ "TxTData >>>>>> ")
    (princ TxtData)
    (princ "\n")

    (setq NomePunto (cdr Ylist))
    (setq Ecef (cdr (nth 2 TxtData)))
    (setq GaussBoaga (cdr (nth 3 TxtData)))
    (setq ControlloStz (cdr (nth 4 TxtData)))
    (setq ControlloPt (cdr (nth 5 TxtData)))

    (setq fp2 (open "C:\\AutocadSupporto\\Estesi\\Esteso.dat" "w"))
    (write-line NomePunto fp2)
    (write-line Ecef fp2)
    (write-line GaussBoaga fp2)
    (write-line ControlloStz fp2)
    (write-line ControlloPt fp2)
    (close fp2)

    (setq Controllo8 nil)
    (while (= Controllo8 nil)
        (setq Controllo8 (findfile "C:\\AutocadSupporto\\Estesi\\Esteso.dat"))
    )

    (if Controllo8
        (startapp "C:\\AutocadSupporto\\Liberty\\Estesi.exe " "C:\\AutoCadSupporto\\Liberty\\Estesi.tkn")
    )
    

)
Grazie.
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#31
Eccomi di nuovo,
ho applicato i tuoi preziosi suggerimenti con grandi risultati ma, questa non ne vuol sapere di funzionare a dovere!
Ho scritto la routine, funziona, poi ho inserito la parte compresa tra le due doppie righe di trattini ed il quarto elemento di TheData non funziona :
Codice:
   (defun C:ACELERIMETRICO2DINPUT (/ FC2 fp1 Controllo1 fp5 fp1 NomePuntoOne NotaOne PuntoCliccato Cx Cy XYZ comment Dist angolo angolostr Lung angolostr GaussBoaga OLdList Np NomePunto TheData NewList)

        (if (= AIUTOICONE 1)
            (progn
            (setq fp1 (open "C:\\AutocadSupporto\\Help\\DatiAiuto.dat" "w"))
            (write-line "Celerimetrico2dInput" fp1)
                (close fp1)
                (startapp "C:\\AutocadSupporto\\Liberty\\AiutoGen.exe " "C:\\AutocadSupporto\\Liberty\\AiutoGen.tkn")
                (exit)
        )
        )

        (setq FC2 (findfile "C:\\AutocadSupporto\\Celerimetrico\\DatiOri.dat"))

        (if FC2
            (vl-file-delete "C:\\AutocadSupporto\\Celerimetrico\\DatiOri.dat")
        )

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

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

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

        (setq PuntoCliccato (getpoint "\nClicca il Punto"))

        (setq Controllo1 nil)
        (while (= Controllo1 nil)
            (setq Controllo1 (findfile "C:\\AutocadSupporto\\Celerimetrico\\DatiOri.dat"))
        )

       (if (= Controllo1 "C:\\AutocadSupporto\\Celerimetrico\\DatiOri.dat")
       (progn
               (setq fp5 (open "C:\\AutocadSupporto\\Celerimetrico\\DatiOri.dat" "r"))
               (setq NomePuntoOne (read-line fp5))
               (setq NotaOne (read-line fp5))
               (close fp5)
       )
       )
      
       (command "_circle" PuntoCliccato 0.15)

       (setq Cx (car PuntoCliccato))
       (setq Cy (cadr PuntoCliccato))

       (setq Cxx (+ Cx 0.00))
       (setq Cyy (+ Cy 0.25))

       (setq XYZ (list Cxx Cyy 0.0))

       (print XYZ)
       (print "\n")

       (command "_text" XYZ 0.40 0 (strcat " " NomePuntoOne))
       (command "_change" "_last" "" "_p" "_c" "_red" "")

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

       (setq NomeEntita (entlast))
       (setq Oggetto "Gruppo")
    
       (if (not (tblsearch "APPID" Oggetto))
           (regapp Oggetto)
       )
 
      (setq OldList (entget NomeEntita))
      (setq GaussBoaga (strcat (rtos Cx) "," (rtos Cy)))

      (setq TheData (list -3 (list Oggetto (cons 1000 NomePuntoOne) (cons 1000 "---------------") (cons 1000 GaussBoaga) (cons 1000 "----------------") (cons 1000 "Definito"))))

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

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

       (command "_line" Punto1 PuntoCliccato "")
       (setq Dist (distance Punto1 PuntoCliccato))

       (setq angolo (- organg (angle Punto1 PuntoCliccato)))
       (if (< angolo 0 ) (setq angolo (+ (* 2 pi) angolo)))
       (setq angolostr (angtos angolo 2 4))
       (setq Lung (- (strlen angolostr) 1))
       (setq angolostr (substr angolostr 1 lung))

       (setq comment NotaOne)

       (setq fp2 (open "C:\\AutocadSupporto\\Libretto\\LibrettoPregeo.dat" "a"))
    
       (if (= comment "")
           (setq txtoutldue (strcat "2|" NomePuntoOne "|" angolostr "|" (rtos Dist 2 3) "|"))
           (setq txtoutldue (strcat "2|" NomePuntoOne "|" angolostr "|" (rtos Dist 2 3) "|" comment "|"))
       )

       (write-line txtoutldue fp2)
       (close fp2)
        
       (alert "Dati del Punto Orizzontale memorizzati")
       (princ "\n")

   ) ;; fine comando CELERIMETRICO2DINPUT
Ottengo questo messaggio di errore :

Comando: ; errore: gruppo DXF errato: (-3 ("Gruppo" (1000 . " 1060") (1000 . "---------------") (1000 . "1498792.8525,5042429.7398") (1000) (1000 . "Definito")))

dove il quarto elemento, anziché "----------------", è niente!
Lisp = disperazione!
Grazie.
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#32
Eccomi di nuovo,
ho applicato i tuoi preziosi suggerimenti con grandi risultati ma, questa non ne vuol sapere di funzionare a dovere!
Ho scritto la routine, funziona, poi ho inserito la parte compresa tra le due doppie righe di trattini ed il quarto elemento di TheData non funziona :
Codice:
   (defun C:ACELERIMETRICO2DINPUT (/ FC2 fp1 Controllo1 fp5 fp1 NomePuntoOne NotaOne PuntoCliccato Cx Cy XYZ comment Dist angolo angolostr Lung angolostr GaussBoaga OLdList Np NomePunto TheData NewList)

        (if (= AIUTOICONE 1)
            (progn
            (setq fp1 (open "C:\\AutocadSupporto\\Help\\DatiAiuto.dat" "w"))
            (write-line "Celerimetrico2dInput" fp1)
                (close fp1)
                (startapp "C:\\AutocadSupporto\\Liberty\\AiutoGen.exe " "C:\\AutocadSupporto\\Liberty\\AiutoGen.tkn")
                (exit)
        )
        )

        (setq FC2 (findfile "C:\\AutocadSupporto\\Celerimetrico\\DatiOri.dat"))

        (if FC2
            (vl-file-delete "C:\\AutocadSupporto\\Celerimetrico\\DatiOri.dat")
        )

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

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

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

        (setq PuntoCliccato (getpoint "\nClicca il Punto"))

        (setq Controllo1 nil)
        (while (= Controllo1 nil)
            (setq Controllo1 (findfile "C:\\AutocadSupporto\\Celerimetrico\\DatiOri.dat"))
        )

       (if (= Controllo1 "C:\\AutocadSupporto\\Celerimetrico\\DatiOri.dat")
       (progn
               (setq fp5 (open "C:\\AutocadSupporto\\Celerimetrico\\DatiOri.dat" "r"))
               (setq NomePuntoOne (read-line fp5))
               (setq NotaOne (read-line fp5))
               (close fp5)
       )
       )
     
       (command "_circle" PuntoCliccato 0.15)

       (setq Cx (car PuntoCliccato))
       (setq Cy (cadr PuntoCliccato))

       (setq Cxx (+ Cx 0.00))
       (setq Cyy (+ Cy 0.25))

       (setq XYZ (list Cxx Cyy 0.0))

       (print XYZ)
       (print "\n")

       (command "_text" XYZ 0.40 0 (strcat " " NomePuntoOne))
       (command "_change" "_last" "" "_p" "_c" "_red" "")

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

       (setq NomeEntita (entlast))
       (setq Oggetto "Gruppo")
   
       (if (not (tblsearch "APPID" Oggetto))
           (regapp Oggetto)
       )

      (setq OldList (entget NomeEntita))
      (setq GaussBoaga (strcat (rtos Cx) "," (rtos Cy)))

      (setq TheData (list -3 (list Oggetto (cons 1000 NomePuntoOne) (cons 1000 "---------------") (cons 1000 GaussBoaga) (cons 1000 "----------------") (cons 1000 "Definito"))))

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

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

       (command "_line" Punto1 PuntoCliccato "")
       (setq Dist (distance Punto1 PuntoCliccato))

       (setq angolo (- organg (angle Punto1 PuntoCliccato)))
       (if (< angolo 0 ) (setq angolo (+ (* 2 pi) angolo)))
       (setq angolostr (angtos angolo 2 4))
       (setq Lung (- (strlen angolostr) 1))
       (setq angolostr (substr angolostr 1 lung))

       (setq comment NotaOne)

       (setq fp2 (open "C:\\AutocadSupporto\\Libretto\\LibrettoPregeo.dat" "a"))
   
       (if (= comment "")
           (setq txtoutldue (strcat "2|" NomePuntoOne "|" angolostr "|" (rtos Dist 2 3) "|"))
           (setq txtoutldue (strcat "2|" NomePuntoOne "|" angolostr "|" (rtos Dist 2 3) "|" comment "|"))
       )

       (write-line txtoutldue fp2)
       (close fp2)
       
       (alert "Dati del Punto Orizzontale memorizzati")
       (princ "\n")

   ) ;; fine comando CELERIMETRICO2DINPUT
Ottengo questo messaggio di errore :

Comando: ; errore: gruppo DXF errato: (-3 ("Gruppo" (1000 . " 1060") (1000 . "---------------") (1000 . "1498792.8525,5042429.7398") (1000) (1000 . "Definito")))

dove il quarto elemento, anziché "----------------", è niente!
Lisp = disperazione!
Grazie.
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#33
Hai provato a spegnere gli osnap? Abituati a verificare, ogni volta che disegni qualcosa a schermo, la necessità di avere gli osnap attivati.
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#34
Grazie rpor,
devo settare "osnap" a zero o cosa?
un'altra domanda, non riesco a far funzionare questa routine, ricevo sempre il messaggio "argomento errato" :
Codice:
(defun C:ESTRAIEXT (/ FC3 Lista NomePunto Ecef GaussBoaga ControlloStz ControlloPt NomeX)

    (if (= Primariga nil)
        (progn
        (alert "Devi prima preparare il rilievo con > PREPARAPUNTI <")
            ;(exit)
        )
    )

    (setq FC3 (findfile "C:\\AutocadSupporto\\Estesi\\Esteso.dat"))

    (if FC3
        (vl-file-delete "C:\\AutocadSupporto\\Estesi\\Esteso.dat")
    )

    (setq Lista (entget (car (entsel)) '("Gruppo")))

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

    (setq Xlist (assoc -3 Lista))

    (if (= Xlist nil)
    (alert "La stringa selezionata non è idonea, non sono associati dati estesi!")
    )

    (setq Ylist (assoc 1 Lista))
    (setq TxtData (car (cdr Xlist)))

    (princ "\n")
    (princ "Xlist   >>>>>> ")
    (princ Xlist)
    (princ "\n")
    (princ "Ylist >>>>>> ")
    (princ Ylist)
    (princ "\n")
    (princ "TxTData >>>>>> ")
    (princ TxtData)
    (princ "\n")

    (setq NomeX (cdr (nth 1 TxtData)))
    (setq TipoPunto (cdr (nth 2 TxtData)))
    (setq Quota (cdr (nth 3 TxtData)))
    (setq Ecef (cdr (nth 4 TxtData)))
    (setq GaussBoaga (cdr (nth 5 TxtData)))
    (setq ControlloStz (cdr (nth 6 TxtData)))
    (setq ControlloPt (cdr (nth 7 TxtData)))

    (setq fp2 (open "C:\\AutocadSupporto\\Estesi\\Esteso.dat" "w"))
    (write-line NomeX fp2)
        (write-line TipoPunto fp2)
        (write-line Quota fp2))
    (write-line Ecef fp2)
    (write-line GaussBoaga fp2)
    (write-line ControlloStz fp2)
    (write-line ControlloPt fp2)
    (close fp2)

    (setq Controllo8 nil)
    (while (= Controllo8 nil)
        (setq Controllo8 (findfile "C:\\AutocadSupporto\\Estesi\\Esteso.dat"))
    )

    (if Controllo8
        (startapp "C:\\AutocadSupporto\\Liberty\\Estesi.exe " "C:\\AutoCadSupporto\\Liberty\\Estesi.tkn")
    )
    

)
il problema risiede sicuramente nella definizione dei 7 parametri di "TxtData" non comprendo il motivo.
Uso questa routine dopo aver eseguito questa'altra :
Codice:
(defun C:PREPARAPUNTI (/ Oggetto Stringa N Entita Testo Txt1 Txt2 Lungh TheData NewList NomePunto TipoPunto QuotaSlm NomeX)

        (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 NomePunto (cdr Txt1))

            (setq PosPar (vl-string-search "(" NomePunto))
            (setq NomeX (substr NomePunto 1 (- PosPar 1)))

            (princ "\n")
            (princ "NomeX >>>>> ")
            (princ NomeX)
            (princ "\n")

            (setq Quota (substr NomePunto (+ PosPar 2) 6))

            (princ "\n")
            (princ "Quota >>>>> ")
            (princ Quota)
            (princ "\n")

            (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")                   

            (princ "\n")
            (setq Ecef (substr Txt2 (+ 2 Lungh) 35))
            (princ Ecef)
            (princ "\n")
            (setq TipoPunto "Generico")
            (setq CStz "Non inserita")
            (setq CPt "Non definito")

            (setq OldList (entget Entita))
            (setq TheData (list -3 (list Oggetto (cons 1000 NomeX) (cons 1000 TipoPunto) (cons 1000 Quota) (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 "" "" "" "" "" "" NomeX)
       );repeat

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

    ); defun
Grazie!
 

Angelo2449

Utente Junior
Professione: Pensionato
Software: Autocad
Regione: Lombardia
#35
Sono riuscito a sistemare la routine "EXTRAIEXT", ora funziona, questo è il codice :
Codice:
(defun C:ESTRAIEXT (/ FC3 Lista NomePunto Ecef GaussBoaga ControlloStz ControlloPt NomeX)

    (if (= Primariga nil)
        (progn
        (alert "Devi prima preparare il rilievo con > PREPARAPUNTI <")
            ;(exit)
        )
    )

    (setq FC3 (findfile "C:\\AutocadSupporto\\Estesi\\Esteso.dat"))

    (if FC3
        (vl-file-delete "C:\\AutocadSupporto\\Estesi\\Esteso.dat")
    )

    (setq Lista (entget (car (entsel)) '("Gruppo")))

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

    (setq Xlist (assoc -3 Lista))
    (setq TxtData (car (cdr Xlist)))

    (princ "\n")
    (princ "TxtData   >>>>>> ")
    (princ TxtData)

    (if (= Xlist nil)
    (alert "La stringa selezionata non è idonea, non sono associati dati estesi!")
    )

    (setq Stringa (cdr TxtData))

    (princ "\n")
    (princ "Stringa   >>>>>> ")
    (princ Stringa)

    (setq NomeX (cdr (nth 1 TxtData)))
    (setq NomeX (substr NomeX 2))   
    (setq TipoPunto (cdr (nth 2 TxtData)))
    (setq Quota (cdr (nth 3 TxtData)))
    (setq Ecef (cdr (nth 4 TxtData)))
    (setq GaussBoaga (cdr (nth 5 TxtData)))
    (setq ControlloStz (cdr (nth 6 TxtData)))
    (setq ControlloPt (cdr (nth 7 TxtData)))

    (princ "\n")
    (princ "NomeX   >>>>>> ")
    (princ NomeX)

    (princ "\n")
    (princ "TipoPunto   >>>>>> ")
    (princ TipoPunto)

    (princ "\n")
    (princ "Quota   >>>>>> ")
    (princ Quota)

    (princ "\n")
    (princ "Ecef   >>>>>> ")
    (princ Ecef)

    (princ "\n")
    (princ "GaussBoaga   >>>>>> ")
    (princ GaussBoaga)

    (princ "\n")
    (princ "ControlloStz   >>>>>> ")
    (princ ControlloStz)

    (princ "\n")
    (princ "ControlloPt   >>>>>> ")
    (princ ControlloPt)
    (princ "\n")

    (setq fp2 (open "C:\\AutocadSupporto\\Estesi\\Esteso.dat" "w"))
    (write-line NomeX fp2)
        (write-line TipoPunto fp2)
        (write-line Quota fp2)
    (write-line Ecef fp2)
    (write-line GaussBoaga fp2)
    (write-line ControlloStz fp2)
    (write-line ControlloPt fp2)
    (close fp2)

    (setq Controllo8 nil)
    (while (= Controllo8 nil)
        (setq Controllo8 (findfile "C:\\AutocadSupporto\\Estesi\\Esteso.dat"))
    )

    (if Controllo8
        (startapp "C:\\AutocadSupporto\\Liberty\\Estesi.exe " "C:\\AutoCadSupporto\\Liberty\\Estesi.tkn")
    )

)
Rimane il quesito per "osnap", grazie.
 

rpor66

Utente Standard
Professione: Programmatore
Software: AutoCad, GstarCAD, CadWorx, Excel, Lisp, VBA
Regione: Sicilia
#36
Nella precedente discussione avevo inserito una funzione:
(defun SetOsnapOnOFF(mode / osmode)
(setq osmode (getvar "osmode"))
(if (= mode "ON")
(if (> osmode 16384)
(setvar "osmode" (- osmode 16384))
)
(if (< osmode 16384)
(setvar "osmode" (+ osmode 16384))
)
)
)

Inseriscila nel file lisp o ti crei un file che richiami dal tuo, quando vuoi spegnere gli osnap aggiungi il comando (SetOsnapOnOff "OFF") e quando li vuoi riaccendere (SetOsnapOnOff "ON").
Questa ha il vantaggio, rispetto a osmode=0, che se hai settato gli osnap non si perdono.