probleme de traduction d\'un lisp

[isabelle240]

Bonjour, j'ai trouvé un lisp sur un site anglais qui fonctionne tres bien sur une version anglaise d'autocad mais que je suis incapable de faire fonctionner sur une version francaise, est-ce que qqu peut m'aider ?

 

CADALYST 03/06 Tip2095: Mlex.lsp

[(gile)]

Salut,

 

Si tu pouvais donner un lien valide ou poster le code...

[isabelle240]

oups pardon , voici le code car je n'ai pas trouve comment mettre un lien

 

;;12-22-05

;;Don Wells, This routine explodes multilines and changes the resulting line segments into plines.

;;

(defun c:mlex (/ ml mleed numb layer clay set1 total

e1 eed1 e1p1 e1p2 newe1 new e2 eed2

e2p1 e2p2 newe2 pass ml2

)

(command "undo" "begin")

(if (= 0 (getvar "worlducs"))

(progn

(setq ucsflag 1)

(setq ucsf (getvar "ucsfollow"))

(setvar "ucsfollow" 0)

(command "ucs" "world")

)

)

(setq pass 0)

(setq ml (car (entsel)))

(setq mleed (entget ml))

(if (eq (cdr (assoc 0 mleed)) "MLINE") ; test for non multiline

(progn ; then proceed

(setq numb (cdr (assoc 73 mleed))) ; number of lines in multiline

(setq layer (cdr (assoc 8 mleed)))

(setq clay (getvar "clayer"))

(command "-layer" "n" "multitemp" "") ; create a temporary layer

(command "-layer" "s" "multitemp" "")

(setq mleed (subst (cons 8 "multitemp") (assoc 8 mleed) mleed))

; put multiline onto temporary layer

(entmod mleed)

(command "explode" ml)

(setq set1 (ssget "X" '((8 . "multitemp"))))

(setq total (sslength set1)) ; number of individual lines from exploded multiline

(repeat numb

(setq e1 (ssname set1 0))

(setq eed1 (entget e1))

(setq e1p1 (cdr (assoc 10 eed1)))

(setq e1p2 (cdr (assoc 11 eed1)))

(command "pedit" e1 "y" "") ; turn line segment into pline

(setq newe1 (entlast))

(setq new (ssadd newe1)) ; put first pline into set

(ssdel e1 set1)

(repeat (- total 1) ; test to see if coordinates of next line match coordinates of first line

(setq e2 (ssname set1 pass))

(setq eed2 (entget e2))

(setq e2p1 (cdr (assoc 10 eed2)))

(setq e2p2 (cdr (assoc 11 eed2)))

(if (or (or (equal e2p1 e1p1) (equal e2p2 e1p1))

(or (equal e2p1 e1p2) (equal e2p2 e1p2))

)

(progn ;then

(command "pedit" e2 "y" "")

(setq newe2 (entlast))

(ssadd newe2 new) ; if coordinates match, put line into set

(ssdel e2 set1)

(setq e1p1 e2p1

e1p2 e2p2

)

) ;progn

(setq pass (+ pass 1)) ;else if coordinates don't match compare next line

) ;if

) ;repeat

(command "pedit" new "j" new "" "")

; join all lines in set into a pline

(setq ml2 (entget (entlast)))

(setq ml2 (subst (cons 8 layer) (assoc 8 ml2) ml2))

(entmod ml2) ; put new pline onto layer of original multiline

(setq total (- total (sslength new)))

(setq pass 0

new nil

)

) ;repeat to put next group of lines into a set

(setvar "clayer" clay)

(command "purge" "la" "multitemp" "n")

; get rid of temporary layer

(if (= 1 ucsflag)

(progn

(command "ucs" "prev")

(setvar "ucsfollow" UCSF)

(setq ucsflag nil

ucsf nil

)

)

)

(command "undo" "end")

(princ (strcat "***Multiline exploded into "

(itoa numb)

" separate plines.***"

)

)

(terpri)

) ;progn

(alert "OBJECT SELECTED IS NOT A MULTILINE.")

;else

) ;if not a multiline

)

[(gile)]

Voilà, j'en ai profité pour faire un test sur la valeur de PEDITACCEPT pour éviter une erreur si elle était à 1.

 

Je te laisse le soin de traduires les invites (si tu en as envie)

 

;;12-22-05
;;Don Wells, This routine explodes multilines and changes the resulting line segments into plines.
;;
(defun c:mlex (/      ml     mleed  numb   layer  clay	 set1	total  e1
       eed1   e1p1   e1p2   newe1  new	  e2	 eed2	e2p1   e2p2
       newe2  pass   ml2
      )
 (command "_.undo" "_begin")
 (if (= 0 (getvar "worlducs"))
   (progn
     (setq ucsflag 1)
     (setq ucsf (getvar "ucsfollow"))
     (setvar "ucsfollow" 0)
     (command "_.ucs" "_world")
   )
 )
 (setq pass 0)
 (setq ml (car (entsel)))
 (setq mleed (entget ml))
 (if (eq (cdr (assoc 0 mleed)) "MLINE") ; test for non multiline
   (progn				; then proceed
     (setq numb (cdr (assoc 73 mleed))) ; number of lines in multiline
     (setq layer (cdr (assoc 8 mleed)))
     (setq clay (getvar "clayer"))
     (command "_.-layer" "_n" "multitemp" "") ; create a temporary layer
     (command "_.-layer" "_s" "multitemp" "")
     (setq mleed (subst (cons 8 "multitemp") (assoc 8 mleed) mleed))
				; put multiline onto temporary layer
     (entmod mleed)
     (command "_.explode" ml)
     (setq set1 (ssget "_X" '((8 . "multitemp"))))
     (setq total (sslength set1))	; number of individual lines from exploded multiline
     (repeat numb
(setq e1 (ssname set1 0))
(setq eed1 (entget e1))
(setq e1p1 (cdr (assoc 10 eed1)))
(setq e1p2 (cdr (assoc 11 eed1)))
(if (	  (command "_.pedit" e1 "")	; turn line segment into pline
  (command "_.pedit" e1 "_y" "")
)
(setq newe1 (entlast))
(setq new (ssadd newe1))	; put first pline into set
(ssdel e1 set1)
(repeat	(- total 1)		; test to see if coordinates of next line match coordinates of first line
  (setq e2 (ssname set1 pass))
  (setq eed2 (entget e2))
  (setq e2p1 (cdr (assoc 10 eed2)))
  (setq e2p2 (cdr (assoc 11 eed2)))
  (if (or (or (equal e2p1 e1p1) (equal e2p2 e1p1))
	  (or (equal e2p1 e1p2) (equal e2p2 e1p2))
      )
    (progn			;then
      (if (		(command "_.pedit" e2 "")
	(command "_.pedit" e2 "_y" "")
      )
      (setq newe2 (entlast))
      (ssadd newe2 new)		; if coordinates match, put line into set
      (ssdel e2 set1)
      (setq e1p1 e2p1
	    e1p2 e2p2
      )
    )				;progn
    (setq pass (+ pass 1))	;else if coordinates don't match compare next line
  )				;if
)				;repeat
(command "_.pedit" new "_j" new "" "")
				; join all lines in set into a pline
(setq ml2 (entget (entlast)))
(setq ml2 (subst (cons 8 layer) (assoc 8 ml2) ml2))
(entmod ml2)			; put new pline onto layer of original multiline
(setq total (- total (sslength new)))
(setq pass 0
      new nil
)
     )					;repeat to put next group of lines into a set
     (setvar "clayer" clay)
     (command "_purge" "_la" "multitemp" "_n")
				; get rid of temporary layer
     (if (= 1 ucsflag)
(progn
  (command "_.ucs" "_prev")
  (setvar "ucsfollow" UCSF)
  (setq	ucsflag	nil
	ucsf nil
  )
)
     )
     (command "_.undo" "_end")
     (princ (strcat "***Multiline exploded into "
	     (itoa numb)
	     " separate plines.***"
     )
     )
     (terpri)
   )					;progn
   (alert "OBJECT SELECTED IS NOT A MULTILINE.")
				;else
 )					;if not a multiline
) 

[isabelle240]

Mille fois merci, a la prochaine...