effacer point ; polylignes, et lignes de longueur nulle, textes et Mtextes

[sechanbask]

Bonjour,

Je souhaite effacer les lignes et polylignes dont la longueur est zéro et également effacer les points... pour les points, j'ai ce qu'il me faut:

 

  (defun c:suppoint (/ sel)
(setq sel (ssget "_X" '((0 . "POINT" ))))
(command "_erase" sel "")
(princ)
) 

 

merci par avance[Edité le 2/6/2007 par sechanbask]

 

[Edité le 30/6/2007 par sechanbask]

[(gile)]

Salut,

 

(defun c:test (/ ss n obj)
 (vl-load-com)
 (if (setq ss (ssget "_X" '((0 . "LINE,LWPOLYLINE"))))
   (repeat (setq n (sslength ss))
     (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
     (if (= 0
     (vlax-curve-getDistAtParam
       obj
       (vlax-curve-getEndParam obj)
     )
  )
(vla-delete obj)
     )
   )
 )
 (princ)
) 

[sechanbask]

Merci voilà pour la solution finale : Désolé si c'est mal écrit mais je débute en lisp... si des modifications sont possibles, je suis preneur

 

(defun c:test (/ ss n obj)
(vl-load-com)
(if (setq ss (ssget "_X" '((0 . "LINE,LWPOLYLINE"))))
(repeat (setq n (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
(if (= 0
(vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
)
(vla-delete obj)
)
)
)
(setq sel (ssget "_X" '((0 . "POINT" ))))
(command "_erase" sel "")
(princ)
)
(princ)
)

[(gile)]

Désolé si c'est mal écrit mais je débute en lisp...

 

Alors tu aurais du poster dans le sous-forum "Débuter en LISP", ma réponse en aurait tenu compte et été moins abrupte.

 

On peut ne faire qu'un seul jeu de sélection et modifier la conditionnelle du if pour y traiter aussi les points.

Tu devrait aussi renomer la routine c:test est un nom très courament employé pour les routine en test justement.

 

(defun c:test (/ ss n obj)
 (vl-load-com)
 (if (setq ss (ssget "_X" '((0 . "LINE,LWPOLYLINE,POINT"))))
   (repeat (setq n (sslength ss))
     (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
     (if (or
    (= (vla-get-ObjectName obj) "AcDbPoint")
    (= 0
       (vlax-curve-getDistAtParam
	 obj
	 (vlax-curve-getEndParam obj)
       )
    )
  )
(vla-delete obj)
     )
   )
 )
 (princ)
) 

[sechanbask]

merci pour tous tes conseils... à bientôt sûrement...

[sechanbask]

Autre petite question...

Je cherche à purger tout (sans faire apparaitre la boite de dialogue d'autocad) comme je le fait avec

 ThisDrawing.PurgeAll  

en VBA, mais en lisp pour l'intégrer à la lisp précédente... sans conjuguer lisp et VBA...

Merci par anticipation

 

[Edité le 11/3/2007 par sechanbask]

[(gile)]

Salut,

 

(vla-PurgeAll (vla-get-ActiveDocument (vlax-get-acad-object)))

[sechanbask]

maintenant je cherche également à selectionner les textes vides et à les supprmier... vous avez une idée?

[(gile)]

Salut, c'est ici

[sechanbask]

Donc le résultat de tout ça ça devrait faire ça mais ça ne marche pas car je n'ai pas inclus les textes et mtextes à la selection... mais je ne sais pas faire alors... merci d'avance

 

 

 (defun c:supp (/ ss n obj)
(vl-load-com)
(if
(setq ss (ssget "_X" '((0 . "*TEXT") (1 . " ,"))))
(mapcar '(lambda (x) (entdel (cadr x))) (ssnamex ss))
)
)
(vla-delete obj)
(if (setq ss (ssget "_X" '((0 . "LINE,LWPOLYLINE,POINT"))))
(repeat (setq n (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
(if (or
(= (vla-get-ObjectName obj) "AcDbPoint")
(= 0
(vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
)
)
(vla-delete obj)
)
)
)
(vla-PurgeAll (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
)

[(gile)]

ça ne marche pas car je n'ai pas inclus les textes et mtextes à la selection...

 

Je pens plutôt que ça ne marche pas parce qu'il y a une parenthèse fermante supplémentaire et un (vla-delete obj) à un moment où onj est nil.

 

l'expression :

(if

(setq ss (ssget "_X" '((0 . "*TEXT") (1 . " ,"))))

(mapcar '(lambda (x) (entdel (cadr x))) (ssnamex ss))

)

se suffit à elle même, elle sélectionne et supprime les textes vides.

[sechanbask]

Merci beaucoup (gile) et aux autres. Voilà le code en entier de l'expression qui supprime :

-point

-ligne et polylignes de longueur 0

-textes et Mtextes vides

 

(defun c:supp (/ ss n obj)
(vl-load-com)
(if (setq ss (ssget "_X" '((0 . "LINE,LWPOLYLINE,POINT"))))
(repeat (setq n (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
(if (or
(= (vla-get-ObjectName obj) "AcDbPoint")
(= 0
(vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
)
)
(vla-delete obj)
)
)
)
(if
(setq ss (ssget "_X" '((0 . "*TEXT") (1 . " ,"))))
(mapcar '(lambda (x) (entdel (cadr x))) (ssnamex ss))
)
(vla-PurgeAll (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
)

[sechanbask]

J'y pense que maintenant mais y'a t-il moyen de compter les objets supprimés? ça serait pour donner l'indication dans la ligne de commande ou vers une boite de message que les amoureux du lisp et objet dcl m'en voudront d'appeler un msgbox... Désolé j'ai oublié mon livre sur l'autolisp au boulot alors je parle avec les termes que je connais...

[lecrabe]

Hello

 

Le Decapode suggère qq améliorations sur ce genre de routine ...

 

Au sujet d'une routine qui efface TEXTE et MTEXTE vides,

je pense qu'il faut perfectionner un peu la routine avec les questions suivantes :

 

**** TEXTE & MTEXTE ****

 

- Supprimer Oui/Non Texte & MTexte ne contenant que des espaces !

 

et Oui ça peut arriver ! Le contenu n'est pas nulle mais ne contient QUE N espaces

 

- Supprimer Oui/Non la partie DROITE des TEXTE et MTEXTE ne contenant que des espaces !

 

en effet parfois les gens saisissent des zones alpha-numerqiues et N espaces en fin de saisie, pouquoi ? Mystère mais ça pose des problèmes sérieux pour des exports ultérieurs en base en données et surtout pour des comparaisons (jointures)

 

D'ailleurs cette option, j'aimerais bien l'avoir pour traiter aussi les ATTRIBUTS !

 

**** MTEXTE ****

- Supprimer Oui / Non les lignes vides que l'on trouve parfois en FIN de MTEXTE !

Attention: ne pas supprimer des lignes vides AU MILIEU du MTEXTE

 

et oui parfois les gens ont la main LOURDE sur la touche Entrée en fin de saisie de MTEXTE

 

**** Objets Linéaires ****

 

En ce qui est de supprimer les Lignes, Arcs, Polylignes COURTEs, j'utilise bien sur la Sélection Rapide ... mais je dois procéder type d'objet par type d'objet, DONC

 

**** LIGNE , ARC , POLYLIGNE , SPLINE , ELLIPSE , TRACE , CERCLE ****

- Poser la question sur la longueur MINIMUM (Défaut = ZERO bien sur)

 

AInsi on pourra supprimer facilement les objets linéaires de longueur ZERO ou TRES FAIBLE

 

Le Decapode vous remercie par avance

 

PS: Petite modif au sujet des Attributs

 

 

[Edité le 2/6/2007 par lecrabe]

[sechanbask]

Moi j'ai besoin uniquement de ce qui est déjà réalisé voire :

-ARC, SPLINE , ELLIPSE , TRACE , CERCLE de longueur 0

 

Mais les fonctionnalités que tu souhaites viendront surcharger le lisp et gonflerons les utilisateurs de mon BE. Mais rien ne t'empêche de poursuivre l'extension.

 

Alors bonne programmation et merci encore à tous.[Edité le 2/6/2007 par sechanbask]

 

Je cherche toujours comment compter les entités supprimées pour l'afficher dans la ligne de commande. et faire le compte de entités -ARC, SPLINE , ELLIPSE , TRACE , CERCLE qui ne correspondent pas au critaère pour faire le pourcentage d'entités supprimables/totales...Merci d'avance...

 

[Edité le 30/6/2007 par sechanbask]

[(gile)]

Pour répondre à la demande de ce cher crustacé, un petit LISP qui nettoye tous les textes, mtextes et attributs du dessin des espaces et autres caractères non imprimables situés à droite de ces objets. Pour les textes et mtextes, si le résultat de ce nettoyage donne une chaine vide, l'objet est supprimé.

 

Code corrigé suite à une observation de Ludwig

 

;; CLEANTXT
;; Supprime les caractères non imprimables (espaces, tabulations, retour charriot, ...)
;; situés à droite de tous les textes, mtextes et attributs du dessin.

(defun c:cleantxt (/ RightCleanText)
 (vl-load-com)

 (defun RightCleanText	(txt / lst)
   (setq lst (reverse (vl-string->list txt)))
   (while (and	lst
	(or (		    (and (= (car lst) 80) (= (cadr lst) 92))
	)
   )
     (if (	(setq lst (cdr lst))
(setq lst (cddr lst))
     )
   )
   (vl-list->string (reverse lst))
 )

 (if (ssget "_X" '((0 . "*TEXT,INSERT")))
   (vlax-for obj (vla-get-ActiveSelectionSet
	    (vla-get-ActiveDocument (vlax-get-acad-object))
	  )
     (if (= (vla-get-ObjectName obj) "AcDbBlockReference")
(if (= (vla-get-HasAttributes obj) :vlax-true)
  (foreach att (vlax-invoke obj 'GetAttributes)
    (vla-put-TextString
      att
      (RightCleanText (vla-get-TextString att))
    )
  )
)
(if (= "" (setq txt (RightCleanText (vla-get-TextString obj))))
  (vla-delete obj)
  (vla-put-TextString obj txt)
)
     )
   )
 )
 (princ)
) 

 

[Edité le 18/12/2007 par (gile)]

[(gile)]

Et voilà pour les objets "trop petits"

 

PS : le LISP ne traite pas les traces qui auraient demandé un traitement spécial. Le LISP Trace2Poly permet de transformer les traces en polylignes optimisées (à lancer avant ETP)

 

;; ETP supprime les lignes, polylignes, splines, ellipes, arcs et cercles dont la longueur
;; est inférieur ou égale à la longueur minimale spécifiée.

(defun c:etp (/ doc fuzz end)
 (vl-load-com)
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (or (setq fuzz (getdist "\nSpécifiez la longueur minimale [b][/b]: "))
     (setq fuzz 0)
 )
 (vla-StartUndoMark doc)
 (if (ssget "_X"
     '((0 . "LINE,ARC,*POLYLINE,SPLINE,ELLIPSE,CIRCLE"))
     )
   (vlax-for obj (vla-get-ActiveSelectionSet doc)
     (if (not (vl-catch-all-error-p
	 (setq end
		(vl-catch-all-apply
		  'vlax-curve-getEndParam
		  (list obj)
		)
	 )
       )
  )
(if (	  (vla-delete obj)
)
     )
   )
 )
 (vla-EndUndoMark doc)
 (princ)
) 

 

[Edité le 13/9/2007 par (gile)]