LISP HELP

[Big666]

Bonjour

ce lisp qui et la somme de lisp qui a été créé par d'autre, beaucoup plus qualifier que moi,fonctionne chez mois et pas au bureau.

je rappelle qui je suis au stade bricoleur dans ce domaine,

merci pour votre aide.

;;; SPURGE version 1.40
;;; Purge tout, y compris les blocs imbriqués, les blocs vides,
;;; les xrefs et les images non référencées
;;; j'ai modifier le nom meci a l'auteur pour son travail

(defun c:QSP
     (/	AcDoc lay l_lst	ss n obj name bloc ent r_lst x_lst p_lst c_lst m)
 (vl-load-com)
 (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))

 ;; Purge les xrefs et rasters non référencées

 ;;(c:xref_purge)
 ;;(c:raster_purge)

 ;; Dévérouillage de tous les calques

 (vlax-for c (vla-get-Layers AcDoc)
   (if	(= :vlax-true
   (vla-get-lock c)
)
     (progn
(vla-put-lock c :vlax-false)
(setq l_lst (cons c l_lst))
     )
   )
 )

 ;; r_lst : liste des blocs et "sous-blocs" insérés
 ;; x_lst : liste des xrefs insérées

 (setq ss (ssget "_X" '((0 . "INSERT"))))
 (if ss
   (progn
     (repeat (setq n (sslength ss))
(setq
  obj (vlax-ename->vla-object (ssname ss (setq n (1- n))))
)
(if (vlax-property-available-p obj 'EffectiveName)
  (setq name (vla-get-EffectiveName obj))
  (setq name (vla-get-Name obj))
)
(if (and
      (= 0
	 (vla-get-count (vla-item (vla-get-Blocks AcDoc) name))
      )
      (= :vlax-false
	 (vla-get-isXref
	   (vla-item (vla-get-Blocks AcDoc) name)
	 )
      )
    )
  (vla-delete obj) ;_ Suppression des blocs vides
  (if (= :vlax-true
	 (vla-get-isXref
	   (vla-item (vla-get-Blocks AcDoc) name)
	 )
      )
    (if	(not (member name x_lst))
      (setq x_lst (cons name x_lst))
    )
    (if	(not (member name r_lst))
      (setq r_lst (cons name r_lst))
    )
  )
)
     )

     ;; Ajout des "sous-blocs" des blocs insérés à r_lst

     (setq n 0)
     (if r_lst
(while (setq name (nth n r_lst))
  (setq bloc (vla-item (vla-get-blocks acDoc) name))
  (repeat (setq m (vla-get-count bloc))
    (setq ent (vla-item bloc (setq m (1- m))))
    (if	(and (= (vla-get-ObjectName ent) "AcDbBlockReference")
	     (not (member (vla-get-name ent) r_lst))
	)
      (setq
	r_lst
	 (reverse (cons (vla-get-Name ent) (reverse r_lst)))
      )
    )
  )
  (setq n (1+ n))
)
     )
   )
 )

 ;; c_lst liste des définitions de blocs de la collection

 (setq c_lst nil)
 (vlax-for b (vla-get-blocks AcDoc)
   (setq c_lst (cons (vla-get-name B) c_lst))
 )

 ;; p_lst : liste des blocs à purger, soit les blocs de la collection ...
 ;; ... moins les blocs "*Model_Space" "*Paper_Space*" et les blocs insérées

 (setq	p_lst (vl-remove-if
	'(lambda (x)
	   (or (= (substr x 1 1) "*")
	       (member x r_lst)
	   )
	 )
	c_lst
      )
 )

 ;; ... moins les xrefs insérées et les blocs qu'elles contiennent

 (mapcar '(lambda (x)
     (setq p_lst
	    (vl-remove-if
	      '(lambda (y)
		 (wcmatch y (strcat x "*"))
	       )
	      p_lst
	    )
     )
   )
  x_lst
 )

 ;; suppression de tous le blocs de p_lst

 (mapcar '(lambda (x)
     (vla-delete (vla-item (vla-get-Blocks AcDoc) x))
   )
  p_lst
 )

 ;; Purge et audit du dessin

 (vla-PurgeAll AcDoc)
 (vla-AuditInfo AcDoc :vlax-true)

 ;; Restauration de l'état des calques

 (if l_lst
   (mapcar '(lambda (x)
       (vla-put-lock x :vlax-true)
     )
    l_lst
   )
 )
 (princ)
 ;; control enregistre ferme etranmit

 (command "CONTROLE" "O")
 (command "-PURGER" "TO" "*" "N")
 (command "_qsave")
 (command "_-etransmit"

   "_c"

   (strcat (getvar "dwgprefix")

	   (substr (getvar "dwgname")

		   1

		   (- (strlen (getvar "dwgname")) 3)

	   )

	   "ZIP"

   )

 )
 (command "_close" "_n")
 (princ)
)

Modifié le 11 décembre 2012 par (gile)
Mise en forme du code et ajout de bbcodes

[Big666]

au secours

[(gile)]

Salut,

 

S'il te plait,

1. pour que le code soit plus lisible, utilise les bbcodes :

[code] ici le code [/code]

donne :

 ici  le code 

Accessible via l'icône :

 

2. pour que ton message soit plus compréhensible, exprime tes questions de manière intelligible et fais un petit effort avec l'orthographe (personnellement, quand un message contient trop de fautes, je ne finis même pas de le lire et passe au suivant).

[didier]

coucou

 

c'est bien de te situer dans les "bricoleurs" mais je rejoins (gile)

et je me permets de rappeler que le pire ennemi est le "copier-coller"

surtout chez les débutants.

mais qu'à cela ne tienne, tu trouveras de l'aide si tu nous dis au moins

ce qui en marche pas.

 

amicalement

[Big666]

certes ma méthode d'apprentissage est discutable.

mais étant pour l'instant incapable de créé de toute pièce un lisp, je regarde ce qui existe,

je l’arrange a ma sauce et je l'essaye .

ci cela fonctionne du premier coup joie! Bonheur! Félicite .

Sinon je fait Ctrl+F2 fenêtre de texte autocad

et là j'essaye de résoudre le problème .

en dernier recoure je vous demande de l'aide.

 

 

pour ce lisp: il fonctionne très bien chez moi mais au bureau non!

 

Le message est :

Commande: qsp

; erreur: une erreur est survenue dans la fonction *erreur*type d'argument

incorrect: stringp nil

 

Pour les fautes je fait de mon mieux .

 

merci pour votre aide

 

 

 

;;; SPURGE version 1.40
;;; Purge tout, y compris les blocs imbriqués, les blocs vides,
;;; les xrefs et les images non référencées
(vl-load-com)
(defun c:QSP (/ AcDoc lay l_lst ss n obj name bloc ent r_lst x_lst p_lst c_lstm)
(vl-load-com)
(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))

;; Purge les xrefs et rasters non référencées

;;(c:xref_purge)
;;(c:raster_purge)

;; Dévérouillage de tous les calques

(vlax-for c (vla-get-Layers AcDoc)
(if (= :vlax-true
(vla-get-lock c)
)
(progn
(vla-put-lock c :vlax-false)
(setq l_lst (cons c l_lst))
)
)
)

;; r_lst : liste des blocs et "sous-blocs" insérés
;; x_lst : liste des xrefs insérées

(setq ss (ssget "_X" '((0 . "INSERT"))))
(if ss
(progn
(repeat (setq n (sslength ss))
(setq
obj (vlax-ename->vla-object (ssname ss (setq n (1- n))))
)
(if (vlax-property-available-p obj 'EffectiveName)
(setq name (vla-get-EffectiveName obj))
(setq name (vla-get-Name obj))
)
(if (and
(= 0
(vla-get-count (vla-item (vla-get-Blocks AcDoc) name))
)
(= :vlax-false
(vla-get-isXref
(vla-item (vla-get-Blocks AcDoc) name)
)
)
)
(vla-delete obj) ;_ Suppression des blocs vides
(if (= :vlax-true
(vla-get-isXref
(vla-item (vla-get-Blocks AcDoc) name)
)
)
(if (not (member name x_lst))
(setq x_lst (cons name x_lst))
)
(if (not (member name r_lst))
(setq r_lst (cons name r_lst))
)
)
)
)

;; Ajout des "sous-blocs" des blocs insérés à r_lst

(setq n 0)
(if r_lst
(while (setq name (nth n r_lst))
(setq bloc (vla-item (vla-get-blocks acDoc) name))
(repeat (setq m (vla-get-count bloc))
(setq ent (vla-item bloc (setq m (1- m))))
(if (and (= (vla-get-ObjectName ent) "AcDbBlockReference")
(not (member (vla-get-name ent) r_lst))
)
(setq
r_lst
(reverse (cons (vla-get-Name ent) (reverse r_lst)))
)
)
)
(setq n (1+ n))
)
)
)
)

;; c_lst liste des définitions de blocs de la collection

(setq c_lst nil)
(vlax-for b (vla-get-blocks AcDoc)
(setq c_lst (cons (vla-get-name B) c_lst))
)

;; p_lst : liste des blocs à purger, soit les blocs de la collection ...
;; ... moins les blocs "*Model_Space" "*Paper_Space*" et les blocs insérées

(setq p_lst (vl-remove-if
'(lambda (x)
(or (= (substr x 1 1) "*")
(member x r_lst)
)
)
c_lst
)
)

;; ... moins les xrefs insérées et les blocs qu'elles contiennent

(mapcar '(lambda (x)
(setq p_lst
(vl-remove-if
'(lambda (y)
(wcmatch y (strcat x "*"))
)
p_lst
)
)
)
x_lst
)

;; suppression de tous le blocs de p_lst

(mapcar '(lambda (x)
(vla-delete (vla-item (vla-get-Blocks AcDoc) x))
)
p_lst
)

;; Purge et audit du dessin

(vla-PurgeAll AcDoc)
(vla-AuditInfo AcDoc :vlax-true)

;; Restauration de l'état des calques

(if l_lst
(mapcar '(lambda (x)
(vla-put-lock x :vlax-true)
)
l_lst
)
)

;; control enregistre ferme etranmit

(command "CONTROLE" "O" )
(command "-PURGER" "TO" "*" "N")
(command "_qsave")
(command "_-etransmit"

           "_c" 

          (strcat (getvar "dwgprefix")

                  (substr (getvar "dwgname")

                          1

                          (- (strlen (getvar "dwgname")) 3)

                  )

                  "ZIP"

          )

 )

(princ)
)

[bonuscad]

Commande: qsp

; erreur: une erreur est survenue dans la fonction *erreur*type d'argument

incorrect: stringp nil

 

Ce message d'erreur veut dire qu'une fonction attend une chaîne de caractère valide, mais ici elle n'a rien eu (nil)

 

Sans en être vraiment certain, je pense que cela vient de (command "_qsave"), qui selon si le fichier à déjà un nom ou non, va réclamer un nom de fichier, qui là n'est pas fourni.

Peut être préférer simplement (command "_save" "nom_fichier") ?!...