Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Modification de lisp, s'il vous plaît.

Neo83

Par Neo83
dans LISP et Visual LISP

 Partager

Messages recommandés

Neo83 Newbie

Neo83

Posté(e)
Posté(e)

Bonjour,J'ai trouvé sur ce site, il y a longtemps déjà ce lisp qui fait les tableaux de surfaces. Celui-ci me rend de sacré services tous les jours de travail. Et merci à celui qui l'a écrit.Je souhaiterais toutefois un légère modification qui consisterait à ranger les noms des pièces par ordre alphabétique lors de l'insertion du tableau. AutoCAD ne permet pas de le faire après.Si j'extrais en CSV et que je réimporte le tableau en CSV, je perd le côté dynamique des surfaces, et ceci est très dommage.

Je ne suis qu'un utilisateur de fichiers lisp, c'est pour cela que je fais appelle à votre communauté.

Je vous remercie pour votre aide.

 

Le lisp en question:(Il est aussi en fichier joint)

 

(defun c:tabsurf ( / js js_sel n obj vla_obj oldim oldlay AcDoc Space nw_style ins_pt_cell h_t w_c ename_cell n_row n_column)

(setq js (ssget '((0 . "LWPOLYLINE"))))

(setq js_sel (ssadd))

(repeat (setq n (sslength js))

(setq obj (ssname js (setq n (1- n))))

(if (vlax-ldata-get (setq vla_obj (vlax-ename->vla-object obj)) "SURF2")

(ssadd obj js_sel)

)

)

(cond

(js_sel

(setq

oldim (getvar "dimzin")

oldlay (getvar "clayer")

)

(setq

AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))

Space

(if (= 1 (getvar "CVPORT"))

(vla-get-PaperSpace AcDoc)

(vla-get-ModelSpace AcDoc)

)

)

(cond

((null (tblsearch "LAYER" "Tableaux-Métrés"))

(vla-add (vla-get-layers AcDoc) "Tableaux-Métrés")

)

)

(cond

((null (tblsearch "STYLE" "TEXTE"))

(setq nw_style (vla-add (vla-get-textstyles AcDoc) "TEXTE"))

(vlax-put nw_style 'fontfile "romand.shx")

(vlax-put nw_style 'height 0.0)

(vlax-put nw_style 'obliqueangle (/ (* 15.0 pi) 180))

(vlax-put nw_style 'width 1.0)

(vlax-put nw_style 'textgenerationflag 0.0)

)

)

(setvar "dimzin" 0) (setvar "clayer" "Tableaux-Métrés")

(initget 9)

(setq ins_pt_cell (getpoint "\nPoint d'insertion haut gauche du tableau: "))

(initget 6)

(setq h_t (getdist ins_pt_cell (strcat "\nHauteur du texte <" (rtos (getvar "textsize")) ">: ")))

(if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))

(initget 7)

(setq w_c (getdist ins_pt_cell "\nLargeur des cellules: "))

(setq ename_cell (vla-addTable Space (vlax-3d-point (trans ins_pt_cell 1 0)) (+ 3 (sslength js_sel)) 2 (+ h_t (* h_t 0.25)) w_c))

(setq n_row 2 n_column -1)

(vla-SetText ename_cell 0 0 "SURFACES")

(vla-SetCellTextStyle ename_cell 0 0 "TEXTE")

(vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5))

(vla-SetCellAlignment ename_cell 0 0 5)

(foreach string '("LOCAUX" "SUPERFICIES (m²)")

(vla-SetText ename_cell 1 (setq n_column (1+ n_column)) string)

(vla-SetCellTextStyle ename_cell 1 n_column "TEXTE")

(vla-SetCellTextHeight ename_cell 1 n_column (vlax-make-variant h_t 5))

(vla-SetCellAlignment ename_cell 1 n_column 5)

)

(setq n_column -1)

(repeat (setq n (sslength js_sel))

(setq ename (vlax-ename->vla-object (ssname js_sel (setq n (1- n)))))

(if (vlax-property-available-p ename 'Area)

(progn

(vla-SetText ename_cell n_row (setq n_column (1+ n_column))

(vlax-ldata-get ename "SURF2")

)

(vla-SetCellTextStyle ename_cell n_row n_column "TEXTE")

(vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5))

(vla-SetCellAlignment ename_cell n_row n_column 6)

(vla-SetText ename_cell n_row (setq n_column (1+ n_column))

(strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr2%ps>%")

)

(vla-SetCellTextStyle ename_cell n_row n_column "TEXTE")

(vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5))

(vla-SetCellAlignment ename_cell n_row n_column 6)

(setq n_row (1+ n_row) n_column -1)

)

)

)

(setq n_column 1)

(vla-SetText ename_cell n_row n_column

(strcat "Total= " "%<\\AcExpr (Sum(B3:B" (itoa n_row) ")) \\f \"%lu2%pr1\">%")

)

(vla-SetCellTextStyle ename_cell n_row (1- (length lst_idcolumn)) "TEXTE")

(vla-SetCellTextHeight ename_cell n_row (1- (length lst_idcolumn)) (vlax-make-variant h_t 5))

(vla-SetCellAlignment ename_cell n_row (1- (length lst_idcolumn)) 6)

(vlax-release-object ename_cell)

(vlax-release-object Space)

(setvar "dimzin" oldim) (setvar "clayer" oldlay)

)

(T

(princ "\nSélection vide!")

)

)

)

Sans nous, les machines ne sont rien

Luna Experienced

Luna

Posté(e)
Posté(e)

Coucou,

 

Le plus simple pour trier c'est à partir d'une liste. Donc comme le programme effectue la création du tableau à partir d'un jeu de sélection, il faut modifier un peu le programme pour le faire correspondre à une liste.

L'idée serait de créer une liste de paire pointée avec le nom de la pièce et le nom de l'objet et ainsi de créer le tableau à partir de la liste triée.

 

Je n'ai pas beaucoup de temps aujourd'hui mais lorsque ce sera bon, je reviendrai vers toi :3

 

Bisous,

Luna

Neo83 Newbie

Neo83

Posté(e)
  • Auteur
Posté(e)

Bonjour Luna,Je te remercie pour ta réponse et pour le temps que tu me donneras pour réaliser ma demande.

A bientôt.

 

Sans nous, les machines ne sont rien

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Bonjour,J'ai trouvé sur ce site, il y a longtemps déjà ce lisp qui fait les tableaux de surfaces. Celui-ci me rend de sacré services tous les jours de travail. Et merci à celui qui l'a écrit.Je souhaiterais toutefois un légère modification qui consisterait à ranger les noms des pièces par ordre alphabétique lors de l'insertion du tableau. AutoCAD ne permet pas de le faire après.Si j'extrais en CSV et que je réimporte le tableau en CSV, je perd le côté dynamique des surfaces, et ceci est très dommage.

Je ne suis qu'un utilisateur de fichiers lisp, c'est pour cela que je fais appelle à votre communauté.

Je vous remercie pour votre aide.

 

Le lisp en question:(Il est aussi en fichier joint)

 

 

Bonjour,

 

Comme je reconnais quelque traits de ma patte d'écriture de ce lisp (quelque peu modifié/adapté par un autre que moi), il m'es assez facile de te proposer la modif...

Donc rapidement, ça donnerais ceci

(defun c:tabsurf ( / js js_sel n obj vla_obj oldim oldlay AcDoc Space nw_style ins_pt_cell h_t w_c ename_cell n_row n_column ename data_sort)
(setq js (ssget '((0 . "LWPOLYLINE"))))
(setq js_sel (ssadd))
(repeat (setq n (sslength js))
	(setq obj (ssname js (setq n (1- n))))
	(if (vlax-ldata-get (setq vla_obj (vlax-ename->vla-object obj)) "SURF2")
		(ssadd obj js_sel)
	)
)
(cond
	(js_sel
		(setq
			oldim (getvar "dimzin")
			oldlay (getvar "clayer")
		)
		(setq
			AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
			Space
			(if (= 1 (getvar "CVPORT"))
				(vla-get-PaperSpace AcDoc)
				(vla-get-ModelSpace AcDoc)
			)
		)
		(cond
			((null (tblsearch "LAYER" "Tableaux-Métrés"))
				(vla-add (vla-get-layers AcDoc) "Tableaux-Métrés")
			)
		)
		(cond
			((null (tblsearch "STYLE" "TEXTE"))
				(setq nw_style (vla-add (vla-get-textstyles AcDoc) "TEXTE"))
				(vlax-put nw_style 'fontfile "romand.shx")
				(vlax-put nw_style 'height 0.0)
				(vlax-put nw_style 'obliqueangle (/ (* 15.0 pi) 180))
				(vlax-put nw_style 'width 1.0)
				(vlax-put nw_style 'textgenerationflag 0.0)
			)
		)
		(setvar "dimzin" 0) (setvar "clayer" "Tableaux-Métrés")
		(initget 9)
		(setq ins_pt_cell (getpoint "\nPoint d'insertion haut gauche du tableau: "))
		(initget 6)
		(setq h_t (getdist ins_pt_cell (strcat "\nHauteur du texte <" (rtos (getvar "textsize")) ">: ")))
		(if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
		(initget 7)
		(setq w_c (getdist ins_pt_cell "\nLargeur des cellules: "))
		(setq ename_cell (vla-addTable Space (vlax-3d-point (trans ins_pt_cell 1 0)) (+ 3 (sslength js_sel)) 2 (+ h_t (* h_t 0.25)) w_c))
		(setq n_row 2 n_column -1)
		(vla-SetText ename_cell 0 0 "SURFACES")
		(vla-SetCellTextStyle ename_cell 0 0 "TEXTE")
		(vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5))
		(vla-SetCellAlignment ename_cell 0 0 5)
		(foreach string '("LOCAUX" "SUPERFICIES (m²)")
			(vla-SetText ename_cell 1 (setq n_column (1+ n_column)) string)
			(vla-SetCellTextStyle ename_cell 1 n_column "TEXTE")
			(vla-SetCellTextHeight ename_cell 1 n_column (vlax-make-variant h_t 5))
			(vla-SetCellAlignment ename_cell 1 n_column 5)
		)
		(setq n_column -1)
		(repeat (setq n (sslength js_sel))
			(setq ename (vlax-ename->vla-object (ssname js_sel (setq n (1- n)))))
			(if (vlax-property-available-p ename 'Area)
				(setq data_sort (cons (cons (vlax-ldata-get ename "SURF2") (itoa (vla-get-ObjectID ename))) data_sort))
			)
		)
		(foreach el (vl-sort data_sort '(lambda (e1 e2) (< (car e1) (car e2))))
			(vla-SetText ename_cell n_row (setq n_column (1+ n_column)) (car el))
			(vla-SetCellTextStyle ename_cell n_row n_column "TEXTE")
			(vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5))
			(vla-SetCellAlignment ename_cell n_row n_column 6)
			(vla-SetText ename_cell n_row (setq n_column (1+ n_column))
				(strcat "%<\\AcObjProp Object(%<\\_ObjId " (cdr el) ">%).Area \\f \"%lu2%pr2%ps>%")
			)
			(vla-SetCellTextStyle ename_cell n_row n_column "TEXTE")
			(vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5))
			(vla-SetCellAlignment ename_cell n_row n_column 6)
			(setq n_row (1+ n_row) n_column -1)
		)
		(setq n_column 1)
		(vla-SetText ename_cell n_row n_column
			(strcat "Total= " "%<\\AcExpr (Sum(B3:B" (itoa n_row) ")) \\f \"%lu2%pr1\">%")
		)
		(vla-SetCellTextStyle ename_cell n_row (1- (length lst_idcolumn)) "TEXTE")
		(vla-SetCellTextHeight ename_cell n_row (1- (length lst_idcolumn)) (vlax-make-variant h_t 5))
		(vla-SetCellAlignment ename_cell n_row (1- (length lst_idcolumn)) 6)
		(vlax-release-object ename_cell)
		(vlax-release-object Space)
		(setvar "dimzin" oldim) (setvar "clayer" oldlay)
	)
	(T
		(princ "\nSélection vide!")
	)
)
)

 

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

Hello Bruno et Neo83

 

SVP qq explications sur cette routine !?

 

J ai vu qu elle traite les LWPLines ! Sur un calque particulier !?

Mais a part ca !

 

A part ces LWPLines, y a t il d autres contraintes de dessin ?

Texte sur un calque particulier, etc ??

 

Merci de tes lumieres !

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

Autodesk Expert Elite Team

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Salut Patrice,

 

En fait cela fait appel à 2 routines, utiliser celle ci seule ne fera pas grand chose.

Je ne retrouve pas sur CadXp les publications que j'avais pu faire (trop ancien?)

Mais si tu veux, consulte cette discussion toute récente, les 2 routines similaires y sont, je pense que tu comprendra le principe...

En résumé: au lieu d'utiliser un bloc avec des attributs, tu utilises des données étendues pour stocker des informations sur un objet.

 

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité