Comment savoir si c'est déjà fait ?

[DenisHen]

Bonjour à la communauté.
J'ai fais un petit bout de code qui réduit de 3mm les lignes rouges sélectionnées...
Mais après avoir partagé ce code avec mes collègues, il ont fini par traiter plusieurs fois certaines lignes, mais pas toutes...
J'ai donc pensé à attribuer un (vlax-ldata aux lignes traitées, pour ne pas refaire ce traitement à nouveau...
Donc, mon petit code ne fonctionne pas, et je ne sais pas pourquoi...

(setq n 0)
(princ "\nSélectionner la ou les lignes de pli (entité : \"ligne\") à \"encocher\" :")
(setq Select (ssget (list '(-4 . "<AND") '(0 . "LINE") '(-4 . "<OR") '(62 . 1) '(-4 . "OR>") '(-4 . "AND>"))))
;;; ne sélectionne que les "lignes rouges"
(while (setq ssObj (ssname Select n))
  (if (/= (vlax-ldata-put ssObj "DecoupPli" 1) "1")
    (progn
      (princ "\nTraitement des lignes......")
  ;....
  ;....
  ;création de la ligne traitée (à ne plus toucher
      (vlax-ldata-put (entlast) "DecoupPli" "1")
  ;...
  ;Suppression de l'ancienne ligne
      (command "_erase" ssObj "")
    ) ;_ Fin de progn
  ) ;_ Fin de if
  (setq n (1+ n))
) ;_ Fin de setq;

Je pense que c'est mon ssObj qui devrait poser problème, mais je n'arrive pas à en être certain...

[(gile)]

Salut,

Quand tu fais:

(/= (vlax-ldata-put ssObj "DecoupPli" 1) "1")

Que penses-tu tester ? Que renvoie (vlax-ldata-put ssObj "DecouPli" 1) ?

Sinon, dans la liste d'un filtre de sélection, le "AND" est implicite, il est donc inutile quand il enveloppe toute la liste. Et le "OR" est tout autant inutile quand il n'enveloppe qu'une seule condition.

(defun c:test (/ ss i line p1 p2 d v)
  (if (setq ss (ssget '((0 . "LINE") (62 . 1))))
    (repeat (setq i (sslength ss))
      (setq line (ssname ss (setq i (1- i)))
	    p1	 (getpropertyvalue line "StartPoint")
	    p2	 (getpropertyvalue line "EndPoint")
      )
      (if (/= (vlax-ldata-get line "DecoupPli") 1)
	(if (<= (setq d (distance p1 p2)) 6.)
	  (entdel line)
	  (progn
	    (setq v (mapcar '(lambda (x1 x2) (* (/ (- x2 x1) d) 3.)) p1 p2))
	    (setpropertyvalue line "StartPoint" (mapcar '+ p1 v))
	    (setpropertyvalue line "EndPoint" (mapcar '- p2 v))
	    (vlax-ldata-put line "DecoupPli" 1)
	  )
	)
      )
    )
  )
  (princ)
)

 

Mais le plus simple pour "savoir si c'est déjà fait" serait de changer de couleur.

[DenisHen]

Bonjour (gile) et merci pour ton aide.
J'ai vu mon erreur, j'aurais du écrire : (/= (vlax-ldata-get ssObj "DecoupPli" 1) "1").
Et effectivement, pourquoi "1" alors que 1 est plus simple.
J'ai donc intégrer ton code au mien, pour mieux le comprendre et ainsi, être capable de le modifier s'il doit évoluer.
Mais ça ne fonctionne pas, et je ne sais pas où :

  (princ "\nSélectionner la ou les lignes de pli (entité : \"ligne\") à \"encocher\" :")
  (if (setq ss (ssget '((0 . "LINE") (62 . 1))))
    (repeat (setq i (sslength ss))
      (setq line    (ssname ss (setq i (1- i)))
            DepLign (getpropertyvalue line "StartPoint")
            FinLign (getpropertyvalue line "EndPoint")
            PtA     DepLign
            PtB     (polar PtA (angle DepLign FinLign) LongCoup)
            PtC     (polar PtB (angle DepLign FinLign) (- (distance DepLign FinLign) (* LongCoup 2)))
            PtD     (polar PtC (angle DepLign FinLign) LongCoup)
      ) ;_ Fin de setq
    ) ;_ Fin de setq
    (if (/= (vlax-ldata-get line "DecoupPli") 1)
      (progn
        (setvar "cecolor" "7")
        (command "_.line" PtA PtB "")
        (command "_.line" PtC PtD "")
        (setvar "cecolor" "1")
        (command "_.line" PtB PtC "")
        (vlax-ldata-put (entlast) "DecoupPli" 1)
        (command "_erase" line "")
      ) ;_ Fin de if
    ) ;_ Fin de repeat
  ) ;_ Fin de if

En fait, ça ne fait rien, même avec de nouvelles lignes :

Commande: SZ_DecoupPli
Sélectionner la ou les lignes de pli (entité : "ligne") à "encocher" :
Sélectionner des objets: Spécifiez le coin opposé: 4 trouvé(s)
Sélectionner des objets:
Commande:

Et je ne peux pas changer la couleur de la ligne, elle doit toujours être rouge.
Encore merci pour ton aide.

[(gile)]

Un peu de méthodologie.

Quand on effectue une tâche "complexe", il est d'usage de la décomposer en plusieurs tâches plus simples testables séparément.

Ici, la "complexité" de la tâche est de modifier la longueur de plusieurs lignes à condition que ce là n'ait pas été déjà fait.

On peut donc décomposer en plusieurs tâches :

1. sélectionner des lignes
2. tester si une ligne a déjà été raccourcie
3. raccourcir une ligne
4. marquer la ligne comme "déjà raccourcie"

Les tâches 2, 3 et 4 peuvent être définies dans des fonctions séparées testables indépendamment. Pour que la tâche 4 fonctionne correctement après la tâche 3, il faut que la ligne passée en argument à la tâche 3 soit juste modifiée, pas remplacée par une autre entité.

2.

(defun dejaRaccourcie (ligne)
  (= (vlax-ldata-get ligne "DecoupPli") 1)
)

3.

(defun raccourcirLigne (ligne longCoupe / ptA ptB long ang)
  (setq	ptA (getpropertyvalue ligne "StartPoint")
	ptB (getpropertyvalue ligne "EndPoint")
	ang (angle ptA ptB)
  )
  (if (<= (distance ptA ptB) (* 2 longCoupe))
    (entmod (subst '(62 . 7) '(62 . 1) (entget ligne)))
    (progn
      (setq ptC	(polar ptA ang longCoupe)
	    ptD	(polar ptB ang (- longCoupe))
      )
      (setpropertyvalue ligne "StartPoint" ptC)
      (setpropertyvalue ligne "EndPoint" ptD)
      (entmake
	(list '(0 . "LINE") (cons 10 ptA) (cons 11 ptC) '(62 . 7))
      )
      (entmake
	(list '(0 . "LINE") (cons 10 ptB) (cons 11 ptD) '(62 . 7))
      )
    )
  )
)

4.

(defun marquerRaccourcie (ligne)
  (vlax-ldata-put ligne "DecoupPli" 1)
)

 

Chacune de ces fonctions peut être testée séparément dans AutoCAD avec les expressions suivantes :

(dejaRaccourcie (car (entsel)))

(raccourcirLigne (car (entsel)) 3.)

(marquerRaccourcie (car (entsel)))

 

Une fois qu'on est satisfait du fonctionnement de ces fonctions, on peut les intégrer dans le traitement d'un jeu de sélection.

(defun c:test (/ s i l)
  (if (setq s (ssget '((0 . "LINE") (62 . 1))))
    (repeat (setq i (sslength s))
      (setq l (ssname s (setq i (1- i))))
      (if (not (dejaRaccourcie l))
	(progn
	  (raccourcirLigne l 3.)
	  (marquerRaccourcie l)
	)
      )
    )
  )
  (princ)
)

 

[(gile)]

On peut améliorer la sélection des objets "non traités" en utilisant les xdata plutôt que les ldata parce qu'on peut les utiliser pour filtrer une sélection (voir ce sujet).

Dans ce cas, la fonction 'dejaRaccourcie' n'est plus utile.

(defun marquerRaccourcie (ligne)
  (if (null (tblobjname "APPID" "DecoupPli"))
    (regapp "DecoupPli")
  )
  (entmod (append (entget ligne) '((-3 ("DecoupPli" (1070 . 1))))))
)

(defun c:test (/ s i l)
  (if (setq s
	     (ssget
	       '((0 . "LINE")
		 (62 . 1)
		 (-4 . "<NOT")
		 (-3 ("DecoupPli"))
		 (-4 . "NOT>")
		)
	     )
      )
    (repeat (setq i (sslength s))
      (setq l (ssname s (setq i (1- i))))
      (raccourcirLigne l 3.)
      (marquerRaccourcie l)
    )
  )
  (princ)
)

 

[DenisHen]

Bonjour (gile) et merci pour ton aide.
Je regarde ton code très attentivement (car je n'ai pas AutoCAD sous le coude pour l'instant).

a. je viens seulement de comprendre pourquoi : "(<= (distance ptA ptB) (* 2 longCoupe))", j'ai mis du temps, mais c'est une excellente idée, de ne pas raccourcir une ligne d'une valeur supérieure à elle-même...😉

b. je ne comprends pas le "(entmod (subst '(62 . 7) '(62 . 1) (entget ligne)))". Tu changes la couleur rouge en blanc (ou l'inverse) ?

c. le getpropertyvalue et le setpropertyvalue sont très sympas ! ! !

d. "(entmod (append (entget ligne) '((-3 ("DecoupPli" (1070 . 1))...." est une très bonne idée, mais je n'arriverais jamais à l'utiliser ailleurs...

e. décomposer du code étape par étape est une très bonne idée, mais je n'y arrive pas toujours. Manque manifeste de méthode...🤕

Encore merci pour ton aide.

Denis...

[(gile)]

il y a 24 minutes, DenisHen a dit :

je ne comprends pas le "(entmod (subst '(62 . 7) '(62 . 1) (entget ligne)))". Tu changes la couleur rouge en blanc (ou l'inverse) ?

Je change la couleur rouge en blanc des lignes trop courtes.

[DenisHen]

Ok, je ne l'avais pas compris... Excellente idée ! !
Je regarde ça dès que j'ai un AutoCAD à portée...
Encore mille mercis...
Denis...

[DenisHen]

Je me renseigne depuis un moment sur cette ligne :
"(entmod (subst '(62 . 7) '(62 . 1) (entget ligne)))"
Que je trouve très intéressante, j'ai juste une petite question : comment l'écrire si on ne connait pas l'ancienne couleur (par exemple) ?
J'ai le souvenir de m'être méchamment planté il y a quelques années à essayer d'utiliser les (entmod, (entget et aussi (entmake...
J'en avais déduit que, pour moi, plus jamais, jusqu'à aujourd'hui... 😉
Encore un grand merci pour toutes cette aide.
Denis...

[(gile)]

il y a une heure, DenisHen a dit :

Je me renseigne depuis un moment sur cette ligne :
"(entmod (subst '(62 . 7) '(62 . 1) (entget ligne)))"
Que je trouve très intéressante, j'ai juste une petite question : comment l'écrire si on ne connait pas l'ancienne couleur (par exemple) ?

On ferait ça :

(setq elst (entget ligne))
(entmod (subst '(62 . 7) (assoc 62 elst) elst))

Sauf que, avec le groupe DXF 62, il faut faire attention,parce qu'il peut être absent de la liste renvoyée par entget si l'entité est en couleur DuCalque.

Donc en fait, on ferait plutôt :

(setq elst (entget ligne))
(if (setq couleur (assoc 62 elst))
  (entmod (subst '(62 . 7) couleur elst))
  (append elst (list '(62 . 7)))
)

 

[DenisHen]

Parfait, mille merci (gile), c'est super ! ! !
Donc, ta deuxième proposition est valable pour toutes les valeurs qui peuvent être "DuCalque".
Encore un grand merci.
Denis...

[(gile)]

il y a une heure, DenisHen a dit :

Donc, ta deuxième proposition est valable pour toutes les valeurs qui peuvent être "DuCalque".

Oui, mais pas seulement, beaucoup de groupes DXF sont optionnels.

Le Manuel d'utilisation DXF est assez complet et en français (donc pas d'excuses).

[DenisHen]

Parfais, encore merci à toi (gile)...