Appel au lispeur! Polyline to multiline

[bono05]

Salut les pros,

 

J'ai trouvé cela comme routine:

 

(defun c:po2ml ( / ent dxf_ent typent name_layer closed lst l_bub e_next dxf_next oldlayer oldosm key_mod scale_ml)

(while (null (setq ent (entsel "\nChoix de l'entité: "))))

(setq typent (cdr (assoc 0 (setq dxf_ent (entget (car ent))))) name_layer (cdr (assoc 8 dxf_ent)))

(cond

((eq typent "LWPOLYLINE")

(setq

closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)

lst (mapcar '(lambda (x) (trans x (car ent) 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))

l_bub (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent))

)

)

((eq typent "POLYLINE")

(setq

closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)

e_next (entnext (car ent))

)

(while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))

(if (zerop (boole 1 223 (cdr (assoc 70 dxf_next))))

(setq

lst (cons (trans (cdr (assoc 10 dxf_next)) (car ent) 1) lst)

l_bub (cons (cdr (assoc 42 dxf_next)) l_bub)

)

)

(setq e_next (entnext e_next))

)

(setq

lst (reverse lst)

l_bub (reverse l_bub)

)

)

)

(cond

((and lst (apply 'and (mapcar 'zerop l_bub)))

(setq oldlayer (getvar "clayer") oldosm (getvar "osmode"))

(setvar "clayer" name_layer)

(setvar "osmode" 0)

(setvar "cmdecho" 0)

(initget "Dessus Nulle dEssous _Top Zero Bottom")

(setq key_mod

(getkword

(strcat

"\nEntrez le type de justification [Dessus/Nulle/dEssous] <"

(cond

((eq (getvar "cmljust") 0)

"Dessus"

)

((eq (getvar "cmljust") 1)

"Nulle"

)

((eq (getvar "cmljust") 2)

"dEssous"

)

)

">: "

)

)

)

(if key_mod

(cond

((eq key_mod "Top") (setvar "cmljust" 0))

((eq key_mod "Zero") (setvar "cmljust" 1))

((eq key_mod "Bottom") (setvar "cmljust" 2))

)

)

(setq scale_ml (getreal (strcat "\nEntrez l'échelle de la multiligne <" (rtos (getvar "cmlscale")) ">: ")))

(if scale_ml (setvar "cmlscale" scale_ml))

(command "_.mline")

(foreach n lst (command "_none" n))

(if closed (command "_close") (command ""))

(setvar "clayer" oldlayer)

(setvar "osmode" oldosm)

(setvar "cmdecho" 1)

(entdel (car ent))

)

(T (princ "\nN'est pas une polyligne, ou celle ci comporte des arrondis!"))

)

(prin1)

)

 

 

Mais voilà mon problème:

 

Ex: j'ai des Polylignes de 400, 800 et 1200....que je devrai modifier en multilignes mais tout en gardant l'épaisseur de chacune. Et comme j'ai 8 epaisseurs differentes pour plus de 67 segments dans un plan, vous comprendrez que je cherche à me simplifier la vie.

 

Deplus j'ai un tout petit message d'erreur à la fin de la commande...

 

Merci!!! :cool:

[bonuscad]

Salut,

 

En faisant juste une petite modif (mise en remarque de la demande de l'épaisseur) avec le semi-colon ";"

 

;			(setq scale_ml (getdist (strcat "\nEntrez l'échelle de la multiligne [b]<[/b]" (rtos (getvar "cmlscale")) "[b]>[/b]: ")))
;			(if scale_ml (setvar "cmlscale" scale_ml))

 

et insertion de la récupération de la largeur constante de la polyligne et assignation à la variable CMSCALE

 

				((and lst (apply 'and (mapcar 'zerop l_bub)))
           [surligneur] (setvar "cmlscale" (cdr (assoc 43 dxf_ent)))[/surligneur] 
					(setvar "clayer" name_layer)

 

Deplus j'ai un tout petit message d'erreur à la fin de la commande...

 

Possible, mais là je ne vois pas de quoi il s'agit sans plus d'explication...

[bonuscad]

Comme je ne suis pas sure que le code intégral que tu as mis n'a pas été modifié, je préfère reposter le code en entier.

 

(defun c:po2ml ( / jspl nbr ent dxf_ent typent name_layer closed lst l_bub e_next dxf_next oldlayer oldosm key_mod)
(princ "\nChoix des polylignes à transformer en multilignes: ")
(setq
	jspl (ssget '((0 . "*POLYLINE") (-4 . "[b]<[/b]NOT") (-4 . "&") (70 . 112) (-4 . "NOT[b]>[/b]")))
	nbr 0
)
(cond
	(jspl
		(initget "Dessus Nulle dEssous _Top Zero Bottom")
		(setq key_mod
			(getkword
				(strcat
					"\nEntrez le type de justification [Dessus/Nulle/dEssous] [b]<[/b]"
					(cond
						((eq (getvar "cmljust") 0)
							"Dessus"
						)
						((eq (getvar "cmljust") 1)
							"Nulle"
						)
						((eq (getvar "cmljust") 2)
							"dEssous"
						)
					)
					"[b]>[/b]: "
				)
			)
		)
		(if key_mod
			(cond
				((eq key_mod "Top") (setvar "cmljust" 0))
				((eq key_mod "Zero") (setvar "cmljust" 1))
				((eq key_mod "Bottom") (setvar "cmljust" 2))
			)
		)
		(setq oldlayer (getvar "clayer") oldosm (getvar "osmode"))
		(setvar "osmode" 0)
		(setvar "cmdecho" 0)
		(repeat (sslength jspl)
			(setq
				typent (cdr (assoc 0 (setq dxf_ent (entget (setq ent (ssname jspl nbr))))))
				name_layer (cdr (assoc 8 dxf_ent))
			)
			(cond
				((eq typent "LWPOLYLINE")
					(setq
						closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
						lst (mapcar '(lambda (x) (trans x ent 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
						l_bub (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent))
					)
				)
				((eq typent "POLYLINE")
					(setq
						closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
						e_next (entnext ent)
					)
					(while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))
						(if (zerop (boole 1 223 (cdr (assoc 70 dxf_next))))
							(setq
								lst (cons (trans (cdr (assoc 10 dxf_next)) ent 1) lst)
								l_bub (cons (cdr (assoc 42 dxf_next)) l_bub)
							)
						)
						(setq e_next (entnext e_next))
					)
					(setq
						lst (reverse lst)
						l_bub (reverse l_bub)
					)
				)
			)
			(cond
				((and lst (apply 'and (mapcar 'zerop l_bub)))
           (setvar "cmlscale" (cdr (assoc 43 dxf_ent)))
					(setvar "clayer" name_layer)
					(command "_.mline")
					(foreach n lst (command n))
					(if (not (zerop closed)) (command "_close") (command ""))
					(entdel ent)
				)
				(T (princ "\nLes polylignes comportant des arrondis n'ont pas été traitées!"))
			)
			(setq nbr (1+ nbr) lst nil l_bub nil)
		)
		(setvar "clayer" oldlayer)
		(setvar "osmode" oldosm)
		(setvar "cmdecho" 1)
	)
	(T (princ "\nSélection vide"))
)
(prin1)
)

[bono05]

BonusCad...une fois de plus TROP FORT !!! Mille fois merci !!

Cela valait bien la peine d'attendre un peu... :D

 

Vraiment un pro!