lisp creation de calques en fonctionde la couleur forcées des objetss

philsogood · le 6 janvier 2020

hello

bonne année et meilleurs voeux à tous

je travaille actuellement sur un ficheir PDF que j'ai craqué avec AutoCAD

le problème c'est que les fichiers ainsi générés sont tous sur le même calques, seule la couleur change en fonction de objets

connaitriez vous un lisp qui permettrait de mettre ces objets dont les couleurs sont forcées sur un calque reprenant ces couleurs comme nouveau calque afin de pouvoir travailler avec de vrais calques plutot qu'un seul qui a une vingtaines de couleurs forcées?

Phil

PHILPHIL · le 6 janvier 2020

hello philsogood

bonne année a tous

voici un lisp,

il répartie dans des calques en fonction de la couleur de l’entité, type entité, épaisseur entité

(defun c:mdfc ()
 (vl-load-com)
 (setvar "cmdecho" 0)
 (setvar "dimzin" 0)
 (setvar "osmode" 0)
 (prompt "\nLE NOM DU CALQUE COMMENCERA PAR CALQUE ... :")
 (prompt "\nCLIQUER SUR LES OBJETS A DEPLACER DE CALQUE :")
 (setq entites nil)
 (while (null entites) (setq entites (ssget)))
 (setq compt 0)
 (setq com (sslength entites))
 (while (< compt com)
   (progn (setq ent1 (ssname entites compt))
          (setq code1 (cdr (assoc -1 (entget ent1))))
          (setq ena1 (vlax-ename->vla-object code1))
          (setq typeobjet (vla-get-objectname ena1))
          (setq proper1 (vlax-get-property ena1 'truecolor))
          (setq colorr (vlax-get-property proper1 'colorindex))
          (setq blue (vlax-get-property proper1 'blue))
          (setq green (vlax-get-property proper1 'green))
          (setq red (vlax-get-property proper1 'red))
          (setq rgb (strcat (rtos red 2 0) "," (rtos green 2 0) "," (rtos blue 2 0)))
          (setq ligntype (vla-get-linetype ena1))
          (setq eplign (vla-get-lineweight ena1))
          (setq calquenew (strcat "CALQUE " typeobjet " " (rtos colorr 2 0) " " ligntype " " (rtos eplign 2 0) "ep"))
          (if (or (= colorr 256) (= colorr 0))
            (setq colorr 7)
          )
          (if (= (tblsearch "layer" calquenew) nil)
            (vl-cmdf "-calque" "n" calquenew "co"
                     colorr calquenew "tl"
                     ligntype calquenew "in" calquenew "")
          )
          (vla-put-layer ena1 calquenew)
          (vlax-put-property proper1 'colorindex 256)
          (vlax-put-property ena1 'truecolor proper1)
          (vla-put-lineweight ena1 -1)  
          (vla-put-linetype ena1 "bylayer")
          (setq compt (1+ compt))
          (prompt (strcat "\rENTITE DEPLACEE : " (rtos compt 2 0) " SUR : " (rtos com 2 0) " "))
   )
 )
)

j'en ai un aussi pour le RGB

a+

Phil

bonuscad · le 6 janvier 2020

Bonjour,

Pour des entités ayant des couleurs vraies (RGB), j'avais écrit ça:

((lambda ( / js n dxf_ent c_true c_rgb l_name)
(setq js (ssget "_X"))
(cond
	(js
		(repeat (setq n (sslength js))
			(setq
				c_true nil
				dxf_ent (entget (ssname js (setq n (1- n))))
				c_true (if (assoc 420 dxf_ent) (cdr (assoc 420 dxf_ent)) nil)
			)
			(if (and (not c_true) (assoc 62 dxf_ent))
				(if (or (/= (cdr (assoc 62 dxf_ent)) 256) (/= (cdr (assoc 62 dxf_ent)) 0))
					(setq c_true (cdr (assoc 62 dxf_ent)))
					(setq c_true 7)
				)
				(if (not (assoc 62 dxf_ent)) (setq c_true 256))
			)
			(cond
				(c_true
					(if (> c_true 256)
						(setq
							c_rgb (mapcar '(lambda ( x ) (lsh (lsh (fix  c_true) x) -24)) '(8 16 24))
							l_name (apply 'strcat (mapcar 'strcat (mapcar 'itoa c_rgb) '("-" "-" "")))
						)
						(setq
							c_rgb c_true
							l_name (itoa c_rgb)
						)
					)
					(if (not (tblsearch "LAYER" l_name))
						(entmake
							(list
								(cons 0 "LAYER")
								(cons 100 "AcDbSymbolTableRecord")
								(cons 100 "AcDbLayerTableRecord")
								(cons 2  l_name)
								(cons 70 0)
								(if (> c_true 256)
									(cons 420 c_true)
									(cons 62 c_true)
								)
								(cons 6 "Continuous")
								(cons 290 1)
								(cons 370 -3)
							)
						)
					)
					(foreach el '(430 420) (if (assoc el dxf_ent) (entmod (setq dxf_ent (vl-remove (assoc el dxf_ent) dxf_ent)))))
					(entmod
						(subst
							(cons 8 l_name)
							(assoc 8 dxf_ent)
							(if (assoc 62 dxf_ent) (subst '(62 . 256) (assoc 62 dxf_ent) dxf_ent) dxf_ent)
						)
					)
				)
			)
		)
	)
)
(prin1)
))

philsogood · le 6 janvier 2020

yep

merci à vous deux

perso je prefère le lisp de bonuscad pour la simple et bonne raison qu'il génère moins de calque

le seul souci c'est que j'ai aussi des couleurs de l'index (de 1 à 255) et du coup j'ai des objets qui ne sont aps traités... :(

philsogood · le 6 janvier 2020

du coup j vais essayer de bricoler le lisp de philphil mais ya moyen que ça marche plus après que j'ai enlever 2-3 trucs... :)

Phil

Olivier Eckmann · le 6 janvier 2020

Bonjour,

Si tu as un AutoCAD MAP3D ou Civil 3D, tu peux passer par une requête en mode "Dessiner" avec "Altération des propriétés" en utilisant la couleur comme nom de calque.

Olivier

PHILPHIL · le 6 janvier 2020

hello

la version RGB

(defun c:MDFC_RGB ()
 (vl-load-com)
 (setvar "cmdecho" 0)
 (setvar "dimzin" 0)
 (setvar "osmode" 0)
 (prompt "\nLE NOM DU CALQUE COMMENCERA PAR CALQUE ... :")
 (prompt "\nCLIQUER SUR LES OBJETS A DEPLACER DE CALQUE :")
 (setq entites nil)
 (while (null entites) (setq entites (ssget)))
 (setq compt 0)
 (setq com (sslength entites))
 (while (< compt com)
   (progn (setq ent1 (ssname entites compt))
          (setq code1 (cdr (assoc -1 (entget ent1))))
          (setq ena1 (vlax-ename->vla-object code1))
          (setq typeobjet (vla-get-objectname ena1))
          (setq proper1 (vlax-get-property ena1 'truecolor))
          (setq colorr (vlax-get-property proper1 'colorindex))
          (setq blue (vlax-get-property proper1 'blue))
          (setq green (vlax-get-property proper1 'green))
          (setq red (vlax-get-property proper1 'red))
          (setq rgb (strcat (rtos red 2 0) "," (rtos green 2 0) "," (rtos blue 2 0)))
          (setq ligntype (vla-get-linetype ena1))
          (setq eplign (vla-get-lineweight ena1))
          (setq calquenew (strcat "CALQUE " typeobjet " " (strcat (rtos red 2 0) " " (rtos green 2 0) " " (rtos blue 2 0)) " " ligntype " " (rtos eplign 2 0) "ep"))
     
          (if (or (= colorr 256) (= colorr 0))
            (setq colorr 7)
          )

          (if (= (tblsearch "layer" calquenew) nil) (vl-cmdf "-calque" "n" calquenew "co" "u" rgb calquenew "tl" ligntype calquenew "in" calquenew "")
          )
          (vla-put-layer ena1 calquenew)
          (vlax-put-property proper1 'colorindex 256)
          (vlax-put-property ena1 'truecolor proper1)
          (vla-put-lineweight ena1 -1)
          (setq compt (1+ compt))
          (prompt (strcat "\rENTITE DEPLACEE : " (rtos compt 2 0) " SUR : " (rtos com 2 0) " "))
   )
 )
)

Phil

bonuscad · le 7 janvier 2020

yep
merci à vous deux
perso je prefère le lisp de bonuscad pour la simple et bonne raison qu'il génère moins de calque
le seul souci c'est que j'ai aussi des couleurs de l'index (de 1 à 255) et du coup j'ai des objets qui ne sont aps traités... :(

J'ai modifié le code en réponse #3.Normalement après quelque tests rapides, cela devrait fonctionner indifféremment avec les couleurs: ACI, RGB et Pantone...

philsogood · le 7 janvier 2020

merci toutes et tous (même si toutes n'étaient pas là)

un code qui sera bien utile... on se demande pourquoi AutoCAD n'a pas fait un truc mieux lecher pour l'import de PDF

Phil

philsogood · le 7 janvier 2020

(ça marche nickel ton lisp Bonuscad!!!)

bonuscad · le 7 janvier 2020

(ça marche nickel ton lisp Bonuscad!!!)

Merci du retour, j'ai fais encore une petite modif (au cas ou ! ) pour que les objets prennent la couleur du calque et ne gardent pas leur couleur d'origine.

Steven · le 8 janvier 2020

Bonjour,

Pour des entités ayant des couleurs vraies (RGB), j'avais écrit ça:

((lambda ( / js n dxf_ent c_true c_rgb l_name)
(setq js (ssget "_X"))
(cond
	(js
		(repeat (setq n (sslength js))
			(setq
				c_true nil
				dxf_ent (entget (ssname js (setq n (1- n))))
				c_true (if (assoc 420 dxf_ent) (cdr (assoc 420 dxf_ent)) nil)
			)
			(if (and (not c_true) (assoc 62 dxf_ent))
				(if (or (/= (cdr (assoc 62 dxf_ent)) 256) (/= (cdr (assoc 62 dxf_ent)) 0))
					(setq c_true (cdr (assoc 62 dxf_ent)))
					(setq c_true 7)
				)
				(if (not (assoc 62 dxf_ent)) (setq c_true 256))
			)
			(cond
				(c_true
					(if (> c_true 256)
						(setq
							c_rgb (mapcar '(lambda ( x ) (lsh (lsh (fix  c_true) x) -24)) '(8 16 24))
							l_name (apply 'strcat (mapcar 'strcat (mapcar 'itoa c_rgb) '("-" "-" "")))
						)
						(setq
							c_rgb c_true
							l_name (itoa c_rgb)
						)
					)
					(if (not (tblsearch "LAYER" l_name))
						(entmake
							(list
								(cons 0 "LAYER")
								(cons 100 "AcDbSymbolTableRecord")
								(cons 100 "AcDbLayerTableRecord")
								(cons 2  l_name)
								(cons 70 0)
								(if (> c_true 256)
									(cons 420 c_true)
									(cons 62 c_true)
								)
								(cons 6 "Continuous")
								(cons 290 1)
								(cons 370 -3)
							)
						)
					)
					(foreach el '(430 420) (if (assoc el dxf_ent) (entmod (setq dxf_ent (vl-remove (assoc el dxf_ent) dxf_ent)))))
					(entmod
						(subst
							(cons 8 l_name)
							(assoc 8 dxf_ent)
							(if (assoc 62 dxf_ent) (subst '(62 . 256) (assoc 62 dxf_ent) dxf_ent) dxf_ent)
						)
					)
				)
			)
		)
	)
)
(prin1)
))

Salut bonuscad,

Tu fais comment pour utiliser ta routines ?

didier · le 8 janvier 2020

Coucou

Un copier-coller en ligne de commande, simplement

Amitiés à toi mon copain que j'ai...

philsogood · le 8 janvier 2020

Steven,

toi qui est formateur avec un nombre hallucinant de titre de formateur sous forme d'acronyme tu ne sais aps ça??? :P

Phil

bonuscad · le 8 janvier 2020

Salut bonuscad,
Tu fais comment pour utiliser ta routines ?

Didier t'a répondu!

Pour compléter un peu la réponse; (lambda) est une fonction anonyme, lorsque tu lance celle ci elle s’exécute mais ne reste pas en mémoire (elle n'est valable qu'une seule fois lors de son appel).

Je fais souvent cela pour des tâches qui ne seront exécuter qu'une seule fois, car une fois toutes les entités traitées, la fonction devient inutile, donc aucune nécessité de la relancer. En faire une commande à l'aide de (defun C:) est inutile (bien que ça reste possible mai sans intérêt). Pourquoi encombrer la mémoire avec une commande qui ne sera plus utiliser ultérieurement dans la session?

Lambda est bien pour des fonctions ponctuelles.

NB: Cela n'empêche pas de déclarer les variables en local dans la fonction lambda pour éviter là aussi un encombrement inutile mais aussi d'éviter des conflit avec un autre programme qui aurait les même variables non déclarée en locale. Beaucoup de gens qui s'initient au lisp oublient souvent de déclarer leurs variables, bien que cela ne remette pas en cause leur code, cela peut produire des erreurs d’exécution que l'on peut avoir du mal a identifier pour dé-bugger.

VDH-Bruno · le 8 janvier 2020

Salut bonuscad,
Tu fais comment pour utiliser ta routines ?

Bonsoir Steven,

Bien que bonuscad est complété et justifié l'emploi d'une fonction lambda, je vais profité de ce sujet pour espérer rappeler à certains et préciser à d'autres 2 ou 3 petites choses concernant la syntaxe des fonctions defun et lambda.

Donc pour ce qui est du code proposé par bonuscad, c'est une fonction anonyme (une fonction qui n'a pas de nom), la fonction n'étant pas nommé elle ne peut s’appeler qu'à l'endroit ou elle est définie.

Exemple de définition d'une fonction anonyme.

_$ (lambda (/) (princ "\nHello World") (princ))
#<USUBR @000000003e859bd8 -lambda->

Pour la lancer en ligne de commande ou dans un lisp, il suffit de mettre la définition de la fonction entre parenthèses

(suivie de ses éventuelles arguments comme pour une fonction nommée définie avec defun).

Exemple de lancement sur la ligne de commande d'une fonction anonyme comme celle proposé par Bonuscad

Commande: ((lambda (/) (princ "\nHello World") (princ)))
Hello World

Pour faire un parallèle avec une fonction nommée défini au moyen de la fonction defun, on aurait:

_$ (defun salutation (/) (princ "\nHello World") (princ))
SALUTATION

Pour lancer une fonction nommée, il suffit mettre son nom dans une liste (c.a.d. de la mettre entre parenthèse suivie de ses éventuelles arguments)

Commande: (salutation)
Hello World

On peut toute fois noter une légère différence entre les 2 définitions de fonction: la première définie avec lambda retourne la définition de fonction (USUBR) alors que la seconde définie avec defun retourne le symbole (SYM) auquel est associé la définition de fonction.

_$ (type (lambda (/) (princ "\nHello World") (princ)))
USUBR
_$ (type (defun salutation (/) (princ "\nHello World") (princ)))
SYM

C'est pourquoi si on veut comme dans le cas de la fonction lambda, appeler une fonction nommée à l'endroit ou elle est définie, il faut pouvoir accéder à sa définition par l'évaluation du symbole retourné au moyen de la fonction eval, puis mettre sa définition dans une liste d'appel suivi de ses éventuelles arguments.

Commande: ((eval (defun salutation (/) (princ "\nHello World") (princ))))
Hello World

Avec AutoCAD on a la possibilité d'appeler une fonction lisp directement à la ligne de commande sans avoir besoin de mettre la fonction dans une liste d'appel, pour cela il suffit de faire précéder le nom de la fonction définie en lisp par c:, comme il n'y a théoriquement plus de liste d'appel dans AutoCAD, il n'y a plus d'intérêt à passer des d'arguments aux fonctions définie en c:ma_fonction.

Exemple de définition d'une fonction en c:

_$ (defun c:salutation (/) (princ "\nHello World") (princ))
C:SALUTATION

Son lancement depuis la ligne de commande d'AutoCAD

Commande: SALUTATION
Hello World

Bien que la fonction se lance directement depuis la ligne de commande, comme toute commande AutoCAD, elle reste une fonction lisp et doit être appelé comme tel depuis un lisp. Mais par abus de langage on qualifie généralement de ce type de fonction de "commande lisp"

Exemple d'appel d'une fonction définie en c: depuis une fonction lambda

_$ ((lambda () (C:SALUTATION)))
Hello World

A+

Steven · le 9 janvier 2020

Salut,

En effet, je me suis souvenu, un peu plus tard, après avoir poser, la question, en allant à un rendez-vous, que j'avais déjà poser poser la question, il y a pas mal de temps pour charger ce genre de routine sans commande. Mais en revenant chez moi, je n'ai plus pensé à faire le test du Copier / Coller.

En tout cas, merci Didier pour avoir confirmé ce que je pensais, merci bonuscad pour l'explication du pourquoi tu n'en faisait pas un lisp chargeable du fait que c'est une routine qu'on utilise pas souvent et merci Bruno pour tes explications bien que je ne sache pas développé de routines ou de lisp, j'ai tout de même compris (un peu) tes explications

Steven · le 9 janvier 2020

Steven,
toi qui est formateur avec un nombre hallucinant de titre de formateur sous forme d'acronyme tu ne sais aps ça??? :P
Phil

Salut philsogood,

Sache que les certifications dont tu parles sont des certifications nous sont imposés dont certaines, par l'Etat pour pouvoir exercer notre métier.

Elle ne sont pas forcément en rapport avec les connaissances métiers mais surtout liées à une question administrative.

On se passerait bien, nous formateurs et formatrices de devoir passer ces certifications, qui sont chères, de surcroît et de se taper tout un tas de paperasse, pour se concentrer sur notre métier. La dernière certification que j'ai passé, m'a bien pris la tête. Soit elle n'a rien à voir avec les connaissances logiciel, rien à voir avec AutoCAD ou le développement et l'utilisation des routines mais on est obligé de l'avoir si on veut pouvoir continuer à bosser. Et en plus, elle n'est pas définitive.

Aussi, de plus en plus d'OF demandent au formateurs s'ils sont certifiés. Ça les rassurent. Mais ça ne tient pas compte des réelles connaissances et du réel savoir faire du formateur ou de la formatrice.

lili2006 · le 12 janvier 2020

Bonjour à toutes et tous,

Si tu as un AutoCAD MAP3D ou Civil 3D, tu peux passer par une requête en mode "Dessiner" avec "Altération des propriétés" en utilisant la couleur comme nom de calque.

Olivier, même depuis un ".pdf" ??!!

Ou après génération avec la fonction "importpdf" ?

Merci d'avance,

Olivier Eckmann · le 13 janvier 2020

Bonjour Lilian,

Les requêtes MAP ne fonctionnent que sur les fichiers DWG, donc c'est après conversion d'un PDF en DWG comme indiqué dans le message initial.

Olivier

lili2006 · le 13 janvier 2020

Bonsoir à toutes et tous,

Salut Olivier,

donc c'est après conversion d'un PDF en DWG

Oui c'est ce que je voulais dire, désolé je me suis mal exprimé,..

Cool si ça marche alors !!

Dés que j'ai le temps, je teste,

Merci pour cette nouvelle astuce car je rejoint Phil, c'est nul ce que propose AutoCAD par défaut,...

Olivier Eckmann · le 14 janvier 2020

Lilian,

ci-joint la procédure pour la requête : ICI

Olivier

philsogood · le 15 janvier 2020

hello

marche pas ton lien Olivier!! ;)

Phil

dilack · le 15 janvier 2020

Salut,

Ben si, il fonctionne très bien même...

lili2006 · le 16 janvier 2020

Bonjour à toutes et tous,

Olivier,

Merci pour la démarche sur MAP. Simple et bougrement efficace

J'ai juste un problème de "forçage" des couleurs de calques.Est ce lié au ".pdf" de départ ou bien aurais je raté une option sous MAP !!

Merci d'avance,

lisp creation de calques en fonctionde la couleur forcées des objetss

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Information importante