Migration d\'un lisp d\'Autocad14 vers 2000i

[mikL44]

Salut à tous,

 

Voila, ce lisp fonctionnait avant sous la V14, il nous servaient quand on inseraient un symbole de vanne par exemple, dans un schema, a couper la ligne automatiquement, depuis que nous avons la 2000i, ce lisp ne fonctionne plus, nous sommes obligés de couper les lignes manuellement. Quelqu'un saurait il au vu des lignes de codes si dessous, ou se situe le bug.

 

merci

 

 

(defun c:coupres ( / valcoup ensh ensv ens nb cpt data ent pt1 pt2 direction

entdir nbh nbv cpth cptv p1h p2h nomv datav nomh datah

p1v p2v lstpih lstpiv lstdr ssptr pti pc1 pc2 entcp datacp

)

 

;Initialisation de la fonction de gestion des erreurs

(setq AW_OLD_ERROR *error*

*error* U_error

)

(G_sauve_VAR '("celtype" "cecolor" "clayer" "cmdecho"

"blipmode" "aflags" "attreq" "orthomode"))

(mapcar 'setvar '("cmdecho" "blipmode" "aflags" "attreq" "orthomode")

'( 0 0 0 0 0 ))

 

(command "accrobj" "aucun")

(setq valcoup (getdist "\nEspacement <2.5> : "))

(if (null valcoup) (setq valcoup 2.5))

(setq ensh (ssadd))

(setq ensv (ssadd))

(princ "\nSelection du reseau...")

(setq ens (ssget (list (cons 0 "LINE"))))

(if ens

(progn

;recuperation des lignes verticales et horizontales

(setq nb (sslength ens))

(setq cpt 0)

(while (< cpt nb)

(setq ent (ssname ens cpt))

(setq data (entget ent))

(setq pt1 (cdr (assoc 10 data)))

(setq pt2 (cdr (assoc 11 data)))

(if (= (car pt1) (car pt2))

(setq ensv (ssadd ent ensv))

)

(if (= (cadr pt1) (cadr pt2))

(setq ensh (ssadd ent ensh))

)

(setq cpt (+ 1 cpt))

)

)

)

(if (or (= (sslength ensh) 0) (= (sslength ensv) 0))

; ALORS

(alert "Mauvais choix...Aucune intersection !")

; SINON...avec plusieurs instructions

(progn

(princ "\nDirection des coupures...")

(setq direction nil)

(setq entdir (car (entsel)))

(if entdir

(progn

(cond

((ssmemb entdir ensh)

(setq direction "HOR")

)

((ssmemb entdir ensv)

(setq direction "VER")

)

(T

(setq direction nil)

)

)

)

)

)

)

(if (null direction)

(progn

(if (not (or (= (sslength ensh) 0) (= (sslength ensv) 0)))

(alert "\n\nMauvais choix dans la direction !")

)

)

(progn

;recuperation des points d'intersection entre les horizontales et les verticales

(setq nbh (sslength ensh))

(setq nbv (sslength ensv))

(setq cpth 0)

(while (< cpth nbh)

(setq nomh (ssname ensh cpth))

(setq datah (entget nomh))

(setq p1h (cdr (assoc 10 datah)))

(setq p2h (cdr (assoc 11 datah)))

(setq cptv 0)

(while (< cptv nbv)

(setq nomv (ssname ensv cptv))

(setq datav (entget nomv))

(setq p1v (cdr (assoc 10 datav)))

(setq p2v (cdr (assoc 11 datav)))

(if (setq pti (inters p1v p2v p1h p2h))

; Instruction pour le ALORS du SI

(progn

(setq lstpih (cons (list pti nomh) lstpih))

(setq lstpiv (cons (list pti nomv) lstpiv))

)

; Instructions pour le SINON du SI

(progn

 

)

)

(setq cptv (+ 1 cptv))

)

(setq cpth (+ 1 cpth))

)

(if (= direction "HOR")

(setq lstdr lstpih)

(setq lstdr lstpiv)

)

(foreach ssptdr lstdr

(setq pti (car ssptdr))

(setq ent (cadr ssptdr))

(cond

((= direction "HOR")

(setq pc1 (list (- (car pti) valcoup) (cadr pti)))

(setq pc2 (list (+ (car pti) valcoup) (cadr pti)))

)

((= direction "VER")

(setq pc1 (list (car pti) (- (cadr pti) valcoup)))

(setq pc2 (list (car pti) (+ (cadr pti) valcoup)))

)

)

; (command "coupure" (list ent pti) "p" pc1 pc2)

(setq entcp (ssget pc1))

(if entcp

(progn

(setq entcp (ssname entcp 0))

(setq datacp (entget entcp))

(if (= (cdr (assoc 0 datacp)) "LINE")

(command "coupure" pc1 "p" pc1 pc2)

)

)

)

)

)

)

;Restitution du contexte

(G_restaure_GLOBAL)

(G_restaure_VAR)

(setq *error* AW_OLD_ERROR)

(princ)

 

)

 

(princ "\tcoupres charge.")

(princ)

[Patrick_35]

Salut

 

Normalement, c'est cette ligne

(command "coupure" pc1 [surligneur]"p"[/surligneur] pc1 pc2)

Elle devient

(command "coupure" pc1 [surligneur]"_f"[/surligneur] pc1 pc2)

 

C'est un problème de traduction de la version française, premier devient 1er, d'où l'intérêt décrire ses prog avec les commandes anglaises (et dans ce cas _f pour first, ou tout simplement _first)

Une chose encore, pour les puristes, [surligneur]coupure[/surligneur] deviendrait [surligneur]_break[/surligneur]

 

@+

[mikL44]

merci bien, je regarde ca, et je reposte pour dire si ca marche

[mikL44]

ca marche pas

sniff

[Patrick_35]

Ah? ça fonctionne chez moi...

Tu as deux lignes de commande avec coupure (dont une avec un ; )

 

@+

 

[Edité le 11/1/2005 par Patrick_35]

[bonuscad]

Tu as du te "louper" quelque part, car j'ai essayer ton code sous 2002 en le corrigeant et cela à fonctionner sur une grille de ligne horzontale et verticale.

 

Je te donne la correction en te prévenant que j'ai inactivé les fonctions (G_sauve_VAR), (G_restaure_GLOBAL) et (G_restaure_VAR) car je ne les posède pas.

 

NB:Patrick_35 a raison: ce n'est qu'un problème de traduction

 

(defun c:coupres ( / valcoup ensh ensv ens nb cpt data ent pt1 pt2 direction entdir nbh nbv cpth cptv p1h p2h nomv datav nomh datah p1v p2v lstpih lstpiv lstdr ssptr pti pc1 pc2 entcp datacp)
;Initialisation de la fonction de gestion des erreurs
(setq AW_OLD_ERROR *error* *error* U_error)
;	(G_sauve_VAR '("celtype" "cecolor" "clayer" "cmdecho" "blipmode" "aflags" "attreq" "orthomode"))
(mapcar 'setvar '("cmdecho" "blipmode" "aflags" "attreq" "orthomode") '( 0 0 0 0 0 ))
(command "_.osnap" "_none")
(setq valcoup (getdist "\nEspacement <2.5> : "))
(if (null valcoup) (setq valcoup 2.5))
(setq ensh (ssadd))
(setq ensv (ssadd))
(princ "\nSelection du reseau...")
(setq ens (ssget (list (cons 0 "LINE"))))
(if ens
	(progn
;recuperation des lignes verticales et horizontales
		(setq nb (sslength ens))
		(setq cpt 0)
		(while (< cpt nb)
			(setq ent (ssname ens cpt))
			(setq data (entget ent))
			(setq pt1 (cdr (assoc 10 data)))
			(setq pt2 (cdr (assoc 11 data)))
			(if (= (car pt1) (car pt2))
				(setq ensv (ssadd ent ensv))
			)
			(if (= (cadr pt1) (cadr pt2))
				(setq ensh (ssadd ent ensh))
			)
			(setq cpt (+ 1 cpt))
		)
	)
)
(if (or (= (sslength ensh) 0) (= (sslength ensv) 0))
; ALORS
	(alert "Mauvais choix...Aucune intersection !")
; SINON...avec plusieurs instructions
	(progn
		(princ "\nDirection des coupures...")
		(setq direction nil)
		(setq entdir (car (entsel)))
		(if entdir
			(progn
				(cond
					((ssmemb entdir ensh)
						(setq direction "HOR")
					)
					((ssmemb entdir ensv)
						(setq direction "VER")
					)
					(T
						(setq direction nil)
					)
				)
			)
		)
	)
)
(if (null direction)
	(progn
		(if (not (or (= (sslength ensh) 0) (= (sslength ensv) 0)))
			(alert "\n\nMauvais choix dans la direction !")
		)
	)
	(progn
;recuperation des points d'intersection entre les horizontales et les verticales
		(setq nbh (sslength ensh))
		(setq nbv (sslength ensv))
		(setq cpth 0)
		(while (< cpth nbh)
			(setq nomh (ssname ensh cpth))
			(setq datah (entget nomh))
			(setq p1h (cdr (assoc 10 datah)))
			(setq p2h (cdr (assoc 11 datah)))
			(setq cptv 0)
			(while (< cptv nbv)
				(setq nomv (ssname ensv cptv))
				(setq datav (entget nomv))
				(setq p1v (cdr (assoc 10 datav)))
				(setq p2v (cdr (assoc 11 datav)))
				(if (setq pti (inters p1v p2v p1h p2h))
; Instruction pour le ALORS du SI
					(progn
						(setq lstpih (cons (list pti nomh) lstpih))
						(setq lstpiv (cons (list pti nomv) lstpiv))
					)
; Instructions pour le SINON du SI
					(progn
					)
				)
				(setq cptv (+ 1 cptv))
			)
			(setq cpth (+ 1 cpth))
		)
		(if (= direction "HOR")
			(setq lstdr lstpih)
			(setq lstdr lstpiv)
		)
		(foreach ssptdr lstdr
			(setq pti (car ssptdr))
			(setq ent (cadr ssptdr))
			(cond
				((= direction "HOR")
					(setq pc1 (list (- (car pti) valcoup) (cadr pti)))
					(setq pc2 (list (+ (car pti) valcoup) (cadr pti)))
				)
				((= direction "VER")
					(setq pc1 (list (car pti) (- (cadr pti) valcoup)))
					(setq pc2 (list (car pti) (+ (cadr pti) valcoup)))
				)
			)
;				(command "_.break" (list ent pti) "_first" pc1 pc2)
			(setq entcp (ssget pc1))
			(if entcp
				(progn
					(setq entcp (ssname entcp 0))
					(setq datacp (entget entcp))
					(if (= (cdr (assoc 0 datacp)) "LINE")
						(command "_.break" pc1 "_first" pc1 pc2)
					)
				)
			)
		)
	)
)
;Restitution du contexte
;	(G_restaure_GLOBAL)
;	(G_restaure_VAR)
(setq *error* AW_OLD_ERROR)
(princ)
)
(princ "\tcoupres charge.")
(princ)

[Patrick_35]

Tu as raison BonusCad, il est beaucoup plus simple de donner la version complète que de dire seulement où se situe l'erreur, m'enfin...

http://smileys.smileycentral.com/cat/36/36_11_7.gif

 

@+

[Pako]

Effectivement, ça fonctionne aussi sous la version 2004 en anglais !

 

Bravo les mecs ! ;)

[mikL44]

Je tiens à vous remercier tous, le prog fonctionne effectivement bien, mais j'ai du mal m'expliquer, en fait avant sous la 14 quand on inserait par exemple un symbole de vanne sur une ligne, le symbole coupait la ligne automatiquement, en fait j'ai du vous transmettre le mauvais LISP (y'en a une telle tripatouillé dans notre biblio), il faut que je retrouve le fameux prog qui coupait les lignes automatiquement, et je vous le transmet.

 

merci