rtansformation de lignes en point

[ddesse]

Bonjour à tous

 

Je voudrais savoir s'il est possible de transformer des ligne en point afin de pouvoir fournir le dessin à une société qui découpe au jet d'eau. J'ai essayé de remplacer les lignes par des pointillés, mais il y en à beaucoup trop. Auriez vous une autre idée ??

 

Merci

 

 

[RhymOne]

Salut

Essaye sa:

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

; DESSIN D'UN POINT AUX SOMMETS DE POLYLIGNE

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

 

 

;--- Fonction principale

(defun c:PointPoly( / e te som cal nb i p1 oldclauer)

(command "ANNULER" "D")

(if (setq e (car (entsel)))

(progn

(setq te (cdr (assoc 0 (entget e))))

(if (or (= te "LWPOLYLINE") (= te "POLYLINE"))

(progn

(setq oldplinetype (getvar "plinetype"))

(cond

((= te "LWPOLYLINE") (setvar "plinetype" 1))

((= te "POLYLINE") (setvar "plinetype" 0))

)

 

(setq som (GetSommetPolyligne e))

(setq cal (cdr (assoc 8 (entget e))))

; Parametres des points

(setq $InfoPoint (GetInfoPoint))

(setq nb (length som) i 0)

(setq oldclayer (getvar "clayer"))

(command "CALQUE" "ET" cal "")

(repeat nb

(setq p1 (nth i som))

(setq p1 (trans p1 0 1))

(command "POINT" p1)

(setq i (1+ i))

)

(command "CALQUE" "ET" oldclayer "")

)

)

)

)

(command "ANNULER" "F")

(princ)

)

 

(defun c:PointPolyS( / e te som cal nb i p1 oldclauer i-s nb-s)

(command "ANNULER" "D")

(if (setq js (ssget (list (cons 0 "*POLYLINE"))))

(progn

(setq $InfoPoint (GetInfoPoint))

(setq nb-s (sslength js) i-s 0)

(repeat nb-s

(setq e (ssname js i-s))

(setq te (cdr (assoc 0 (entget e))))

(if (or (= te "LWPOLYLINE") (= te "POLYLINE"))

(progn

(setq oldplinetype (getvar "plinetype"))

(cond

((= te "LWPOLYLINE") (setvar "plinetype" 1))

((= te "POLYLINE") (setvar "plinetype" 0))

)

 

(setq som (GetSommetPolyligne e))

(setq cal (cdr (assoc 8 (entget e))))

; Parametres des points

 

(setq nb (length som) i 0)

(setq oldclayer (getvar "clayer"))

(command "CALQUE" "ET" cal "")

(repeat nb

(setq p1 (nth i som))

(setq p1 (trans p1 0 1))

(command "POINT" p1)

(setq i (1+ i))

)

(command "CALQUE" "ET" oldclayer "")

)

)

(setq i-s (1+ i-s))

)

)

)

(command "ANNULER" "F")

(princ)

)

 

;--- Parametres du point

(defun GetInfoPoint( / olddpmode olddpsize repeff)

(setq olddpmode (getvar "pdmode"))

(setq olddpsize (getvar "pdsize"))

(command "_ddptype")

(list (getvar "pdmode") (getvar "pdsize") olddpmode olddpsize)

)

 

; lecture des sommets de la polyligne

(defun GetSommetPolyligne (e1 / res ee1 type_e1 p z-elev p z tee1 p1 p2)

(if (setq ee1 (entget e1))

(progn

(setq type_e1 (cdr (assoc 0 ee1)))

(setq z (cdr (assoc 38 ee1)))

(cond

((= type_e1 "LINE")

(setq z (cdr (assoc 38 ee1)))

(if (not z) (setq z 0.0))

(setq p1 (cdr (assoc 10 ee1))

p2 (cdr (assoc 11 ee1))

)

(setq p1 (list (car p1) (cadr p1) z)

p2 (list (car p2) (cadr p2) z)

)

(setq res (list p1 p2))

)

((= type_e1 "POLYLINE")

(setq arret NIL)

(while (not arret)

(setq e1 (entnext e1))

(setq ee1 (entget e1))

(setq tee1 (cdr (assoc 0 ee1)))

(cond

((= tee1 "SEQEND") (setq arret T))

((= tee1 "VERTEX")

(setq p1 (cdr (assoc 10 ee1)))

(setq res (cons p1 res))

)

)

)

)

((= type_e1 "LWPOLYLINE")

(setq z (cdr (assoc 38 ee1)))

(setq res nil)

(while (setq p (car ee1))

 

(if (= (car p) 10)

(progn

(setq p1 (cdr p))

(setq res (cons (append p1 (list z)) res))

)

)

(setq ee1 (cdr ee1))

)

)

); Cond

)

)

(reverse res)

)

 

 

(princ "\nInsertion de point sur les sommets d'une polyligne V1.03, tapez POINTPOLY pour lancer la commande")

[RhymOne]

Petit soucis de copier coller:

Voici le lien pour telecharge le lisp a copier coller dans :

C:\Documents and Settings\XXX\Application Data\Autodesk\AutoCAD 20XX\RXX.0\fra\Support

http://dl.free.fr/djvF4sY6s

A plus..

[ddesse]

merci à tous