Aller au contenu

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


Messages recommandés

Posté(e)

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

Projeteur Revit Indépendant - traitement des eaux/CVC

Posté(e)

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

FREELANCE

Autodesk Architecture 2025 sous windows 11 64

REVIT

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Posté(e)

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)
))
 

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

Posté(e)

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... :(

Projeteur Revit Indépendant - traitement des eaux/CVC

Posté(e)

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

FREELANCE

Autodesk Architecture 2025 sous windows 11 64

REVIT

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Posté(e)

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...

 

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

Posté(e)

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

Projeteur Revit Indépendant - traitement des eaux/CVC

Posté(e)

(ç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.

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

Posté(e)

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 ?

Steven________________________________________

Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.

Pour le perso Linux Mint et pas de problèmes. Mais pas d'AutoCAD.

En rêve; AutoCAD sous Linux.

Posté(e)

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.

 

 

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

Posté(e)

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+

Apprendre => Prendre => Rendre

Posté(e)

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 smile.gif

 

Steven________________________________________

Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.

Pour le perso Linux Mint et pas de problèmes. Mais pas d'AutoCAD.

En rêve; AutoCAD sous Linux.

Posté(e)

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.

Steven________________________________________

Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.

Pour le perso Linux Mint et pas de problèmes. Mais pas d'AutoCAD.

En rêve; AutoCAD sous Linux.

Invité
Répondre à ce sujet…

×   Collé en tant que texte enrichi.   Coller en tant que texte brut à la place

  Seulement 75 émoticônes maximum sont autorisées.

×   Votre lien a été automatiquement intégré.   Afficher plutôt comme un lien

×   Votre contenu précédent a été rétabli.   Vider l’éditeur

×   Vous ne pouvez pas directement coller des images. Envoyez-les depuis votre ordinateur ou insérez-les depuis une URL.

×
×
  • 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é