routine polyligne vers bloc

[philsogood]

hello
petit concours de l'été, une bière pour le gagnant
bon je sais pas ce que je vais donner au gagnant car il habitera trop loin...
du coup...

je cherche un programme pour transformer des polylignes "caractéristiques" en bloc
les polylignes sont les rectangles rouges, les blocs sont en blanc...
en fait il s'agira du même bloc qui pourrait tourner se besoin...
il n'y a que 2 positions possibles : 0 ou 90°
après si ya 2 blocs c'est aps très grave non plus 🙂
comme vous l'aurez peur être remarqué, le bloc n'est symétrique, sur ce registre il y a la tige qui sort du rectangle : sa position n' aucune importance
merci pour votre aide, mon ficheir comporte 300 PL
Phil

PS : si j'ai fait des fautes de frappe vous gagnez une deuxième bière!

 

registre_PL_vers_bloc.dwg

[(gile)]

Salut,

D'abord une bière pour la faute de frappe.

Ensuite, le fichier joint ne contient pas de bloc. Il faudrait préciser s'il faut remplacer les polylignes par un bloc existant ou si le programme doit créer le bloc.

[philsogood]

@(gile) je savais qu'il y aurait des faites de frappe 🙂

en PJ le bloc à insérer

laisse tomber pour les lignes se superposant, ça c'est accessible à mes petits doigts

en y réflechissant, si la languette du registre peut être toujours à droite ou toujours en haut (si registre horizontal ou vertical), je prends

Phil

registre_ailettes.dwg

[(gile)]

Au vu des éléments fournis et de ma totale méconnaissance des registres, ailettes et autres languettes, le LISP ci dessous devrait répondre ou en tout cas fornir une base modifiable.

(defun c:test (/ massoc isValid ss i elst pts ll ur pt rot)
  
  (defun massoc	(key alst)
    (if	(setq alst (member (assoc key alst) alst))
      (cons (cdar alst) (massoc key (cdr alst)))
    )
  )
  
  (defun rectanglep (pts)
    (and
      (= (length pts) 4)
      (or
	(and
	  (= (car (car pts)) (car (cadr pts)))
	  (= (cadr (cadr pts)) (cadr (caddr pts)))
	  (= (car (caddr pts)) (car (cadddr pts)))
	  (= (cadr (cadddr pts)) (cadr (car pts)))
	)
	(and
	  (= (cadr (car pts)) (cadr (cadr pts)))
	  (= (car (cadr pts)) (car (caddr pts)))
	  (= (cadr (caddr pts)) (cadr (cadddr pts)))
	  (= (car (cadddr pts)) (car (car pts)))
	)
      )
    )
  )
  
  (if
    (setq
      ss (ssget
	   '((0 . "lwpolyline") (62 . 1) (90 . 4) (-4 . "&") (70 . 1))
	 )
    )
     (repeat (setq i (sslength ss))
       (setq elst (entget (ssname ss (setq i (1- i)))))
       (if (and	(vl-every '(lambda (b) (zerop b)) (massoc 42 elst))
		(rectanglep (setq pts (massoc 10 elst)))
	   )
	 (progn
	   (setq ll (apply 'mapcar (cons 'min pts))
		 ur (apply 'mapcar (cons 'max pts))
	   )
	   (if (< (- (car ur) (car ll)) (- (cadr ur) (cadr ll)))
	     (setq pt ll
		   rot 0
	     )
	     (setq pt  (list (car ll) (cadr ur))
		   rot 270
	     )
	   )
	   (command-s  "_.insert" "registre_ailettes" "_non" pt 1. 1. rot)
	   (command-s "_.erase" (cdr (assoc -1 elst)) ""))
	 )
       )
     )
  )

 

[philsogood]

hello

ça marche pas, je pense avoir tout fait comme il faut mais bon...

ci-joint le fichier pour que tu vois ce qui bugge si tu peux (il faut insérer le bloc dans le fichier, je ne l'ai pas fait)

Phil

rectangle.dwg

[(gile)]

Il y a 3 heures, philsogood a dit :

ça marche pas

Normal, le dessin ne contient aucune polyligne rectangulaire rouge...

Si tu veux avoir le résultat escompté il faut être (très) précis sur les données en entrée.

(defun c:test (/ massoc isValid ss i elst pts ll ur pt rot)

  (defun massoc	(key alst)
    (if	(setq alst (member (assoc key alst) alst))
      (cons (cdar alst) (massoc key (cdr alst)))
    )
  )

  (defun rectanglep (pts)
    (and
      (= (length pts) 4)
      (or
	(and
	  (= (car (car pts)) (car (cadr pts)))
	  (= (cadr (cadr pts)) (cadr (caddr pts)))
	  (= (car (caddr pts)) (car (cadddr pts)))
	  (= (cadr (cadddr pts)) (cadr (car pts)))
	)
	(and
	  (= (cadr (car pts)) (cadr (cadr pts)))
	  (= (car (cadr pts)) (car (caddr pts)))
	  (= (cadr (caddr pts)) (cadr (cadddr pts)))
	  (= (car (cadddr pts)) (car (car pts)))
	)
      )
    )
  )

  (if
    (setq
      ss (ssget
	   '((0 . "lwpolyline") (90 . 4) (-4 . "&") (70 . 1))
	 )
    )
     (repeat (setq i (sslength ss))
       (setq elst (entget (ssname ss (setq i (1- i)))))
       (if (and	(vl-every '(lambda (b) (zerop b)) (massoc 42 elst))
		(rectanglep (setq pts (massoc 10 elst)))
	   )
	 (progn
	   (setq ll (apply 'mapcar (cons 'min pts))
		 ur (apply 'mapcar (cons 'max pts))
	   )
	   (if (< (- (car ur) (car ll)) (- (cadr ur) (cadr ll)))
	     (setq pt ll
		   rot 0.
	     )
	     (setq pt  (list (car ll) (cadr ur))
		   rot (* pi 1.5)
	     )
	   )
	   (entmakex
	     (list
	       (cons 0 "INSERT")
	       (cons 2 "registre_ailettes")
	       (cons 10 pt)
	       (cons 50 rot)
	     )
	   )
	   (entdel (cdr (assoc -1 elst)))
	 )
       )
     )
  )
  (princ)
)

 

[Raph_38]

Bonjour,

@Philsoggod : ça sent le schéma de principe aéraulique 😁

@Gile : je serais toujours épaté par cette facilité à programmer en lisp (perso, j'ai vraiment du mal avec ça)

Serait-il possible d'avoir la possibilité de choisir le bloc à insérer ?

Dans ton programme, peux-tu m'expliquer comment tu choisir le point d'insertion du bloc sur les rectangles sélectionnées ?

[(gile)]

Il y a 10 heures, Raph_38 a dit :

je serais toujours épaté par cette facilité à programmer en lisp

Cette "facilité" est largement due à 20 ans de pratique et de travail.

 

Il y a 10 heures, Raph_38 a dit :

Serait-il possible d'avoir la possibilité de choisir le bloc à insérer ?

On peut intégrer la routine Getblock (dans le fichier Dialog.lsp en bas de cette page) en début de routine et passer le résultat dans l'expression (entmakex ...).

 

Il y a 10 heures, Raph_38 a dit :

Dans ton programme, peux-tu m'expliquer comment tu choisir le point d'insertion du bloc sur les rectangles sélectionnées ?

Dans le cas présent les polylignes sont des rectangles orientés suivant les axes X et Y. Le LISP calcule les points inférieur gauche (ll) et supérieur droit (ur) :

	   (setq ll (apply 'mapcar (cons 'min pts))
		 ur (apply 'mapcar (cons 'max pts))
	   )

puis il détermine si le rectangle est "horizontal" ou "vertical" pour définir le point d'insertion et la rotation (ceci en fonction des instructions et du bloc fourni par @philsogood).

	   (if (< (- (car ur) (car ll)) (- (cadr ur) (cadr ll)))
	     (setq pt ll
		   rot 0.
	     )
	     (setq pt  (list (car ll) (cadr ur))
		   rot (* pi 1.5)
	     )
	   )

[MamyTina]

Bonjour,

Citation

après si ya 2 blocs c'est aps très grave non plus 🙂

Ce que je constate c'est: 'aps' au lieu de 'pas' est récurrent sur tes messages! 😁

Citation

merci pour votre aide, mon ficheir comporte 300 PL

Ai-je droit à une bière aussi? voire deux ou trois? 😂

Amicalement

[rebcao]

Hello Phil,

Je viens pour le FUT DE BIERE avec la TIREUSE, il y a effectivement quelques petites "Frapadingues..."

Je suis pas LOIN, pour la livraison, tu peux profiter du service de livraison de LEBONCOIN avec la mention "DON"...

Christian

[philsogood]

hello

super @(gile) ça marche très bien

reste plus qu'à ce que je passe à la caisse : tu montes quand sur Lyon?? 😉

@Raph_38 oui, yen a plusieurs en fait... je dois coller des étiquettes sur un fichiers qui n'étaient composés que de ligne et d'arc de cercle... un belle *****

j'ai 2000 étiquettes à poser sur le fichier et je dois en avoir presque autant à créer pour tous les actionneurs manuels (vannes, clapets...)

je ne joue qu'avec des lisp : ATTIN , ATTOUT , SSATT et quelques commandes natives : RECHERCHER , BATTMAN , ATTSYNC

@rebcao Cricri, tu habites trop loin... en plus t'as déménagé et tu m'as même pas invité à la crémaillère... si tu veux une bière viens la chercher 😛

Phil