ETIRER EN CAPTURANT SUIVANT PLUSIEURS POLYLIGNE

[PHILPHIL]

HELLO

 

gile a ecrit ce LISP

 

 (defun C:ETCP (/
       ENT ELST PLST
       )
 (setvar "cmdecho" 0)
 (setq OSM (getvar "osmode"))
 (setvar "osmode" 0)
 (and (setq ENT (car (entsel)))
      (setq ELST (entget ENT))
      (= "LWPOLYLINE" (cdr (assoc 0 ELST)))
      (setq PLST (mapcar (function (lambda (X) (trans (cdr X) ENT 1)))
		  (vl-remove-if-not (function (lambda (X) (= (car X) 10))) ELST)
	  )
      )
      (vl-cmdf "zoom" "ob" ENT "")
      (vl-cmdf "_.erase" ENT "")
      (vl-cmdf "_.stretch" "_cp")
      (mapcar 'vl-cmdf PLST)
      (vl-cmdf "" "")
 )
 (setvar "osmode" OSM)
 (princ)
)

 

j'essaye de le modifier pour qu'il prenne en compte plusieurs polylignes et lui donner des le depart les deux points de translation

 

mais je bute sur le fait qu'il prenne meme en compte les points "POI1" "POI2"

 

une explication pourquoi ca ne marche pas ???

 

phil

 

 

 (defun C:ETCPP (/
	;;UNEPOLY ELST PLST
	)
 (setvar "cmdecho" 0)
 (setq OSM (getvar "osmode"))
 (setq POI1 NIL)
 (while (null POI1)
   (setq POI1 (getpoint "\n1er POINT DE DEPART"))
 )
 (setq POI2 NIL)
 (while (null POI2)
   (setq POI2 (getpoint "\n2eme POINT DE D'ARRIVEEE"))
 )
 (setvar "osmode" 0)

 (prompt
   "CLIQUER SUR L'ENTITE(S) POLYLIGNE(S) FERMEE(S) :"
 )
 (setq LESPOLY nil)
 (while (null LESPOLY)
   (setq
     LESPOLY (ssget
	(list (cons -4 "		      (cons 0 "polyline")
	      (cons 0 "lwpolyline")
	      (cons -4 "or>")
	)
      )
   )
 )

 (setq compt 0)
 (setq com (sslength LESPOLY))
 (while (< compt com)
   (progn (setq UNEPOLY (ssname LESPOLY compt))
   (and	(setq ELST (entget UNEPOLY))
	(= "LWPOLYLINE" (cdr (assoc 0 ELST)))
	(setq PLST
	       (mapcar (function (lambda (X) (trans (cdr X) UNEPOLY 1)))
		       (vl-remove-if-not
			 (function (lambda (X) (= (car X) 10)))
			 ELST
		       )
	       )
	)
	(vl-cmdf "zoom" "ob" UNEPOLY "")
	(vl-cmdf "_.erase" UNEPOLY "")
	(vl-cmdf "_.stretch" "_cp")
	(mapcar 'vl-cmdf PLST)
	(vl-cmdf poi1 poi2)
   )
   (setq compt (1+ compt))
   )
 )
 
 (setvar "osmode" OSM)
 (princ)
)

 

 

 

[Edité le 12/6/2009 par PHILPHIL]

 

[Edité le 12/6/2009 par PHILPHIL]

[(gile)]

Salut,

 

Quelque chose comme ça ?

 

(defun	C:ETCPP (/ osm ss p1 p2 n ent elst plst)
  (setq osm (getvar "osmode"))
  (if (and
 (setq ss (ssget '((0 . "LWPOLYLINE"))))
 (setq p1 (getpoint "\nSpécifiez le point de base: "))
      )
    (progn
      (repeat (setq n (sslength ss))
 (setq ent  (ssname ss (setq n (1- n)))
       elst (entget ent)
       plst (cons
	      (mapcar (function (lambda (X) (trans (cdr X) ent 1)))
		      (vl-remove-if-not
			(function (lambda (X) (= (car X) 10)))
			elst
		      )
	      )
	      plst
	    )
 )
 (vl-cmdf "_.erase" ent "")
      )
      (setvar "cmdecho" 0)
      (setvar "osmode" 0)
      (vl-cmdf "_.stretch")
      (foreach	l plst
 (vl-cmdf "_cp")
 (mapcar 'vl-cmdf l)
 (vl-cmdf "")
      )
      (princ "\nSpécifiez le deuxième point: ")
      (vl-cmdf "" p1 pause)
    )
  )
  (setvar "cmdecho" 1)
  (setvar "osmode" osm)
  (princ)
)

[PHILPHIL]

hello gile

 

merci d'avoir regarder

 

il y a quand meme un petit souci

 

si on zoom pour aller chercher le deuxieme point de base

le LISP perd touts les points de references des polylignes préalablement selectionnées

( la fonction "etirer" ne prend en compte que les" points" / "polylignes" qui sont vue entierement a l'ecran je crois )

dans "ETCP" juste apres la selection de la polyligne il y avait un zoom sur la polyligne pour qu autocad enregistre ses points plein ecran et ensuite on selectionnais les deux points( base, final)

 

d'ou mon idée d'aller chercher en premier les deux points ( base , arrivée) puis de zoomer sur la selection des polylignes

 

 

la fonction "etirer" n'accepte pas que l'ont sélectionne deux points d'une meme polyligne en deux fois il n'y a que "MSTRETCH" des express tools qui accepte ca bizarre

 

merci gile

bon week

 

phil

 

[PHILPHIL]

hello gile

 

ca marche j'ai juste rajouter dans le LISP

pour qu'il prenne bien en compte toutes les polylignes

apres un zoom sur les point de depart et arrivée

 

merci gile

 

a+

 

phil

 

 

 ....
(progn
(vl-cmdf "zoom" "ob" ss "")
(repeat (setq n (sslength ss))
....