XYZ

[ribbit]

Hello,

 

Je n'arrive plus a trouver ca : je cherche un petit lisp qui permettrait d'associer les valeurs XYZ d'un point à celui ci en Xdata ou en bloc peu importe - pour répondre a cette question, posée sur un autre forum sur le web (GeoRezo pour ceux qui suivent).

 

Ce sont des points avec 3 attributs. Et pour chaque point, il y a un X, un Y et un Z. Il y a aussi un objet texte avec l'altitude mais indépendant (il n'y a pas autant de texte que de points).

J'ai comparé avec un autre fichier autocad. en effet, sur celui qui fonctionne bien (l'autre), le "point" est en fait une "Référence de bloc". Ca doit etre ca le soucis non ?

Quoiqu'il en soit, dans les deux cas la géométrie indique la position X, Y et Z.

Donc c'est mauvais signe. j'ai peur ded devoir rentrer tous les attributs à la main... :-)

 

Merci d'avance,

Ribbit.

[(gile)]

Salut,

 

Peut-être ici ?

[Patrick_35]

Salut

Peut-être avec un de mes premiers lisp avec des réacteurs ?

 

@+

 

(defun Attributs_ini(Rea Cde)
 (setq dernier_ent (entlast))
)

(defun Attributs_xyz(Rea Cde / bl js n xyz)
 (cond
   ((or (eq (car Cde) "MOVE") (eq (car Cde) "STRETCH"))
     (setq js (ssget "_p"))
   )
   ((or (eq (car Cde) "GRIP_MOVE") (eq (car Cde) "GRIP_STRETCH"))
     (setq js (cadr (ssgetfirst)))
   )
   ((eq (car Cde) "INSERT")
     (setq js (ssadd))
     (ssadd (entlast) js)
   )
   ((eq (car Cde) "COPY")
     (setq js (ssadd) n (entnext dernier_ent))
     (while n
       (ssadd n js)
       (setq n (entnext n))
     )
   )
   ((eq (car Cde) "UCS")
     (setq js (ssget "x" (list (cons 0 "INSERT") (cons 2 Nom_bloc))))
   )
 )
 (if js
   (progn
     (setq n 0)
     (while (ssname js n)
       (setq bl (entget (ssname js n)))
       (if (and (eq (cdr (assoc 0 bl)) "INSERT") (eq (strcase (cdr (assoc 2 bl))) (strcase Nom_bloc)))
         (if (cdr (assoc 66 bl))
           (progn
             (setq xyz (trans (cdr (assoc 10 bl)) (cdr (assoc -1 bl)) 1))
             (while (not (eq (cdr (assoc 0 bl)) "SEQEND"))
               (if (eq (cdr (assoc 0 bl)) "ATTRIB")
                 (cond
                   ((eq (strcase (cdr (assoc 2 bl))) (strcase Eti_X))
                     (setq bl (subst (cons 1 (rtos (car xyz))) (assoc 1 bl) bl))
                     (entmod bl)
                     (entupd (cdr (assoc -1 bl)))
                   )
                   ((eq (strcase (cdr (assoc 2 bl))) (strcase Eti_Y))
                     (setq bl (subst (cons 1 (rtos (cadr xyz))) (assoc 1 bl) bl))
                     (entmod bl)
                     (entupd (cdr (assoc -1 bl)))
                   )
                   ((eq (strcase (cdr (assoc 2 bl))) (strcase Eti_Z))
                     (setq bl (subst (cons 1 (rtos (caddr xyz))) (assoc 1 bl) bl))
                     (entmod bl)
                     (entupd (cdr (assoc -1 bl)))
                   )
                 )
               )
               (setq bl (entget (entnext (cdr (assoc -1 bl)))))
             )
           )
         )
       )
       (setq n (1+ n))
     )
   )
 )
 (princ)
)

(defun c:spt(/ i j n)
 (if (setq i (vlr-reactors :vlr-command-reactor))
   (progn
     (setq n 1 i (nth n (car i)))
     (while i
       (setq j nil)
       (if (or (eq (cdr (car (vlr-reactions i))) 'ATTRIBUTS_XYZ) (eq (cdr (car (vlr-reactions i))) 'ATTRIBUTS_INI))
         (setq j i)
       )
       (if j
         (vlr-remove j)
         (setq n (1+ n))
       )
       (if (setq i (vlr-reactors :vlr-Command-Reactor))
         (setq i (nth n (car i)))
       )
     )
     (if mrea_mpt
       (princ (strcat "\n\tDésactivation de la mise à jour XYZ du bloc " Nom_bloc "."))
     )
     (setq mrea_mpt nil)
   )
 )
 (princ)
)

(defun c:mpt()
 (if (not mrea_mpt)
   (progn
     (c:spt)
     (vlr-command-reactor nil '((:vlr-commandwillstart . Attributs_ini)))
     (setq mrea_mpt (vlr-command-reactor nil '((:vlr-commandEnded . Attributs_xyz))))
     (princ (strcat "\n\tActivation de de la mise à jour XYZ du bloc " Nom_bloc "."))
   )
   (princ (strcat "\n\tLa mise à jour XYZ du bloc " Nom_bloc " est déjà activée."))
 )
 (princ)
)

(vl-load-com)
(setq Nom_bloc "XY"
     Eti_X    "X"
     Eti_Y    "Y"
     Eti_Z    "Z")
(princ (strcat "\n\tPour activer la mise à jour XYZ du bloc " Nom_bloc ", lancez la commande MPT.\n\tPour revenir à la normale, faites la commande SPT."))
(princ)

[ribbit]

Hello Grand Chef,

 

Ca m'a l'air pas mal du tout, mais je vais faire le débutant (absence trop prolongée de CadXP nuit à la santé, c'est bien connu). J'en ai fait un joli vlx, mais huuuu, faut il un bloc préexistant au préalable ? Genre un bloc avec un attribut non renseigné X, un Y et un Z ? Quelle étape ai je loupée ?

 

Si je comprend ce magnifique petit bout de code avec mon intelligence lispienne proche de 0, il met a jour les bloc avec les valeurs X, Y et Z en temps réel ?

 

En gros, on voit ecrit X, Y et Z renseignés en permanence en attribut ?

 

Merci en tout cas, ca risque de dépanner. Puis je faire suivre le code une fois que j'ai compris le fonctionnement ?

Ribbit

 

[Edité le 12/7/2006 par ribbit]

[Patrick_35]

Hugh, petit ribbit qui cours dans la prairie :cool:

 

Le VLX n'est pas trop conseillé pour la simple raison que tu définis le bloc ainsi que les attributs à prendre en compte par les réacteurs du lisp

(setq Nom_bloc "XY"

Eti_X "X"

Eti_Y "Y"

Eti_Z "Z")

 

Le Nom_bloc est comme son nom l'indique, la variable qui définit le nom du bloc qui est à prendre en compte par les réacteurs.

Du même que l'étiquette Eti_X pour que le réacteur inscrive la valeur X du bloc, Eti_Y pour la valeur Y et donc logiquement, l'Eti_Z pour la valeur Z

 

il met a jour les bloc avec les valeurs X, Y et Z en temps réel ?

Oui, à condition que le lisp soit chargé

 

En gros, on voit ecrit X, Y et Z renseignés en permanence en attribut ?

Oui, les valeurs X,Y et Z du bloc

 

Puis je faire suivre le code une fois que j'ai compris le fonctionnement ?

Oui, si c'est publié en clair, c'est pour que tout le monde en profite ;)

 

@+

[ribbit]

Aaah , oki oki.

 

Je file bidouiller ca et je te tiens au courant.

 

Merfi encore, je fais suivre dès que j'y arrive.

 

Ribbit, qui coure qui coure et qui rate son bus (?) :D

 

 

 

[ribbit]

Re,

 

C'est bon, j'ai reussi a faire marcher la bete, mais en fait ca ne colle pas avec ce que je pensais obtenir. En fait, il faut a chaque fois inserer un bloc pour 1 point. Par contre le script est très intéressant, pour cette histoire de mise a jour. C'est les "réacteurs" qui font ce petit miracle ?

 

J'ai une autre idée/question pour tenter une autre solution : Est-ce que ca serait compliqué de faire un export texte des coordonnées X, Y, Z d'un semis de points (sans extension bien sur, car je sais qu'on peut le faire avec map ou covadis ou encore Civil) ?

 

Merci en tout cas pour le LISP, c'est très sympa.

Ribbit.

 

 

 

[Edité le 20/7/2006 par ribbit]

[Patrick_35]

Pas forcement une insertion, un copier, déplacer, les grips, le scu permettent la mise à jour.

Et ce "petit miracle" vient bien des réacteurs

Pour l'export de points, je sais que Bonus à faity quelque chose là dessus. fait une recherche

 

@+

[lecrabe]

Coucou

 

Voici un Lisp qui exporte en fichier Texte les sommets XYZ d'une polyligne 2D (non splinée)

et/ou d'un ensemble de points : ;)

 

*** SVP enlevez le BLANC entre

 

 

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

; (Export LWPOLYLINE Vertices & Points to File)

; Copyright © 2000 DotSoft, All Rights Reserved

; Website: http://www.dotsoft.com

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

; DISCLAIMER: DotSoft Disclaims any and all liability for any damages

; arising out of the use or operation, or inability to use the software.

; FURTHERMORE, User agrees to hold DotSoft harmless from such claims.

; DotSoft makes no warranty, either expressed or implied, as to the

; fitness of this product for a particular purpose. All materials are

; to be considered ‘as-is’, and use of this software should be

; considered as AT YOUR OWN RISK.

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

 

(defun c:ptexport ()

(setq sset (ssget '((-4 . "

(0 . "LWPOLYLINE")(-4 . "OR >"))))

(if sset

(progn

(setq itm 0 num (sslength sset))

(setq fn (getfiled "Point Export File" "" "txt" 1))

(if (/= fn nil)

(progn

(setq fh (open fn "w"))

(while (

(setq hnd (ssname sset itm))

(setq ent (entget hnd))

(setq obj (cdr (assoc 0 ent)))

(cond

((= obj "POINT")

(setq pnt (cdr (assoc 10 ent)))

(princ (strcat (rtos (car pnt) 2 8) ","

(rtos (cadr pnt) 2 8) ","

(rtos (caddr pnt) 2 8)) fh)

(princ "\n" fh)

)

((= obj "LWPOLYLINE")

(if (= (cdr (assoc 38 ent)) nil)

(setq elv 0.0)

(setq elv (cdr (assoc 38 ent)))

)

(foreach rec ent

(if (= (car rec) 10)

(progn

(setq pnt (cdr rec))

(princ (strcat (rtos (car pnt) 2 8) ","

(rtos (cadr pnt) 2 8) ","

(rtos elv 2 8)) fh)

(princ "\n" fh)

)

)

)

)

(t nil)

)

(setq itm (1+ itm))

)

(close fh)

)

)

)

)

(princ)

)

 

(princ "\nPoint Export loaded, type PNTEXPORT to run.")

(princ)

 

Routine provenant de l'excellent site www.dotsoft.com :)

 

*** SVP enlevez le BLANC entre

 

Le Decapode

 

 

[Edité le 20/7/2006 par lecrabe]

[ribbit]

Marvellous !!!

 

Merci pour le script crabby.

 

Je te laisse le poster, vu qu'on suit le même forum ;)

 

Merci a tout deux en tout cas, ca va dépanner du monde ces scripts.

 

 

[Edité le 24/7/2006 par ribbit]