Modif lisp

[fabdo]

Bonjour (gile)

 

Tu avais créé cette routine pour charger des blocs points sous la forme point,X,Z

 

(defun c:matricule (/ mat mlst ss n bloc att lst opt cnt ind pt)

(if (and

(setq mat (car (nentsel "\nSélectionnez un matricule: ")))

(setq mlst (entget mat))

(= "ATTRIB" (cdr (assoc 0 mlst)))

(= (type (read (cdr (assoc 1 mlst)))) 'INT)

(setq ss (ssget "_X"

(list '(0 . "INSERT")

(assoc 2 (entget (cdr (assoc 330 mlst))))

)

)

)

)

(progn

(repeat (setq n (sslength ss))

(setq bloc (ssname ss (setq n (1- n)))

att (entnext bloc)

)

(while (not (equal (assoc 2 (entget att)) (assoc 2 mlst)))

(setq att (entnext att))

)

(setq lst (cons (cons (atoi (cdr (assoc 1 (entget att))))

(trans (cdr (assoc 10 (entget bloc))) bloc 1)

)

lst

)

)

)

(while (progn

(initget "2d 3d")

(setq opt (getkword

"\nSpécifiez le type de polyligne [2d/3d] < Quitter >: "

)

)

)

(cond

((= opt "2d") (command "_pline"))

((= opt "3d") (command "_3dpoly"))

(T (command))

)

(setq cnt 0)

(while (/= 0 (getvar "CMDACTIVE"))

(setvar "CMDECHO" 0)

(cond

((< 2 cnt) (initget "Clore annUler"))

((< 1 cnt) (initget "annUler"))

)

(setq ind (getint

(strcat

"\nEntrez le matricule du point"

(cond

((< cnt 2) "")

((< cnt 3) " ou [annUler]")

(T " ou [Clore/annUler]")

)

": "

)

)

)

(cond

((numberp ind)

(cond

((setq pt (cdr (assoc ind lst)))

(command "_non" pt)

(setq cnt (1+ cnt))

)

(T

(princ "\nMatricule non valide.")

)

)

)

((= ind "Clore") (command "_C"))

((= ind "annUler")

(command "_U")

(setq cnt (1- cnt))

)

(T (command))

)

(setvar "CMDECHO" 1)

)

)

)

)

(princ)

)

 

 

j'ai maintenant des listings de points sous la forme:

2001 608638.700 186869.000 12.122

2002 608601.500 186897.000 5.122

2003 608568.193 186903.665 10.524

2004 608496.896 186917.933 12.012

 

Est-il possible de changer quelque chose dans ta routine pour que cela puisse fonctionner.

 

Et quelle ligne est à modifier pour charger des blocs contenant jusqu'au 4 chiffres après la virgule sous ta première routine?

 

D'avance merci.

 

fab.

 

 

 

 

 

[(gile)]

Salut,

 

Excuse moi mais je ne comprends pas du tout ta demande.

Le LISP que tu a posté, crée une polyligne (2d ou 3d) reliant les points d'insertions des blocs dont on entre les matricules.

Je ne vois pas le rapport avec un listing de points.

Si tu peux mettre des liens vers les sujets concernés ou poster à la suite de ces sujets, je m'y retrouverais peut-être plus facilement.

[fabdo]

Oups désolé

 

Celui-ci fonctionne très bien gile c'est de celui la qu'il s'agit, I'm sorry.

 

(defun c:PointFile (/ AcDoc Space bloc file str mat alt ins ref)

(vl-load-com)

(and

(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))

Space (if (= (getvar "CVPORT") 1)

(vla-get-PaperSpace AcDoc)

(vla-get-ModelSpace AcDoc)

)

)

(or

(tblsearch "BLOCK" (setq bloc "PointFile"))

(findfile (setq bloc "PointFile.dwg"))

)

(setq file (getfiled "Choisir le fichier" "" "txt" 0))

(setq file (open file "r"))

(while (setq str (read-line file))

(setq str (vl-string-right-trim "," str)

mat (substr str 1 (vl-string-position (ascii ",") str))

str (substr str (+ 2 (vl-string-position (ascii ",") str)))

alt

(rtos (atof (substr str (+ 2 (vl-string-position (ascii ",") str 1 T)))) 2 2)

ins nil

ins (cons (atof alt) ins)

str (substr str 1 (vl-string-position (ascii ",") str 1 T))

ins

(cons

(atof (substr str

(+ 2 (vl-string-position (ascii ",") str 1 T))

)

)

ins

)

str (substr str 1 (vl-string-position (ascii ",") str 1 T))

ins (cons (atof str) ins)

ref (vla-InsertBlock

Space

(vlax-3d-point ins)

bloc

1.0

1.0

1.0

0.0

)

)

(mapcar '(lambda (x y) (vla-put-TextString x y))

(vlax-invoke ref 'GetAttributes)

(list mat alt)

)

)

)

(princ)

)

 

fab.

[(gile)]

Salut,

 

Si j'ai bien compris la demande...

 

(defun c:PointFile (/ AcDoc Space bloc file str mat alt ins ref)
 (vl-load-com)
 (and
   (setq AcDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
  Space	(if (= (getvar "CVPORT") 1)
	  (vla-get-PaperSpace AcDoc)
	  (vla-get-ModelSpace AcDoc)
	)
   )
   (or
     (tblsearch "BLOCK" (setq bloc "PointFile"))
     (findfile (setq bloc "PointFile.dwg"))
   )
   (setq file (getfiled "Choisir le fichier" "" "txt" 0))
   (setq file (open file "r"))
   (while (setq str (read-line file))
     (setq str	(vl-string-right-trim " " str)
    mat	(substr str 1 (vl-string-position (ascii " ") str))
    str	(substr str (+ 2 (vl-string-position (ascii " ") str)))
    alt
	(rtos
	  (atof
	    (substr str (+ 2 (vl-string-position (ascii " ") str 1 T)))
	  )
	  2
	  4 [surligneur]; nombre de décimales affichée dans l'attribut [/surligneur] 
	)
    ins	nil
    ins	(cons (atof alt) ins)
    str	(substr str 1 (vl-string-position (ascii " ") str 1 T))
    ins
	(cons
	  (atof	(substr	str
			(+ 2 (vl-string-position (ascii " ") str 1 T))
		)
	  )
	  ins
	)
    str	(substr str 1 (vl-string-position (ascii " ") str 1 T))
    ins	(cons (atof str) ins)
    ref	(vla-InsertBlock
	  Space
	  (vlax-3d-point ins)
	  bloc
	  1.0
	  1.0
	  1.0
	  0.0
	)
     )
     (mapcar '(lambda (x y) (vla-put-TextString x y))
      (vlax-invoke ref 'GetAttributes)
      (list mat alt)
     )
   )
 )
 (princ)
)

[fabdo]

Bonsoir gile,

 

je n'arrive plus à charger mes points avec pointfile je pense que c'est du au nouveau format, est-il possible de modifier quelques paramètres pour que cela puisse marcher, mon nouveau format est :

 

3621 607842.161 186630.952 53.809

3621 609293.313 186570.308 53.809

3622 607829.639 186632.375 53.399

3622 609274.530 186572.442 53.399

3623 607813.552 186645.811 53.194

 

merci d'avance.

 

bonne soirée

[(gile)]

Salut,

 

La routine ci dessus fonctionne avec l'espace comme séparateur, la routine originale fonctionnait avec la virgule comme séparateur.

Je n'ai fait que remplacer tous les (ascii ",") par des (ascii " ").

[fabdo]

Ok gile

 

Je pense que je dois avoir un souci lors de la création de mon pointfile, je te tiens au courant.

 

Grand Merci!!

[fabdo]

Merci gile

 

Tout fonctionne comme d'hab...

 

Bon week-end.