-
Compteur de contenus
5 029 -
Inscription
-
Dernière visite
-
Jours gagnés
56
Type de contenu
Profils
Forums
Calendrier
Blogs
Tout ce qui a été posté par bonuscad
-
toujours sous 2002 _pasteblock fonctionne avec les options X Y et Z _pasteclip ne fonctionne pas Ces options auraient elles été laissé par oubli avec _pasteclip? On pourrait le croire
-
Même comportement sous 2002 :( Mais ne serait ce pas simplement des autres raccourcis possibles de l'option E ou Echelle. En passant par cette option il est signifié comme message: Spécifiez le facteur d'échelle des axes XYZ: Il est bien notifié "des axes" , ce qui laisserait entendre qu'un traitement individuel ne serait pas possible..... Mais c"est vrai qu'il est surprenant que l'évolution dynamique, avant confirmation, donne un résultat correct. :o Si l'on fait succèder les options X et Y, j'ai l'impression que c'est la valeur de X qui prime comme facteur d'échelle.
-
Bonjour Tout d'abords une histoire de vocabulaire: Ce que tu veux réaliser est une "Macro" et non un "Script". La difèrence ?!! Une macro accepte une entrée utilisateur, un srcript non. Une macro peut utiliser aussi le language diesel. Un sript se réalise dans un fichier d'extension SCR. Ce que tu a besoin est une pause, elle se fait avec le symbole anti-slash "\" Un exemple de macro réalisable: ^C^C^P$M=$(if,$(!=,$(getvar,cvport),2),_.mspace;)_.ucs;_3point;\\\_.plan;_current;_.ucs;_world;^Z
-
Slt Un oeil à ce fil où ce thème était évoqué.
-
probleme sur un simple script
bonuscad a répondu à un(e) sujet de dilack dans Personnalisation, macros, DIESEL
Avec l'aide précieuse de Patrick_35, un lisp à été confectionné pour créer un script destiné à traiter un dossier désigné. Ce lisp est personnalisable a volonté pour créer toute sorte de script Dans ton cas cela donnerais: (defun c:make_script ( / prefix file_scr) (setq prefix (strcat (vl-filename-directory (getfiled "Sélectionner un fichier dessin TEMOIN" "" "dwg" 16)) "\\") file_scr (open (strcat prefix "open_folder.scr") "w") ) (foreach dwg (vl-directory-files prefix "*.dwg" 1) (write-line "_.open" file_scr) (write-line (strcat "\"" prefix dwg "\"") file_scr) [color=green] ;; ;;debut partie personnalisable ;; (write-line "_.zoom" file_scr) (write-line "_extent" file_scr) (write-line "_.mslide" file_scr) (write-line (strcat "\"" prefix (substr dwg 1 (- (strlen dwg) 4)) "\"") file_scr) ;; ;;fin partie personnalisable ;; [/color] (write-line "_.qsave" file_scr) (write-line "_.close" file_scr) ) (close file_scr) (princ (strcat "\Vous pouvez lancer le SCRIPT :" prefix "open_folder.scr")) (prin1) ) Alors pourquoi ne pas profiter des reflexions des membres de ce forum qui aboutissent à des solutions qui simplifie la vie? -
utiliser la liste des fichiers .dwg dans un lisp
bonuscad a répondu à un(e) sujet de bucheron dans Débuter en LISP
Tiens ça me rappele quelque chose Patrick_35 ;) Tes remarque m'ont été très précieuses, mais à mon tour d'en faire une. :D J'ai remarqué après plusieurs tests que : (getfiled "Choisissez un fichier de référence" (getvar "dwgprefix") "dwg" 8) renvoie le nom du chemin + fichier pour une sélection hors des chemins de recherche, mais renvoie le nom du fichier SEUL si la sélection se fait dans un dossier de recherche. Par contre (getfiled "Choisissez un fichier de référence" (getvar "dwgprefix") "dwg" 16) renvoie bien le nom du dossier+fichier dans TOUT les cas. Ce qui conviendra mieux pour récupérer le chemin ;) @+ -
Connaitre les coordonnees du curseur par prog
bonuscad a répondu à un(e) sujet de gandhi dans AutoCAD 2005
Comme le dit notre cher ami Tramber, j'utiliserais aussi la fonction (grread) Celle ci est une fonction très puissante de lecture de périphérique d'entrée, elle peut même être utilisé dans un script (astuce) pour executer une entrée utilisateur. Preuve que c'est une fonction de 1er niveau qu'autocad interpréte en priorité. Voici un exemple de ce que tu pourrais faire (à adapter à ton besoin bien sur) (defun c:dyn_pt-cursor ( / sv_shmnu key) (setq sv_shmnu (getvar "SHORTCUTMENU")) (setvar "SHORTCUTMENU" 11) (while (and (setq key (grread T 4 0)) (not (member key '((2 13) (2 32)))) (/= (car key) 25)) (cond ((or (eq (car key) 5) (eq (car key) 3)) (print (cadr key)) ) ) ) (setvar "SHORTCUTMENU" sv_shmnu) (prin1) ) Ceci te retournera en dynamique le point de positionnement du curseur sous la forme d'une liste (X Y Z). Entrée, Espace ou Click-droit sort de la boucle de lecture. -
Tu as raison Christian, après quelques essais, seul le texte simple, les cercles et les insertions de bloc sont accepter comme point de modification avec la commande CHANGER. Pour Ganok, le problème se retourne sur le fitre de la chaine de texte :casstet: Difficile de contourner cet obstacle (mais moindre mal, la boite ne sera utilisée qu'une seule fois pour filtrer tout les textes)
-
Bonjour, Si tu pouvais le mettre sous cette forme, il n'y aura pas de problème! 7188,32211.1227,54685.4545,36.32 7189,32210.1740,54684.0084,35.63 7199,32212.9382,54624.2911,34.38 7202,32213.4473,54622.8716,35.09 7206,32196.0647,54572.8861,35.18 7295,32196.2404,54570.8418,36.26 7296,32171.8534,54560.8802,38.54 7297,32173.0374,54560.2201,38.39 7494,31947.5829,54410.4740,46.72 7495,31947.1114,54411.1135,46.70 7496,31950.4759,54421.5120,46.00 Ceci est facilement faisable avec un éditeur de texte, même avec Excel cela doit être possible, à condition d'enregistrer au format texte. Autrement trouver autre chose....
-
Je pense qu'il voulait parler de "_.QSELECT" Par curiosité j'ai voulu faire un essai avec "_.SELECT" "_ALL" et lancer un script _.change _previous Texte modifié Texte modifié Texte modifié ............ Je ne sais pas si c'est de la chance, mais la commande "changer" m'a traitée que les textes bien que j'avais intercalé des lignes et polylignes dans l'ordre de création dans mon dessin de test. A essayer plus en pronfondeur....
-
besoin d\'aide: échelle d\'impression
bonuscad a répondu à un(e) sujet de loupigne dans AutoCAD 2006
2 autres solutions dans ce fil Tu as le choix, et en cherchant un peu tu peux en trouver d'autres! -
Ce que cherche à faire Ganok est de passer outre la boite de dialogue de la commande "RECHERCHER" ou "_FIND" A priori ce n'est pas possible. La syntaxe "_.-FIND" (avec le tiret) ne marche pas avec cette commande comme on pourrait le faire avec "_.-LAYER". Vu que cela concerne une LT, une solution à creuser, serait d'uriliser un filtre sur les textes avec la chaine à rechercher. Une fois la sélection faite utiliser la commande "_.CHANGE" avec l'option "Spécifiez le point de modification" et non "[Propriétés]" Après une série de validation par "entrée" tu arrive à l'option du changement de texte. Tout ceci peut se faire dans un script pour arriver directement à l'option qui t'interresse. Pas de meilleure solutions en LT. ;)
-
Vous ne verrez plus jamais la Terre de la même façon
bonuscad a répondu à un(e) sujet de alf_ze_cat dans SIG internet
Ce lien est aussi interessant. Porté plus sur des phénomènes anormaux. Dites 33 !.... -
Courbes altimétriques ?
-
augmenter l\'affichage des pointillés
bonuscad a répondu à un(e) sujet de miamy dans AutoCAD LT 2004
Bonjour, Copier-coller la définition suivante dans ROND_PLEIN.SHP *128,64,RONDPLEIN 1,10,(1,040), 3,10, 2,010,1, 10,(9,040), 2,010,1, 10,(8,040), 2,010,1, 10,(7,040), 2,010,1, 10,(6,040), 2,010,1, 10,(5,040), 2,010,1, 10,(4,040), 2,010,1, 10,(3,040), 2,010,1, 10,(2,040), 2,010,1, 10,(1,040), 4,10,2,0 Compiler en SHX ce fichier. Créer un fichier DotsLine.lin contenant: *DotsLine,pointillé shx . . . . A,0,-1,[RONDPLEIN,rond_plein.shx,x=0,s=.1],0 Placer ces fichier dans un dossier de recherche d'AutoCAD. Il ne reste plus qu'à charger ce nouveau type de ligne NE PAS utiliser d'épaisseur -
Si tu veux traiter tout un dossier de bibliothèque, et comme tu as posté dans la catégorie version pleine. Je te propose une procédure lisp qui va générer automatiquement un script pour traiter tous les dessins de ton dossier. Lorque tu auras chargé et lancé la routine dans un nouveau dessin, il te seras demandé de pointé un dessin TEMOIN dans un dossier. Dès lors un fichier script seras créé dans ce dossier, il te suffira alors d"executer le fichier "OPEN_FOLDER.SCR" avec la commande SCRIPT. ATTENTION: Les noms de fichier accentués ont l'air de poser problème (à vérifier) NB:Cette procédure peut être personnalisée pour créer tout type de script pour un traitement par lot. L'exemple ci dessous est adapté a ta demande ;) (defun c:open_folder ( / prefix file_dwg file_scr dwg) (setq prefix (getfiled "Sélectionner un fichier dessin TEMOIN" "" "dwg" 8)) (setq prefix (substr prefix 1 (- (strlen prefix) (strlen (substr prefix (+ 2 (vl-string-position 92 prefix nil t))))))) (command "_.sh" (strcat "dir \"" prefix "*.dwg\"/b>\"" prefix "\"files.txt")) (command "_.dir" (strcat prefix "files.txt")) (setq file_dwg (open (strcat prefix "files.txt") "r")) (setq file_scr (open (strcat prefix "open_folder.scr") "a")) (while (setq dwg (read-line file_dwg)) (write-line "_.open" file_scr) (write-line (strcat "\"" prefix dwg "\"") file_scr) ;;[color=red] ;;debut partie personnalisable ;; (write-line "_.zoom" file_scr) (write-line "_extent" file_scr) (write-line "_.scale" file_scr) (write-line "_all" file_scr) (write-line "" file_scr) (write-line (strcat (rtos (car (getvar "INSBASE")) 2 4) "," (rtos (cadr (getvar "INSBASE")) 2 4) "," (rtos (caddr (getvar "INSBASE")) 2 4)) file_scr) (write-line "0.001" file_scr) (write-line "_.zoom" file_scr) (write-line "_extent" file_scr) ;; ;;fin partie personnalisable[/color] ; (write-line "_.qsave" file_scr) (write-line "_.close" file_scr) ) (close file_scr) (close file_dwg) (command "_.del" (strcat prefix "files.txt")) (textscr) (princ (strcat "\Vous pouvez lancer le SCRIPT :" prefix "open_folder.scr")) (prin1) )
-
Bonjour, Au fil d'un surf erratique je suis tombé sur ces liens, si ça peut te rendre service :exclam: Common Lisp Ceci a travers un post "in English" explicant une procédure d'utilisation,dans un forum J'espère que j'ai bon! Je suis pas un utilisateur de Common Lisp :casstet:
-
Salut Je viens justement la remanier un peu, j'ais rejoins tes observations sans le vouloir, mais je me suis arrêté a mon usage pour coter les pentes de talus sur les profils en travers. Tu peux essayer de l'ajuster encore a tes besoins (le plus gros est fait) ;) (defun C:SLOPE ( / blp pt_o pt_f frac_prec sv_osmd e_last dxf_o slope slope_h slope_v nx sv_ortho pt_start pt_x t2_slope t1_slope pt_mid pt_text pt_int ed_1) (setvar "cmdecho" 0) (setq blp (getvar "blipmode")) (setvar "blipmode" 0) (initget 9) (setq pt_o (getpoint "\nSpécifiez le point de départ: ")) (cond (pt_o (initget 41) (setq pt_f (getpoint pt_o "\nChoix du point final: ")) (cond (pt_f (command "_.undo" "_group") (cond ((null (member (getvar "USERI1") '(1 10 100 1000))) (initget "Unité Dizaine Centaine Millier _Unit TEn Hundred THousand") (setq frac_prec (getkword "\Précision de la fraction [unité/Dizaine/Centaine/Millier]: ")) (if (not frac_prec) (setq frac_prec "TEn")) (cond ((eq frac_prec "Unit") (setq slope_v 1)) ((eq frac_prec "TEn") (setq slope_v 10)) ((eq frac_prec "Hundred") (setq slope_v 100)) ((eq frac_prec "THousand") (setq slope_v 1000)) ) (setvar "USERI1" slope_v) ) (T (setq slope_v (getvar "USERI1"))) ) (setq sv_osmd (getvar "osmode")) (setvar "osmode" 0) (command "_.ray" pt_o pt_f "") (setq e_last (entlast) dxf_o (trans (cdr (assoc 11 (entget e_last))) 0 1 T) ) (entdel e_last) (if (and (not (zerop (car dxf_o))) (not (zerop (cadr dxf_o)))) (setq slope (abs (/ (car dxf_o) (cadr dxf_o))) slope_h (fix (* slope_v slope)) nx (if (zerop slope_h) 0 (gcd slope_h slope_v)) ) (if (zerop (car dxf_o)) (setq slope_v 1 slope_h 0 nx 0) (setq slope_v 0 slope_h 1 nx 0)) ) (setq sv_ortho (getvar "orthomode")) (while (> nx 1) (setq slope_h (/ slope_h nx) slope_v (/ slope_v nx) nx (gcd slope_h slope_v)) ) (setvar "orthomode" 1) (setq pt_start (mapcar '/ (mapcar '+ pt_o pt_f) '(2.0 2.0 2.0)) pt_start (list (car pt_start) (cadr pt_start) 0.0)) (initget 9) (setq pt_x (getpoint pt_start "\nSpecifiez la grandeur du symbole: ") pt_x (list (car pt_x) (cadr pt_x))) (if (equal (car pt_x) (car pt_start) 1E-12) (setq t2_slope (rtos slope_h 2 0) t1_slope (rtos slope_v 2 0)) (setq t2_slope (rtos slope_v 2 0) t1_slope (rtos slope_h 2 0)) ) (repeat 2 (command "_.dimordinate" pt_start "_text" t1_slope pt_x) (setq pt_mid (mapcar '/ (mapcar '+ pt_start pt_x) '(2.0 2.0 2.0))) (if (equal (car pt_x) (car pt_start) 1E-12) (setq pt_int (polar pt_x 0.0 (distance pt_start pt_x))) (setq pt_int (polar pt_x (/ pi 2.0) (distance pt_start pt_x))) ) (if (and (not (zerop (car dxf_o))) (not (zerop (cadr dxf_o)))) (setq pt_start (inters pt_o pt_f pt_x pt_int nil)) (setq pt_start pt_x) ) (setq t1_slope t2_slope pt_text (polar pt_mid (angle pt_start pt_x) (getvar "dimtxt")) ) (command "_aidimtextmove" "_2" (entlast) "" pt_text) (if (not ed_1) (setq ed_1 (entlast))) ) (command "_.-group" "_create" "*" "" (entlast) ed_1 "") (setvar "orthomode" sv_ortho) (setvar "osmode" sv_osmd) (command "_.undo" "_end") ) ) ) ) (setvar "blipmode" blp) (setvar "cmdecho" 1) (prin1) ) Modifcation du code lors de la dernière l'édition du post: * Ajout de la précision fractionnaire (établie lors du 1er usage) * Correction de la position du texte qui était mal placé dans certain cas * Gestion des cas particulier qui provoquaient un échec de la routine (segments horizontaux et verticaux) * Une seule action d'annulation Le code (devrait) être plus fiable...... [Edité le 13/7/2005 par bonuscad]
-
Salut, C'est vrai que tout ça est bien long! Je te fais une proposition où je m'y suis pris autrement, cela fonctionne dans le SCU courant, sans boite de dialogue et tu positionnes tes traits (longueur, dessus/dessous) et le texte comme tu veux. A essayer! modifier ou adapter à tes besoins ;) (defun C:SLOPE ( / blp pt_o pt_f sv_osmd e_last dxf_o slope sv_ortho pt_start pt_x t2_slope t1_slope ed_1) (setvar "cmdecho" 0) (setq blp (getvar "blipmode")) (setvar "blipmode" 0) (initget 9) (setq pt_o (getpoint "\nSpécifiez le point de départ: ")) (cond (pt_o (initget 41) (setq pt_f (getpoint pt_o "\nChoix du point final: ")) (cond (pt_f (setq sv_osmd (getvar "osmode")) (setvar "osmode" 0) (command "_.ray" pt_o pt_f "") (setq e_last (entlast) dxf_o (trans (cdr (assoc 11 (entget e_last))) 0 1 T) ) (entdel e_last) (setq slope (/ (car dxf_o) (cadr dxf_o)) sv_ortho (getvar "orthomode")) (setvar "orthomode" 1) (setq pt_start (mapcar '/ (mapcar '+ pt_o pt_f) '(2 2 2))) (initget 9) (setq pt_x (getpoint pt_start "\nSpecifiez la grandeur du gabarit: ")) (if (eq (car pt_x) (car pt_start)) (setq t2_slope (rtos slope 2 1) t1_slope (rtos 1 2 0)) (setq t2_slope (rtos 1 2 0) t1_slope (rtos slope 2 1)) ) (repeat 2 (command "_.dimordinate" pt_start "_text" t1_slope pt_x) (command "_aidimtextmove" "_2" (entlast) "" (mapcar '/ (mapcar '+ pt_start pt_x) '(2 2 2))) (princ "\nPosition du texte: ") (command "_aidimtextmove" "_2" (entlast) "" pause) (if (not ed_1) (setq ed_1 (entlast))) (setq pt_start (inters pt_o pt_f pt_x (polar pt_x (if (eq (car pt_x) (car pt_start)) 0.0 (/ pi 2.0)) (distance pt_start pt_x)) nil) t1_slope t2_slope) ) (command "_.-group" "_create" "*" "" (entlast) ed_1 "") (setvar "orthomode" sv_ortho) (setvar "osmode" sv_osmd) ) ) ) ) (setvar "blipmode" blp) (setvar "cmdecho" 1) (prin1) )
-
Salut Didier Je connais pas ce problème pour la commande Décaler, mais il est fort possible qu'il existe sous des versions 2000. Cependant je connais un problème similaire, et ça depuis de nombreuses versions succesives. Cela concerne les commandes Hachure et Contour. Si tu travaille en coordonnées Lambert, tu peux être confronté à un problème de reconnaissance de contour. Tu as droit à un message "contour introuvable" Si tu déplace ton origine de SCU auprès de ta zone, la reconnaissance se fait alors sans problème. Je pense que c'est du à la précision du calcul qui est "bouffé" par la définition de la mantisse des grands nombres (6 à 7 chiffres avant la virgule) Cela ne permet plus assez de précision pour les décimales qui sont alors certainement arrondie avant un "fuzz" de précision élevée.
-
Salut, Une autre proposition en lisp (defun c:offset_near ( / e_sel dis_off v_icon) (while (null (setq e_sel (entsel "\nChoix de l'objet à décaler: ")))) (initget "Par _Through" 6) (setq dis_off (getdist (strcat "\nSpécifiez la distance de décalage ou [Par] <" (rtos (getvar "offsetdist")) ">: "))) (if dis_off (setvar "offsetdist" (if (eq dis_off "Through") -1 dis_off))) (setvar "cmdecho" 0) (setq v_icon (getvar "ucsicon")) (setvar "ucsicon" 0) (command "_.ucs" "_entity" e_sel) (princ "\nSpécifiez un point sur le côté à décaler: ") (command "_.offset" "" e_sel pause "") (command "_.ucs" "_previous") (setvar "ucsicon" v_icon) (setvar "cmdecho" 1) (prin1) ) Malgré que tu ais posté en LT, cependant je vais te faire aussi une proposition en script pour une LT Ce script sera moins perfomant, il ne fonctionnera qu'avec des polylignes, lignes et à la limite des splines, mais pas avec des arcs, cercles ou ellipses, mais bon se sera mieux que rien A placer dans un bouton: ^C^C_ucsicon;_off;_.select;_single;\_.copy;_previous;;_none;*0,0,0;_none;*0,0,0;_.ucs;_entity;_last;_.offset;\_none;0,0,0;\;_.erase;_previous;;_.ucs;_previous;_.ucsicon;_on;^Z [Edité le 8/7/2005 par bonuscad]
-
Juste par curiosité! Tes grips sont ils activés dans les blocs? Si oui, vois tu les poignées sur les points caractéristiques de ton objet? Si ce n'est pas le cas, tes blocs sont peut être constitués de solide3D!
-
La ligne de Titifonky est bonne, du moins je l'ai testée d'un un bouton avec ceci: _non ^P(list (/ (+ (car (setq p1 (getpoint))) (car (setq p2 (getpoint)))) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0) (/ (+ (caddr p1) (caddr p2)) 2.0)) Par contre la tienne, je serais surpris qu'elle retourne le milieu de 2 pts. Tu as 4 points / 3 ?!?!? encore que 3 pts/3 pourait te donner le barycentre d'un triangle Autre remarque, ta procédure ne vérifie pas l'accroche-objet, si par malchanche le point retourner se trouve sur un objet, il sera faux suivant le mode actif. Titifonky a utilisé "_non" (aucun) pour palier a ce problème. Quoiqu'il en soit les 2 méthode sont bonnes. Personellement j'utilise le lisp dans un bouton comme ceci ((lambda ( / p1 p2 p) (prompt "\nPoint milieu entre ") (setq p1 (getpoint "premier point : ")) (setq p2 (getpoint p1 "\nsecond point : ")) (setvar "osmode" (+ 16384 (rem (getvar "osmode") 16384))) (setq p (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2) (/ (+ (caddr p1) (caddr p2)) 2) ) ) (setvar "lastpoint" p) )) J'ai choisi cette méthode car si je n'ai pas une commande en cours le point est stoké dans "LASTPOINT" et je peux m'en servir dans la commande suivante à l'aide "@" Mais on pourrait faire la même chose avec (cur + cur)/2 aussi. ;)
-
Cloner dynamiquement un objet
bonuscad a répondu à un(e) sujet de bonuscad dans Programmer en s'amusant
Moi j'ai pu apprendre grâce aux sources d'autres concepteurs. Celles qui m'ont permis de décoller rapidement en lisp étaient les SOURCES d'une application payante. UniTab III pour AutoCad V10 (les dinosaures se rapelleront peut être!) Il me semble essentiel pour moi de livrer ses sources pour de petites applications, de cette manière les plus passionnés pourront progresser (même pour les plus désargentés, ce qui n'est pas rare dans notre profession de DAO voir la discussion sur les salaires) :mad: Et je trouve que ce sont les utilisateurs qui sont le plus à même de personnaliser cet formidable outil qu'est AutoCad. On connait nos besoins, ce qui n'est pas forcément le cas de développeurs payé pour fabriquer un produit, par contre nous n'avons pas ou peu la culture et le temps pour faire ce genre de chose. Y a pas comme un HIC ??? Concernant la routine, elle ne modifie pas une entité existante sur un calque verrouilé (ce qui serait refusé), mais pompe les infos pour en créer une nouvelle, ce qui n'est pas incompatible avec un calque verrouillé. -
Hé oui encore moi avec ce fameux (grread) ;) Ceci pour vous montrer que l'on peut faire une commande pour cloner une entité sans toucher au clavier, rien qu'avec un click Cette commande clone les paramétres: calque, type de ligne, couleur, épaisseur de ligne, échelle du type de ligne et lance la commande pour créer l'entité qui est sous le curseur. Le click-gauche verrouille/déverrouille la reconnaissance faite au dernier emplacement du curseur. (pas forcément utile) Le click-droit lance la commande approprié à l'objet lu sous le curseur ou dernier objet verrouillé par le click-droit NB:L'info du type d'objet (code DXF 0) apparait dans la barre d'état (quand le curseur est positionné dessus) à la place des coordonnées. Bien sur on pourrait encore sophistiquer le lisp, mais le rapport complexité efficacité ne me semble pas mauvais. Et puis c'est juste un amusement, à moins que certain apprécie à utiliser ce genre de routine? (defun c:dyn_clone ( / sv_shmnu loop key ent dxf_ent nam_bl typ_ent lay_ent lin_ent col_ent wid_ent sct_ent flag tabl_dxf cmd_clone) (setq sv_shmnu (getvar "SHORTCUTMENU") loop 0 ) (setvar "SHORTCUTMENU" 11) (while (and (setq key (grread T 4 0)) (not (member key '((2 13) (2 32)))) (/= (car key) 25)) (cond ((and (eq (car key) 3) ent) (setq loop (rem (1+ loop) 2)) ) (T (setq ent (nentselp "" (cadr key))) ) ) (cond ((and ent (zerop loop)) (if (eq (type (car (last ent))) 'ENAME) (setq dxf_ent (entget (car (last ent))) nam_bl (cdr (assoc 2 dxf_ent)) ) (setq dxf_ent (entget (car ent)) nam_bl nil) ) (if (eq (cdr (assoc 0 dxf_ent)) "VERTEX") (setq dxf_ent (entget (cdr (assoc 330 dxf_ent)))) ) (setq typ_ent (cdr (assoc 0 dxf_ent)) lay_ent (cdr (assoc 8 dxf_ent)) lin_ent (cdr (assoc 6 dxf_ent)) col_ent (cdr (assoc 62 dxf_ent)) wid_ent (cdr (assoc 370 dxf_ent)) sct_ent (cdr (assoc 48 dxf_ent)) ) (grtext -2 typ_ent) ) ) ) (cond ((eq typ_ent "LWPOLYLINE") (setq typ_ent "PLINE") ) ((eq typ_ent "POLYLINE") (setq flag (rem (cdr (assoc 70 dxf_ent)) 128)) (cond ((< flag 6) (setq typ_ent "PLINE") ) ((and (> flag 7) (< flag 14)) (setq typ_ent "3DPOLY") ) ((> flag 15) (setq typ_ent "3DMESH") ) ) ) ((or (eq typ_ent "HATCH") (eq typ_ent "SHAPE")) (setq nam_bl (cdr (assoc 2 dxf_ent))) ) ((eq typ_ent "DIMENSION") (setq nam_bl nil) (cond ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 0) (setq typ_ent "DIMLINEAR") ) ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 1) (setq typ_ent "DIMALIGNED") ) ((or (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 2) (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 5)) (setq typ_ent "DIMANGULAR") ) ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 3) (setq typ_ent "DIMDIAMETER") ) ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 4) (setq typ_ent "DIMRADIUS") ) ((or (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 6) (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 70)) (setq typ_ent "DIMORDINATE") ) (T (setq typ_ent "DIM")) ) ) ((eq typ_ent "VIEWPORT") (setq typ_ent "VPORTS") ) ((eq typ_ent "3DSOLID") (initget 1 "BOîte Sphère CYlindre CÔne BIseau Tore _Box Sphere CYlinder COne Wedge Torus") (setq typ_ent (getkword "\n[bOîte/Sphère/CYlindre/CÔne/BIseau/Tore]: ")) ) ) (grtext -2 "") (setvar "SHORTCUTMENU" sv_shmnu) (cond (typ_ent (setvar "clayer" lay_ent) (if lin_ent (setvar "celtype" lin_ent) (setvar "celtype" "ByLayer")) (if col_ent (setvar "cecolor" (itoa col_ent)) (setvar "cecolor" "256")) (if wid_ent (setvar "celweight" wid_ent) (setvar "celweight" -1)) (if sct_ent (setvar "celtscale" sct_ent) (setvar "celtscale" 1.0)) (setq cmd_clone (strcat "_." typ_ent)) (if nam_bl (progn (if (and (setq tabl_dxf (tblsearch "BLOCK" nam_bl)) (eq (boole 1 (cdr (assoc 70 tabl_dxf)) 4) 4)) (command "_.-XREF" "_attach" nam_bl) (command cmd_clone nam_bl) ) ) (command cmd_clone) ) ) (T (prin1)) ) )
