sergeluc

Bonjour bryce, j'utilise la 2011 et je n'ai pas trouvé de lisp équivalant sur le net,c'est pourquoi je voulais faire évoluer ces routines .j'ai bien essayé mais sans résultant convaincant ,pour l'instant.La sélection multiple par fenetre des LWPOLYLINES me pose des problèmes . merci pour ta réponse

bonjour , Je cherche à reconstruire des entités coupées de meme type "lignes polylignes ou arcs" depuis une sélection par fenetre.Les anciennes entités (coplanaires) sont supprimées et remplacées par une nouvelle . Merci d'avance pour toute aide Je joins pour exemple cette routine qui fonctionne mais par sélection de deux entités . Ce lisp n'est pas de moi. (defun c:REC-exct ( / ENTS1 ENTG1 EL ENTS2 ENTG2) (setq CL (getvar "CLAYER")) (setvar "CMDECHO" 0) (setq ENTS1 (car (entsel "\nPremiere entite"))) (setq ENTG1 (entget ENTS1)) (setq EL (cdr (assoc 8 ENTG1))) (setq ENTS2 (car (entsel "\nDeuxieme entite"))) (setq ENTG2 (entget ENTS2)) (cond ((and (= (cdr (assoc 0 ENTG1)) "LINE") (= (cdr (assoc 0 ENTG2)) "LINE") ) ;_ Fin de and (progn (setq P1 (cdr (assoc 10 ENTG1)) P2 (cdr (assoc 11 ENTG1)) P3 (cdr (assoc 10 ENTG2)) P4 (cdr (assoc 11 ENTG2)) ) ;_ Fin de setq (command "_LAYER" "_S" EL "") (entdel ENTS1) (entdel ENTS2) (if (> (distance P1 P3) (distance P1 P4)) (setq P5 P1 P6 P3 ) ;_ Fin de setq (setq P5 P1 P6 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P2 P3) (distance P2 P4)) (setq P7 P2 P8 P3 ) ;_ Fin de setq (setq P7 P2 P8 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P5 P6) (distance P7 P8)) (command "_LINE" P5 P6 "") (command "_LINE" P7 P8 "") ) ;_ Fin de if (command "_LAYER" "_S" CL "") (setvar "CMDECHO" 1) ) ;_ Fin de progn ) ;_ Fin de 1er cond ((and (= (cdr (assoc 0 ENTG1)) "POLYLINE") (= (cdr (assoc 0 ENTG2)) "POLYLINE") ) ;_ Fin de and (progn (setq PW (cdr (assoc 40 ENTG1))) (command "_EXPLODE" ENTS1) (setq ENTS1 (entlast)) (command "_EXPLODE" ENTS2) (setq ENTS2 (entlast)) (setq ENTG1 (entget ENTS1)) (setq ENTG2 (entget ENTS2)) (setq P1 (cdr (assoc 10 ENTG1)) P2 (cdr (assoc 11 ENTG1)) P3 (cdr (assoc 10 ENTG2)) P4 (cdr (assoc 11 ENTG2)) EL (cdr (assoc 8 ENTG1)) ) ;_ Fin de setq (entdel ENTS1) (entdel ENTS2) (command "_LAYER" "_S" EL "") (if (> (distance P1 P3) (distance P1 P4)) (setq P5 P1 P6 P3 ) ;_ Fin de setq (setq P5 P1 P6 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P2 P3) (distance P2 P4)) (setq P7 P2 P8 P3 ) ;_ Fin de setq (setq P7 P2 P8 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P5 P6) (distance P7 P8)) (command "_PLINE" P5 "_W" PW "" P6 "") (command "_PLINE" P7 "_W" PW "" P8 "") ) ;_ Fin de if (command "_LAYER" "_S" CL "") (setvar "CMDECHO" 1) ) ;_ Fin de progn ) ;_ Fin de 2eme cond ((and (= (cdr (assoc 0 ENTG1)) "LWPOLYLINE") (= (cdr (assoc 0 ENTG2)) "LWPOLYLINE") ) ;_ Fin de and (progn (setq PW (cdr (assoc 40 ENTG1))) (command "_EXPLODE" ENTS1) (setq ENTS1 (entlast)) (command "_EXPLODE" ENTS2) (setq ENTS2 (entlast)) (setq ENTG1 (entget ENTS1)) (setq ENTG2 (entget ENTS2)) (setq P1 (cdr (assoc 10 ENTG1)) P2 (cdr (assoc 11 ENTG1)) P3 (cdr (assoc 10 ENTG2)) P4 (cdr (assoc 11 ENTG2)) EL (cdr (assoc 8 ENTG1)) ) ;_ Fin de setq (entdel ENTS1) (entdel ENTS2) (command "_LAYER" "_S" EL "") (if (> (distance P1 P3) (distance P1 P4)) (setq P5 P1 P6 P3 ) ;_ Fin de setq (setq P5 P1 P6 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P2 P3) (distance P2 P4)) (setq P7 P2 P8 P3 ) ;_ Fin de setq (setq P7 P2 P8 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P5 P6) (distance P7 P8)) (command "_PLINE" P5 "_W" PW "" P6 "") (command "_PLINE" P7 "_W" PW "" P8 "") ) ;_ Fin de if (command "_LAYER" "_S" CL "") (setvar "CMDECHO" 1) ) ;_ Fin de progn ) ;_ Fin de 3eme cond ((and (= (cdr (assoc 0 ENTG1)) "ARC") (= (cdr (assoc 0 ENTG2)) "ARC") ) ;_ Fin de and (progn (setq CA (strcase (getstring "\nChanger arcs en cercle? Y or <N> ")) ) ;_ Fin de setq (if (= CA "Y") (progn (setq P1 (cdr (assoc 10 ENTG1)) RA (cdr (assoc 40 ENTG1)) ) ;_ Fin de setq (command "_LAYER" "_S" EL "") (entdel ENTS1) (entdel ENTS2) (command "_CIRCLE" P1 RA) (command "_LAYER" "_S" CL "") ) ;_ Fin de progn (progn (setq 150X (car (polar (cdr (assoc 10 ENTG1)) (cdr (assoc 50 ENTG1)) (cdr (assoc 40 ENTG1)) ) ;_ Fin de polar ) ;_ Fin de car 150Y (cadr (polar (cdr (assoc 10 ENTG1)) (cdr (assoc 50 ENTG1)) (cdr (assoc 40 ENTG1)) ) ;_ Fin de polar ) ;_ Fin de cadr 151X (car (polar (cdr (assoc 10 ENTG1)) (cdr (assoc 51 ENTG1)) (cdr (assoc 40 ENTG1)) ) ;_ Fin de polar ) ;_ Fin de car 151Y (cadr (polar (cdr (assoc 10 ENTG1)) (cdr (assoc 51 ENTG1)) (cdr (assoc 40 ENTG1)) ) ;_ Fin de polar ) ;_ Fin de cadr 250X (car (polar (cdr (assoc 10 ENTG2)) (cdr (assoc 50 ENTG2)) (cdr (assoc 40 ENTG2)) ) ;_ Fin de polar ) ;_ Fin de car 250Y (cadr (polar (cdr (assoc 10 ENTG2)) (cdr (assoc 50 ENTG2)) (cdr (assoc 40 ENTG2)) ) ;_ Fin de polar ) ;_ Fin de cadr 251X (car (polar (cdr (assoc 10 ENTG2)) (cdr (assoc 51 ENTG2)) (cdr (assoc 40 ENTG2)) ) ;_ Fin de polar ) ;_ Fin de car 251Y (cadr (polar (cdr (assoc 10 ENTG2)) (cdr (assoc 51 ENTG2)) (cdr (assoc 40 ENTG2)) ) ;_ Fin de polar ) ;_ Fin de cadr AP1 (list 150X 150Y) AP2 (list 151X 151Y) AP3 (list 251X 251Y) ) ;_ Fin de setq (command "_LAYER" "_S" EL "") (entdel ENTS1) (entdel ENTS2) (command "_ARC" AP1 AP2 AP3) (command "_LAYER" "_S" CL "") ) ;_ Fin de progn ) ;_ Fin de if ) ;_ Fin de progn ) ;_ Fin de 3eme cond );cond generales ) ;_ Fin de defun je joins aussi une routine plus significative ,laquelle ne fonctionne que pour des lignes mais c'est exactement ce que je veux reproduire par sélection. ;sert a reconstruire des lignes coupées ,selection fenetre ;============================================================================== ; PROJ Projection du point A sur la droite B C avec verification ; selon D comme la fonction INTERS ;============================================================================== (defun _proj (a b c d) (inters b c a (polar a (+ (* 0.5 pi) (angle b c)) 1.0) d ) ) (defun c:reb-lig ( / p q lot la i lb ea eb d p1 p2 p3 p4 d1 d2 ea10 ea11 eb10 eb11 temp) (setq p nil q nil) (initget 1) (setq p (getpoint "\nPremier coin : ")) (initget 1) (setq q (getcorner p "\nAutre coin : ")) (setvar "cmdecho" 0) (command "_erase" "_w" p q "") (if (setq lot (ssget "c" p q)) (progn (while (setq la (ssname lot 0)) (ssdel la lot) (setq i 0) (repeat (sslength lot) (setq lb (ssname lot i)) (setq ea (entget la)) (setq eb (entget lb)) (setq d (apply '(lambda (e1 e2) (if (= "LINE" (cdr (assoc 0 e1)) (cdr (assoc 0 e2))) (progn (setq p1 (cdr (assoc 10 e1)) p2 (cdr (assoc 11 e1)) p3 (cdr (assoc 10 e2)) p4 (cdr (assoc 11 e2)) d1 (distance p1 (_proj p1 p3 p4 nil)) d2 (distance p2 (_proj p2 p3 p4 nil)) ) (if (> 0.001 (abs (- d1 d2))) d1 nil ) ) ) ) (list ea eb) ) ) (cond ((not d) nil) ((> 0.001 (abs d)) (if (= (cdr (assoc 8 ea)) (cdr (assoc 8 eb))) (progn (setq ea10 (cdr (assoc 10 ea)) ea11 (cdr (assoc 11 ea)) eb10 (cdr (assoc 10 eb)) eb11 (cdr (assoc 11 eb)) ) (if (> (distance ea10 eb10) (distance ea10 eb11) ) (setq temp eb10 eb10 eb11 eb11 temp ) ) (if (< (distance ea10 eb10) (distance ea11 eb10) ) (setq temp ea10 ea10 ea11 ea11 temp ) ) (entdel lb) (entmod (append ea (list (cons 10 ea10) (cons 11 eb11) ) ) ) T ) ) ) (T nil) ) (setq i (1+ i)) ) ) ) ) (setvar "highlight" 1) (redraw) (princ) )

une possibilité mais sans établir la liste réelle des entités sur la couleur en Ducalque ;test de selection d'objets par leur couleur (defun c:le-test ( / e dxf_ent la-couleur lenom) (setq e (car (entsel "Selection de la couleur: "))) (setq dxf_ent (entget e)) (if (= (assoc 62 dxf_ent) nil) (progn (setq la-couleur (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 dxf_ent))))));couleur en Ducalque (setq lenom (cdr (assoc 8 dxf_ent))) (SETQ la-sel (SSGET "_x" (LIST (CONS 8 lenom)))) );progn (progn (setq la-couleur (cdr (assoc 62 dxf_ent)));couleur forcée (setq la-sel (ssget "_x" (ssget-ColorIndex-filter la-couleur))) );progn );if (princ) );defun (defun ssget-ColorIndex-filter ( ColorIndex / ) (list (cons 62 ColorIndex) '(-4 . "<NOT") '(-4 . "*") '(420 . 0) '(-4 . "NOT>"));couleur forcée )

Bonjour tout le monde , je butte sur une sélection d'objets quelconque par leur couleur et lorsqu'elle est en Ducalque. J'ai testé le lisp (Special_selections) de gile "ssc" qui me sélectionne toutes les entités de la couleur (ducalque et forcées). Le but est de ne selectionner que ce qui correspond à l'objet soit couleur en ducalque , soit couleur forcée . ci-dessous le lisp ou j'en suis ;test de selection d'objets par leur couleur (defun c:le-test ( / e dxf_ent) (setq e (car (entsel "Selection de la couleur: "))) (setq dxf_ent (entget e)) (if (= (assoc 62 dxf_ent) nil) (setq la-couleur (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 dxf_ent))))));couleur en Ducalque (setq la-couleur (cdr (assoc 62 dxf_ent)));couleur forcée );if (setq la-sel (ssget "_x" (ssget-ColorIndex-filter la-couleur))) );defun (defun ssget-ColorIndex-filter ( ColorIndex / ) (list (cons 62 ColorIndex) '(-4 . "<NOT") '(-4 . "*") '(420 . 0) '(-4 . "NOT>"));couleur forcée )

avec la commande "FLATTEN" d'autocad , mais attention si beaucoup d'objets le traietement est long

Bonjour, Une petite parenthèse ,la routine "laytable" fonctionne en autocad 2006 fr,en 2004fr l'insertion du tableau semble ne pas se faire ,en autocad 2000 fr les tables n'existent pas . tout cela pour dire ,attention aux versions d'autocad utilisées surtout avec les fonctions "vla-................get-TrueColor........."

Bonjour Gile , Complètement d'accord avec les précisions que tu as apportées . merci , a+

Une astuce trouvée sur le net pour l'utilisation de l'éditeur visual lisp d'autocad. mais attention , comme le dit l'article ce sont des variables locales qu'il faut rajouter après "\" pour les mettre à nil .Personnellement j'utilise cette option comme une aide . http:// http://rkmcswain.blogspot.com/2006/07/vlisp-variables.html

bienvenue ElpanovEvgeniy (chouette , une autre grosse pointure ) merci Gile mais les attributs sont toujours pris en compte dans la boundingbox. Ci-dessous une définition d'un des attributs qui embète tout le monde : DEFINITION DES ATTRIBUTS Calque: "HYRREP" Espace: Espace objet Maintien = 491 Style = "Standard" Fichier de polices = txt départ point, X= 215.4429 Y= 163.5739 Z= 0.0000 hauteur 0.1000 par défaut message (_mes_dwg "hy" 1) étiquette REP rotation angle 0 largeur facteur d'échelle 1.0000 inclinaison angle 0 drapeaux normal(e) génération normal(e)

merci Gile , Je viens de tester ,ils sont toujours pris en compte ,je vais y réfléchir demain .Je te tiens informé dès que je trouve une réponse . encore merci

Bonjour Gile , Je viens d'utiliser ta routine "bbox" 11/8/2006 à 21:55 sur des blocs en 2d elle fonctionne quelque soient le SCU dans lequel a été créé l'objet . C'est parfait . Une seule chose m'ennuie c'est qu'elle tient compte de tous les objets constituants un bloc y compris les attributs .Peux tu m'aider ,si c'est possible ,pour y filtrer les attributs afin qu'ils ne soient pas pris en compte dans l'emprise d'un bloc . merci d'avance et félicitations pour ce travail remarquable une fois de plus [Edité le 26/10/2006 par sergeluc]

merci gile , c'est toujours exceptionnel . Bonne journée

Bonjour à tous , Pour éviter de mettre des " ; " à toutes les lignes de commentaires dans un programme autolisp ou vlisp ,vous pouvez pour un ensemble continu de lignes de caractères utiliser le code ascii " | " Alt 6 au clavier et un " ; " en début et fin de l'ensemble de ces lignes . Ce qui donne : (print "Test debut") |;ceci est un test pour les lignes suivantes qui sont des commentaires ne seront pas interprètées bla bla bla bla bla bla (setq test (car (entsel))) |; bla bla bla (print "Test fin")

mettre un ensemble de lignes en commentaires rapidement reponse dans le message suivant [Edité le 27/9/2006 par sergeluc]

Bonjour à tous ; avec un peu ......de temps on trouve ,voici une solution : ;test de decoupe par la fonction TRIM de lignes , plines , lwpolylines traversant une lwpolyline FERMEE (exemple: un rectangle) et suppression des objets a l'interieur de la fenetre de découpe ;on peut aussi découper des cercles,vertex (defun c:test4 (/ ent) (vl-load-com) (setq ent (entsel "\nChoix d'une polyligne "));pour exemple (setq ent (entget(car ent))) (test4) (princ) );defun (defun test4 ( / pt_lst bbox1 pt1-bbox1 pt2-bbox1 pt3-bbox1 pt4-bbox1 pt5-bbox1) ;sort la liste des points de tous les sommets (cond ((= (cdr (assoc 0 ent)) "LWPOLYLINE");pour exemple (setq nbs (cdr (assoc 90 ent)) cnt 0 pt_lst '() ) ;_ Fin de setq (while (< cnt nbs) (if (= (caar ent) 10) (setq pt_lst (cons (cdar ent) pt_lst) cnt (+ cnt 1) ) ;_ Fin de setq ) ;_ Fin de if (setq ent (cdr ent)) ) ;_ Fin de while (setq pt_lst (reverse pt_lst));sans Z (setq ptscu (mapcar '(lambda (x) (trans x 0 1)) pt_lst));avec Z ;je récupère les points min et max pour dessiner un rectangle (setq p_min (list (apply 'min (mapcar 'car ptscu)) ;pour les cas ou on trouve pwline fermée +lines exct ;(apply 'min (mapcar 'caddr ptscu));a voir pour pwline fermées (apply 'max (mapcar 'cadr ptscu));pour pwline ouvertes 0.0 );list p_max (list (apply 'max (mapcar 'car ptscu)) ;(apply 'max (mapcar 'caddr ptscu));a voir pour pwline fermées (apply 'min (mapcar 'cadr ptscu));pour pwline ouvertes 0.0 );list );setq ;création du rectangle qui sert à la découpe (command "_.rectang" p_min p_max);pour test (setq bbox1 (entlast)) ;je récupére les 4 assoc 10 du rectangle (if bbox1 (progn (setq n-bbox1 (entget bbox1)) (setq nbs (cdr (assoc 90 n-bbox1)) cnt 0 pt_lst '() ) ;_ Fin de setq (while (< cnt nbs) (if (= (caar n-bbox1) 10) (setq pt_lst (cons (cdar n-bbox1) pt_lst) cnt (+ cnt 1) ) ;_ Fin de setq ) ;_ Fin de if (setq n-bbox1 (cdr n-bbox1)) ) ;_ Fin de while (setq pt_lst (reverse pt_lst));sans Z (setq ptscu1 (mapcar '(lambda (x) (trans x 0 1)) pt_lst));liste avec les Z ;les 4 assoc 10 (setq pt1-bbox1 (nth 0 ptscu1) pt2-bbox1 (nth 1 ptscu1) pt3-bbox1 (nth 2 ptscu1) pt4-bbox1 (nth 3 ptscu1) );setq ;suppression des objets superflus a l'interieur de la fenetre (command "_.erase" "_w" pt1-bbox1 pt4-bbox1 "_r" bbox1 "") ;;;;;;;;;DECOUPE DU POINT 1 AU POINT 1;;;;;;;;;;;;;; (command "_.trim" bbox "" "_f" pt1-bbox1 pt2-bbox1 "" "_f" pt2-bbox1 pt3-bbox1 "" "_f" pt3-bbox1 pt4-bbox1 "" "_f" pt4-bbox1 pt1-bbox1 "" "" );command ;suppression du rectangle (entdel bbox1) (alert "terminé");test fin de fonction );progn );if bbox );cond ) ;_ Fin de cond );defun test4 (c:test4) [Edité le 26/9/2006 par sergeluc]

j'ai trouvé la solution en changeant les polices de caractères utilisées dans autocad ce qui rejoint la réponse de capde06 .

Bonjour X13 Je ne l'ai pas encore installé mais à l' adresse suivante tu trouveras ce fichier "ObjectDCL-help.zip" http://discussion.autodesk.com/thread.jspa?threadID=491276

bonjour , Je ne sais pas si c'est le meme mais j'en est essayé un du meme nom sur acad2006 "CUI to MNU.vlx" commande "CuitoMnu" il m'a généré le fichier suivant pour ABSTools.cui : // // AutoCAD menu file // // // Default AutoCAD NAMESPACE declaration: // ***MENUGROUP=ABSTOOLS // // Begin AutoCAD Digitizer Button Menus // // // Begin System Pointing Device Menus // // // Begin AutoCAD Pull-down Menus // ***POP1 ABSTOOLSID_Mnu [&ABS Tools] ABSTOOLSID_ClashReporter [Clash Reporter]^C^C_.ABSTOOLSCLASHREPORT ABSTOOLSID_FabStyle [&Fabrication Styles]^c^c_.ABSTOOLSFABRICATIONSTYLE ABSTOOLSID_HgrStyle [Hanger &Styles]^c^c_.ABSTOOLSHANGERSTYLE [--] ABSTOOLSID_Help [ABS Tools &Help]^c^c_.ABSTOOLSHELP ABSTOOLSID_About [&About ABS Tools]^c^c_.ABSTOOLSABOUT // // Begin AutoCAD ToolBars // // // Begin AutoCAD Image Menus // // // AutoCAD Screen Menus // // // Begin AutoCAD Tablet Menus // // // Help Strings // ***HELPSTRINGS ABSTOOLSID_About [About ABS Tools] ABSTOOLSID_FabStyle [Fabrication Styles] ABSTOOLSID_HgrStyle [Hanger Styles] // // Keyboard Accelerators // // // End of AutoCAD menu file // Je suis plus que sceptique , il y en a un gratuit à cette adresse : http://home.pacifier.com/~nemi/ qui s'appelle : "lprof.lsp" que je joins ,mais je n'ai pas réussi a le faire fonctionner .Si je trouve un peu de temps je regarderai cela de plus près et si quelqu'un veut le faire . (defun c:lprof () (setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0) (vl-load-com) (setq acadobject (vlax-get-Acad-Object)) (setq acadprefs (vla-get-preferences acadobject)) (setq acadprofiles (vla-get-profiles acadprefs)) (vlax-dump-object acadprofiles T) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (initget 1 "Menu Cui") (setq key (getkword "\nLoad MENU or CUI file>: ")) (cond ((= key "Menu")(setq word "Load Menu File")(setq mn "mnu")) ((= key "Cui")(setq word "Load CUI File")(setq mn "cui")) ) (setq lok1 (getfiled word "c:/Documents and Settings/" mn 8)) (setq lgt (strlen lok1)) (setq aa (substr lok1 1 (- lgt 4))) (setq lgtaa (strlen aa)) (setq count (- lgtaa 1)) (setq chk "0") (while (/= chk "\\") (setq chk (substr aa lgtaa 1)) (cond ((/= chk "\\")(setq count (- count 1)) (setq lgtaa (- lgtaa 1))) ((= chk "\\")(setq bb (substr aa (+ 2 count)))) ) ) (setq bb (strcase bb)) (setq cc (strcase (strcat bb "-PROFILE"))) (setq ACAD1 (strcat ";" (substr aa 1 lgtaa))) (setq mname (strcat aa ".mnu")) (setq mmname (strcat"P15=+" bb ".POP15")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vla-put-ActiveProfile acadProfiles "<>") (setq ACAD2 (getenv "ACAD")) (setq ACAD3 (strcat acad2 ACAD1)) (setq prname (getvar "cprofile")) (vlax-invoke-method acadProfiles 'CopyProfile prname cc) (vla-put-ActiveProfile acadProfiles cc) (setenv "ACAD" ACAD3) (command "_.menuload" mname) (menucmd mmname) (setvar "cmdecho" cmd) (princ) ) Nota: à l'invite : mnu ou cui , tapez votre choix pour le sens de conversion .

bonjour à tous , Je sens que ce sujet va me passionner .Je vais de suite lire les rubriques du forum "ObjectDCL" merci à tous

Bonjour, si cela peut aider il y a cette routine http:// http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=10802#pid41812 en supprimant : (if l3 (xref-ins-2000);pour acad2000 et 2006 ) ;if l3 elle détache tous les xrefs sans chemins (non trouvés)

Bonjour, voici le résultat de mes élucubrations pour traiter des xrefs sur Autocad 2000 et 2006 en supprimant ceux déclarés dont le chemin n'est pas reconnu ,en insérant en bloc ceux qu'ils le sont et en les explosant.Mon problème se posait sutout sur la version acad2000. En récupérant a droite et à gauche des bouts de code et surtout avec l'aide de Gile ,je suis arrivé à cette compilation qui fonctionne et pourra sans doute etre améliorée . ;Le 30/06/06 DETACHEMENT des xrefs dont le chemin n'est plus valide ;insertion en bloc et explosion du (des) bloc(s) des xrefs valides ;fonctionne en acad2000 et 2006 ;------------------ (defun c:detach-ins-ref (/ cmd bl rc n tot AcDoc rep itm) (vl-load-com) (setq cmd (getvar "cmdecho") tot 0 bl (tblnext "block" t) l2 nil l3 nil rep "*\\*" ) ;_ Fin de setq (setvar "cmdecho" 0) (command "_.undo" "_group") (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (while bl (if (= (logand (cdr (assoc 70 bl)) 4) 4) (progn (setq rc (cdr (assoc 1 bl)) n (substr rc 1 (- (strlen rc) 4)) ) ;_ Fin de setq (if (and (not (findfile rc)) (not (wcmatch (cdr (assoc 1 bl)) rep)) ) ;and ;liste des xrefs nommés dans la liste sans chemins (progn (setq l2 (cons n l2)) (setq tot (1+ tot)) ) ;_ Fin de progn ;liste des xrefs nommés dans la liste avec chemins (progn (setq l3 (cons n l3)) (setq tot (1+ tot)) );progn ) ;_ Fin de if ) ;_ Fin de progn ) ;_ Fin de if xref (setq bl (tblnext "block")) ) ;_ Fin de while (deverou-cal) ;--------------------------------------------- (if l2 ;on détache les xrefs sans chemins (foreach x l2 (vla-detach (vla-item (vla-get-Blocks AcDoc) x)) ) ;foreach ) ;if l2 ;--------------------------------------------- (if l3 (xref-ins-2000);pour acad2000 et 2006 ) ;if l3 (setq l2 nil l3 nil ss nil );setq (restor-cal) (vla-PurgeAll AcDoc) (command "_.undo" "_end") (setvar "cmdecho" cmd) (princ) ) ;_ Fin de defun ;----------------------------------- ;; Dévérouillage de tous les calques (defun deverou-cal () (repeat (setq n (vla-get-count (vla-get-Layers AcDoc))) (setq lay (vla-item (vla-get-Layers AcDoc) (setq n (1- n)))) (if (= :vlax-true (vla-get-lock lay) ) ;_ Fin de = (progn (vla-put-lock lay :vlax-false) (setq l_lst (cons lay l_lst)) ) ;_ Fin de progn ) ;_ Fin de if ) ;_ Fin de repeat );defun ;--------------------------------------------- ;; Restauration de l'état des calques (defun restor-cal () (if l_lst (mapcar '(lambda (x) (vla-put-lock x :vlax-true) ) ;_ Fin de lambda l_lst ) ;_ Fin de mapcar ) ;_ Fin de if );defun ;--------------------------------------------- (defun xref-ins-2000 ( / s-bind nb s-visr) (setq s-bind (getvar "bindtype")) (setq s-visr (getvar "visretain")) (setvar "bindtype" 1) (setvar "visretain" 1) (if (setq nb (ssget "x" '((0 . "insert")))) (progn (setq nb (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex nb) ) ) ) );setq (foreach item nb (if (vlax-property-available-p item "path") (progn (command "_xref" "_bind" (vla-get-name item));attacher ou lier suivant bindtype (setq ss (ssget "X" (list '(0 . "INSERT") (cons 2 (vla-get-name item))))) (command "_explode" ss) );progn );if );foreach );progn );if (setvar "bindtype" s-bind) (setvar "visretain" s-visr) (princ) ) ;--------------- ;nota : ;(command "_-xref" "_bind" "*");marche en acad2006 et pas en 2000 ;vla-get-Path pose des problémes en autocad2000

voir routine dans ci-dessous [Edité le 2/7/2006 par sergeluc]

Bonjour Gile j'ai testé sur autocad2000 et 2006 avec un plan de 1.8méga et 2 xrefs. spurge version 1.2 avec 1 xref chargé et l'autre chemin non reconnu . j'ai arreté la procédure au bout de 5 minutes.(trop long) XREF_PURGE seul aucun résultat .les xrefs conservent leur état initial quel qu'il soit. et purge_xref du 5/6/2006 à 21:15 avec les corrections pour la version 2000 . détache les xrefs quelque soit leur état (chemin reconnu ou pas) a+

Bonjour Gile Je viens de récupérer ta dernière version 1.1 je testerai demain (le 14-06) sur 2000 et 2006 Tant qu'il sagit d'xref et de purge cela m'intéresse . A+ de monis en monis de disponibilité en ce moment,mais je ne désespère pas..... [Edité le 16/6/2006 par sergeluc]

bonsoir Gile je viens de faire plusieurs test sur "spurge" la dernière sur acad2000 avec la bonne version purge_xref j'ai des résultats bizarre .Tout dépend de ce que l'on insert ou pas. 1)un xref comprenant 20 blocs (avec spurge seul) + bloc seul = boucle sans fin en rajoutant raster ou purge_xref =la meme chose avec puge_xref seul detache l'xref avec chemin connu+retour: erreur automation aucune description n'a été entrée 2)raster_purge seul ne me renvoi aucune erreur purge _xref me renvoi ;erreur automation aucune description n'a été entrée et me purge l' xref dont le chemin est connu et laisse biensur le bloc unique et donc pas de retour de vla-auditinfo 3)dessin vierge spurge seul ..retour OK spurge+purge_xref ... retour OK 4) dessin avec 1 xref (sans bloc) avec spurge+xref_purge= erreur type d'argument incorrect :consp nil idem avec spurge seul avec purge_xref seul = erreur automation aucune description n'a été entrée et il m'enleve l'xref dont le chemin est connu . Bon j'arrete cela devient un peu brouillon,jespère que ca va t'aider [Edité le 12/6/2006 par sergeluc]