2 valeur supprimer la +grande ou +petite

[lovecraft]

Bonjour à tous,

Je recherche un lisp, qui me permettrait de selectionner deux valeurs (texte), et d'avoir l'option de supprimer la valeur la plus grande ou la plus petite.

Merci de votre aide.

Lovecraft

[(gile)]

Je ne comprends pas la demande.

Il est plus facile et rapide de sélectionner et effacer directement la valeur (plus petite ou plus grande) que de lancer un LISP, sélectionner 2 textes et choisir l'option (plus petite ou plus grande) pour que le programme sache quelle valeur supprimer, non ? :casstet:

[lovecraft]

bonjour,

Gile, merci d'avoir regarder ma demande.

On peut dire en quelques sorte que c'est un p'tit challenge. T'as bien compris ce que je voulais faire. donc j'ai un peu commencé, mais comme tu le sais je ne suis qu'un debutant .....

 

Voila ce que j'ai commencé a faire.(c'est pas encore ca) Mais si vous avez des améliorations je suis a votre ecoute, même pour les conseils.

;***********************************************************************

defun c:cmax()

 

(setq sstext (ssget))

(setq i 1)

(repeat (sslength sstext)

 

(setq enttxt (ssname sstext i))

(setq bdenttxt (entget enttxt))

(setq enttxt1 (entnext enttxt))

(setq bdenttxt1 (entget enttxt1))

 

(setq txt1 (cdr (assoc 1 bdenttxt1)))

(setq txt2 (cdr (assoc 1 bdenttxt)))

 

(setq vtxt1 (atof txt1))

(setq vtxt2 (atof txt2))

 

(if (

 

(command "effacer" txtmax "" )

 

);fin du repeat

 

);fin du defun

 

;********************************************************************

 

Merci

[Patrick_35]

Salut

J'ai bien une solution, mais elle n'est pas du tout facile à comprendre par un débutant

Donc j'attends un peu avant de la donner

 

@+

[Patrick_35]

Au vu du nombre de réponses, voici le lisp comme promis

Tu as deux commandes

cmax pour effacer la valeur max, et pour cmin, je pense que tu devines

 

(defun patrick:effacer_mini_maxi(tri / sel tbl trier)
 (defun trier(val)
   (if (member (type (read (vla-get-textstring val))) '(INT REAL))
     (setq tbl (cons (cons val (vla-get-textstring val)) tbl))
   )
 )

 (vlax-map-collection (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) 'trier)
 (vla-delete sel)
 (if tbl
   (progn
     (setq tbl (vl-sort tbl '(lambda (a b) (if tri
				      (> (cdr a) (cdr b))
				      (< (cdr a) (cdr b))
				    )
		     )
	)
     )
     (if (and	(cadr tbl)
	(eq (cdar tbl) (cdadr tbl))
  )
(princ (strcat "\nAttention, des valeurs " (if tri "MAX" "MIN") " sont identiques dans la sélection. Abandon."))
(vla-delete (caar tbl))
     )
   )
   (princ "\nPas de valeurs numériques dans la sélection.")
 )
)

(defun c:cmax()
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (if (ssget (list (cons 0 "TEXT,MTEXT")))
   (patrick:effacer_mini_maxi T)
 )
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ)
)

(defun c:cmin()
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (if (ssget (list (cons 0 "TEXT,MTEXT")))
   (patrick:effacer_mini_maxi nil)
 )
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ)
)

 

@+

[lovecraft]

Merci patrick pour ce p'tit lisp, il est clair qu'il n'est pas facile de comprendre ce lisp mais je vais essayer .

Enfin demain je mettrai ce que j'ai fait mais develloppé en lisp et non en Vlisp.

encore merci

 

[(gile)]

Deux autres façons de faire.

 

La première ressemble à celle de Lovecraft.

 

L'utilisation de la fonction and fait s'arréter la routine si une des expressions retourne nil.

Deux entités son sélectionnées, pour chacune on vérifie que c'est un texte ou un mtexte et que la valeur de ce texte est un nombre.

Puis les nombres sont comparés.

 

(defun c:supp_max (/ text1 text2 val1 val2)
 (and
   (setq text1 (car (entsel "\nSélectionnez le premier texte: ")))
   (wcmatch (cdr (assoc 0 (entget text1))) "*TEXT")
   (numberp (setq val1 (read (cdr (assoc 1 (entget text1))))))
   (setq text2 (car (entsel "\nSélectionnez le premier texte: ")))
   (wcmatch (cdr (assoc 0 (entget text2))) "*TEXT")
   (numberp (setq val2 (read (cdr (assoc 1 (entget text2))))))
   (cond
     ((      ((      (T (princ "\nLes valeurs sont égales"))
   )
 )
 (princ)
) 

 

L'autre ressemble plus à ce qu'a fait Patrick_35, mais sans fonction vla-.

On sélectionne des entités texte ou mtexte.

Onfait une liste de paire pointées (nom_d'entité . valeur) en écartant les textes dont la valeur n'est pas un nombre.

On trie la liste et supprime le premier élément si sa valeur est différente de celle du second.

 

(defun c:supp_min (/ ss n ent lst)
 (and
   (setq ss (ssget '((0 . "*TEXT"))))
   (repeat (setq n (sslength ss))
     (setq ent (ssname ss (setq n (1- n))))
     (if (numberp (setq val (read (cdr (assoc 1 (entget ent))))))
(setq lst (cons (cons ent val) lst))
     )
   )
 )
 (and
   (setq lst (vl-sort lst '(lambda (x1 x2) (    (if	(/= (cdar lst) (cdadr lst))
     (entdel (caar lst))
     (princ "\nAu moins 2 valeurs inférieures égales")
   )
 )
 (princ)
) 

[lovecraft]

bonjour,

Merci gile pour tes versions.

 

donc voici la miennes,

Merci de vos commentaires.

 

;***************************************************************************

 

(defun c:EFVAL()

 

(initget 1 "1 2")

 

(setq choix (getkword "tapez 1 pour effacer les valeurs mini ou 2 pour effacer les valeurs max: "))

 

 

(if (= choix "1")

 

(progn

 

(while (/= (setq sstext (ssget)) nil)

 

(setq ent1 (ssname sstext 0))

(setq bdent1 (entget ent1))

(setq txt1 (cdr (assoc 1 bdent1)))

(setq vtxt1 (atof txt1))

 

(setq ent2 (ssname sstext 1))

(setq bdent2 (entget ent2))

(setq txt2 (cdr (assoc 1 bdent2)))

(setq vtxt2 (atof txt2))

 

(if (

 

(command "effacer" txtmin "" )

 

 

);fin du while

 

);fin du progn

 

(progn

 

 

(while (/= (setq sstext (ssget)) nil)

 

(setq ent1 (ssname sstext 0))

(setq bdent1 (entget ent1))

(setq txt1 (cdr (assoc 1 bdent1)))

(setq vtxt1 (atof txt1))

 

(setq ent2 (ssname sstext 1))

(setq bdent2 (entget ent2))

(setq txt2 (cdr (assoc 1 bdent2)))

(setq vtxt2 (atof txt2))

 

(if (> vtxt1 vtxt2) (setq txtmax ent1) (setq txtmax ent2))

 

(command "effacer" txtmax "" )

 

);fin du while

 

);fin du progn

 

);fin du if

 

);fin deu defun

 

;*********************************************************************************