Aller au contenu

bonuscad

Membres
  • Compteur de contenus

    5 029
  • Inscription

  • Dernière visite

  • Jours gagnés

    56

Tout ce qui a été posté par bonuscad

  1. Bien que ce ne soit pas du VBA, Kamal a mis en ligne sur le forum de planetar (ex manandmachine) un ARX nommé QBRICK qui ma fois est digne d'intêret pour couper tout entité linéaire entre-elles. Je vous laisse découvrir par vous même et faire vos remarque si vous en avez!!
  2. Salut tostaky, Regarde ICI La fonction de recherche t'aurais certainement aidé ;)
  3. bonuscad

    Aide sur macros

    Yalta, En considérant le mode ACCROBJ Inactif, la syntaxe suivante devrait être bonne: Commande: _.LINE Spécifiez le premier point: '_cal >> Expression:[surligneur] plt(end,end,0.25)[/surligneur] >> Sélectionnez un objet pour l'accrochage _END: >> Sélectionnez un objet pour l'accrochage _END:
  4. Tramber a bien corrigé l'erreur, elle est identique à l'origininal de l'auteur que j'ai sur mon poste. Je n'ai pas controlé le reste. Je recommande vivement lors de ces démarches de fournir plutôt un LIEN qu'une copie du code qui peut être altérée. Ceci pour un respect de l'auteur qui ne doit pas assumer les modifications du code qui ne sont pas, en plus, NOTIFIEES dans la source. Merci d'avance pour lui Faite une recherche sur le site de l'auteur (je ne l'ai pas), mais ca doit être facile à retrouver. ;)
  5. Salut à tous Je trouve qu'il serait bien qu'AutoDesk propose une commande purger efficace. En effet depuis l'apparition des Dictionnaires dans la base de donnée du dessin et d'application ARX tierce, il n'est pas rare d'avoir un dessin de taille volumineuse par rapport a ce qu'il contient. Qu'on soit obligé, nous pauvre utilisateurs, d'utiliser des routines de tout bord pour pouvoir ramené un dessin dans des limites raisonnable, me semble un comble. En effet un utilisateur lambda sera incapable de vire une liste de filtre de calque rapidement, de virer des entrée dans le dictionnaire qui sont non référencées. Ne trouvez vous désagréable d'avoir sans cesse cette boite de dialogue au sujet des application ARX que vous ne possédez pas et ceci pour toute la durée que vous utiliserez ce dessin. Je suis sûr que j'oublie encore des trucs. Mais en tout cas si rien n'est fait, cela deviendra vite ingérable, pour voir une ligne et une brouette, il vous faudra ouvrir un fichier de taille incommensurable :casstet:
  6. O comme je te comprends :exclam: A défaut, on se rassure quelque peu en voyant le nombre de lecture des posts, qui peut nous laisser croire que ca sert quand même à quelque chose. Maigre consolation je reconnais :mad:
  7. bonuscad

    diviser une polyligne

    Salut, Bon ben si t'es preneur en lisp, je peux te proposer ceci. NB: Je n'ais pas fait de controle sur les polyligne de type maillage, dans ce cas la routine peut avorter. J'ai fais au plus court ;) Ca peut être amélioré ou pris sous un autre angle, comme tout programme. C'est relativement court, donc analysable plus facilement. (defun c:div_pl ( / ent obj_vlax param_start param_end perim_obj res_track old_osmd l_pt lg) (while (null (setq ent (entsel "\nChoix de la Ligne, Polyligne ou Spline: ")))) (cond ((member (cdr (assoc 0 (entget (car ent)))) '("LINE" "LWPOLYLINE" "POLYLINE" "SPLINE")) (vl-load-com) (initget 7) (setq res_track (getint "\nNombre de division: ") obj_vlax (vlax-ename->vla-object (car ent)) param_start (vlax-curve-getStartParam obj_vlax) param_end (vlax-curve-getEndParam obj_vlax) perim_obj (vlax-curve-getDistAtParam obj_vlax (+ param_start param_end)) res_track (/ perim_obj res_track) l_pt '() lg 0.0 old_osmd (getvar "osmode") ) (while (< (+ lg res_track) perim_obj) (setq l_pt (cons (vlax-curve-getPointAtDist obj_vlax (setq lg (+ lg res_track))) l_pt)) ) (setvar "cmdecho" 0) (setvar "osmode" 0) (foreach n l_pt (command "_.break" n "_first" n n)) (setvar "osmode" old_osmd) (setvar "cmdecho" 1) ) (T (princ "\nN'est pas une Ligne, Polyligne ou Spline: ")) ) (prin1) )
  8. Bonjour, La solution de Maximilien est bonne, quoiqu'elle comporte une erreur et une faute de frappe. Il aurait fallu faire une pause dans la commande "_dimlinear" pour achever la commande et que la fonction (entlast) retourne bien la cotation effectuée et non l'entité précédente. Je propose une autre solution différente, cela restera une cotation, mais qui sera dissocié de l'objet. Faire la cotation normalement, puis appliquer la routine, la valeur de retranchement entée sera valable pour la session du dessin (si valeur négative, se sera un ajout) (defun c:dim-n ( / js ent_dim dxf_ent p1 p2 p_nw1 p_nw2) (if (not value) (progn (initget 2) (setq value (getreal "\nValeur à retrancher à la côte sélectionnée <5.0>: ")) (if (not value) (setq value 5.0)) ) ) (while (null (setq js (ssget "_+.:E:s" '((0 . "DIMENSION")))))) (setq ent_dim (ssname js 0)) (setq dxf_ent (entget ent_dim)) (cond ((or (zerop (rem (cdr (assoc 70 dxf_ent)) 32)) (eq (rem (cdr (assoc 70 dxf_ent)) 32) 1)) (setq p1 (cdr (assoc 13 dxf_ent)) p2 (cdr (assoc 14 dxf_ent))) (setq p_nw1 (polar p1 (angle p1 p2) (/ value 2.0)) p_nw2 (polar p2 (angle p2 p1) (/ value 2.0))) (setq dxf_ent (subst (cons 13 p_nw1) (assoc 13 dxf_ent) dxf_ent)) (setq dxf_ent (subst (cons 14 p_nw2) (assoc 14 dxf_ent) dxf_ent)) (entmod dxf_ent) ) (T (princ "\nN'est pas une côte alignée, pivotée, horizontale ou verticale.") ) ) (prin1) ) Tu vois Bmolama, pas besoin de se MANIFESTER pour avoir une solution, il doit en exister un tas d'autre. Chacun aborde le problème à sa façon
  9. bonuscad

    CVPORT instable

    A tout hasard, n'aurais tu pas 2 fenêtres superposées dont l'une aurait son cadre inactif ou serait sur un calque gelé/eteint. Ceci pourrait expliquer cela.
  10. bonuscad

    impression au format pdf

    J'utilise depuis un certain déjà, la solution de PDF Gratuit Ma fois même si l'installation peut paraitre un peut compliqué, bien que très bien expliqué, j'obtiens un très bon résultat. Tout cela avec une interface en Français et sans bandeau publicitaire Je viens de voir d'ailleur en retournant sur le site une posibilité de transcrire du PDF en DXF. Va falloir que je jette un oeil de plus près. Si quelqu'un a essayé ???
  11. bonuscad

    CVPORT instable

    Bonjour Tramber, Voilà un exemple de la façon dont je gère le CVPORT dans un lisp, si ça peut t'éclairer Ceci pour éviter d'avoir un message du style: erreur: paramètre de la variable AutoCAD rejeté: "CVPORT" 3 (defun c:test_cvport ( / f_m) (if (eq (getvar "TILEMODE") 1) (setvar "TILEMODE" 0)) (if (not (eq (getvar "CVPORT") 1)) (command "_.pspace")) (princ "\nChoisissez une fenêtre: ") (while (null (setq f_m (ssget "_:S:E" '((0 . "VIEWPORT"))))) (princ "\nN'est pas une fenêtre") ) (setq f_m (ssname f_m 0)) (command "_.mspace") (setvar "CVPORT" (cdr (assoc 69 (entget f_m)))) ) Le code DXF 69 d'une "VIEWPORT" est l'ID de la fenêtre qui varie à chaque ouverture du dessin, sauf celle de l'espace papier qui est toujours 1
  12. Salut, Je remet le couvert sur ce FIL Après les observations qui m'ont été faites je commente le code ! Ca permettra peut être de comprendre l'autre fil. Donc voici le code reprenant une partie de l'autre code proposé sur l'autre sujet ;sous-fonction à 3 arguments ;ls => liste de points '((x y) (x y)...) ou '((x y z) (x y z) ....) ;lb => liste de réels (réel1 réel2 ...) ;flag_closed => entier bit de fermeture 0 ouvert, 1 fermé ; (defun def_bub_pl (ls lb flag_closed / ls lb rad a l_new) (textscr) ; ;si polyligne fermée on rajoute à la liste le dernier sommet (if (not (zerop flag_closed)) (setq ls (append ls (list (car ls))))) ; ;tant qu'il existe un second élément dans liste on boucle (while (cadr ls) ; ;si arrondi 0.0 donc segment droit, autrement c'est un arc (if (zerop (car lb)) (progn (princ "\nSommet :") (princ (car ls)) ) (progn ; ;calcul trigo du rayon et de l'angle au centre (setq rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0) a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb)))))) ) ;si angle négatif on prend le complémentaire à 2PI (if (< a 0.0) (setq a (- (* 2.0 pi) a))) (princ (strcat "\n Rayon : " (rtos rad))) (princ "\tPoint centre : ") ; ;si arrondi négatif => horaire, autrement => trigo (if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0)) (princ (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad)) (princ (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad)) ) ) ) ; ;décrémente la liste des sommets et des arrondis (setq ls (cdr ls) lb (cdr lb)) ) ) ; ;Fonction principale info_arc_poly ;retourne la valeur du rayon et du centre de l'arc de la polyligne selectionnée, si celle-ci en posède ; (defun c:INFO_ARC_POLY ( / ent dxf_ent typ_ent closed l_bub e_next) ; ;boucle tant que rien n'est sélectionné ou n'est pas une polyligne (while (not (or (eq typ_ent "LWPOLYLINE") (eq typ_ent "POLYLINE"))) (while (null (setq ent (entsel "\nChoisir une polyligne: ")))) (setq typ_ent (cdr (assoc 0 (setq dxf_ent (entget (car ent)))))) (if (not (or (eq typ_ent "LWPOLYLINE") (eq typ_ent "POLYLINE"))) (princ "\nCe n'est pas une polyligne!") ) ) ; ;traite les 2 types de polyligne ;closed => est à 1 si polyligne fermée ;lst => liste des sommets :l_bub => liste des valeurs des arrondis (cond ((eq typ_ent "LWPOLYLINE") (setq closed (boole 1 (cdr (assoc 70 dxf_ent)) 1) lst (mapcar '(lambda (x) (trans x (car ent) 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))) l_bub (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent)) ) ) ((eq typ_ent "POLYLINE") (setq closed (boole 1 (cdr (assoc 70 dxf_ent)) 1) e_next (entnext (car ent)) ) (while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next))))) ; ;pour accepter seulement les définition de point de polyligne 3D ;refuse les sommets inseré par le lissage ou spline et les maillages (if (zerop (boole 1 223 (cdr (assoc 70 dxf_next)))) (setq lst (cons (trans (cdr (assoc 10 dxf_next)) (car ent) 1) lst) l_bub (cons (cdr (assoc 42 dxf_next)) l_bub) ) ) (setq e_next (entnext e_next)) ) (setq lst (reverse lst) l_bub (reverse l_bub) ) ) ) ; ;appel de la sous fonction def_bub avec arguments requis (def_bub_pl lst l_bub closed) (prin1) )
  13. Bonjour, Ma demande n'était pas de debuger le code ;) Suite aux conversations de ICI ainsi que celle CI J'aurais souhaité que les personnes interréssés l'essayent et fassent part de leurs observations. Je n'ais pas commenté le code, c'est vrai, mais si ça interresse quelqu'un, je suis prêt à le faire! Ce qui interessant à retenir, c'est que la variable "LST" contient les sommets des segments droit et pour les parties courbe un point est généré tous les 10 degré. Cette liste peut donc servir à autre chose que de déterminer les point de trajet d'une sélection.. Pour les bugs si j'ai besoin d'aide, alors votre aide sera la bienvenue. Mais pour l'instant je suis plutot soucieux du sens de ma démarche , si cette solution en lisp pourrait convenir, ou si je fais fausse route?
  14. Bonjours à tous, En m'inspirant d'une demande fréquente pour faire une sélection à partir d'objets existants, le plus souvent à partir d'une polyligne avec ou sans segments courbes. J'ai essayer de construire un lisp répondant à ce besoin. J'ai trouvé un bout de code intéressant de Bill Zondlo que j'ai adapté à mes besoin (Show_drag_circle) pour pouvoir traiter les arcs, voir à: http://discussion.autodesk.com/thread.jspa?messageID=4073523 Le résultat, bien qu'en phase de test, à l'air convenable, mais bien sûr doit comporter encore des imperfections ou des bugs. Je vous le propose, dès fois que certain d'entre vous ait envie de l'améliorer,de le remodeler ou de le tripatouiller. Tout "feed-back" est le bienvenu. Actuellement la routine accepte: ligne, arc, cercle, polylignes/lwpolyligne. (defun def_bulg_pl (ls lb flag_closed / ls lb rad a l_new) (if (not (zerop flag_closed)) (setq ls (append ls (list (car ls))))) (while (cadr ls) (if (zerop (car lb)) (setq l_new (append l_new (list (car ls)))) (progn (setq rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0) a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb)))))) ) (if (< a 0.0) (setq a (- (* 2.0 pi) a))) (if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0)) (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb))))))) (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb))))))) ) ) ) (setq ls (cdr ls) lb (cdr lb)) ) (append l_new (list (car ls))) ) (defun bulge_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst) (setq inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin)) ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end))) nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0))) ) (repeat nm (setq p1 (polar pt_cen inc rad) inc (+ inc (/ (* pi 2.0) 36.0)) lst (append lst (list p1)) ) ) (setq p2 (polar pt_cen ang rad) lst (append lst (list p2)) ) (if (< sens 0.0) (reverse lst) lst) ) (defun c:sel_by_object ( / ent dxf_ent typent closed lst l_bulg e_next key osmd opkb oapt vmin vmax minpt maxpt zt lst2 l_ent ss1 ss2 js_all tmp) (while (null (setq ent (entsel "\nChoix de l'entité: ")))) (setq typent (cdr (assoc 0 (setq dxf_ent (entget (car ent)))))) (cond ((eq typent "LWPOLYLINE") (setq closed (boole 1 (cdr (assoc 70 dxf_ent)) 1) lst (mapcar '(lambda (x) (trans x (car ent) 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))) l_bulg (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent)) lst (def_bulg_pl lst l_bulg closed) ) ) ((eq typent "POLYLINE") (setq closed (boole 1 (cdr (assoc 70 dxf_ent)) 1) e_next (entnext (car ent)) ) (while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next))))) (if (zerop (boole 1 223 (cdr (assoc 70 dxf_next)))) (setq lst (cons (trans (cdr (assoc 10 dxf_next)) (car ent) 1) lst) l_bulg (cons (cdr (assoc 42 dxf_next)) l_bulg) ) ) (setq e_next (entnext e_next)) ) (setq lst (reverse lst) l_bulg (reverse l_bulg) lst (def_bulg_pl lst l_bulg closed) ) ) ((eq typent "LINE") (setq lst (list (trans (cdr (assoc 10 dxf_ent)) 0 1) (trans (cdr (assoc 11 dxf_ent)) 0 1)) closed 0 ) ) ((eq typent "CIRCLE") (setq lst (bulge_pts (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) 0.0 (cdr (assoc 40 dxf_ent))) (polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (- (* 2.0 pi) (/ (* pi 2.0) 36.0)) (cdr (assoc 40 dxf_ent))) (cdr (assoc 40 dxf_ent)) 1 ) lst (append lst (list (car lst))) closed 1 ) ) ((eq typent "ARC") (setq lst (bulge_pts (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (cdr (assoc 50 dxf_ent)) (cdr (assoc 40 dxf_ent))) (polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (cdr (assoc 51 dxf_ent)) (cdr (assoc 40 dxf_ent))) (cdr (assoc 40 dxf_ent)) 1 ) closed 0 ) ) (T (princ "\nN'est pas une Ligne, Arc, Cercle ou Polyligne!")) ) (cond (lst (if (equal (last lst) (car lst)) (setq lst (cdr lst) closed 1)) (setq osmd (getvar "osmode") oapt (getvar "aperture") opkb (getvar "pickbox")) (setvar "osmode" 0) (setq vmin (mapcar '- (getvar "viewctr") (list (/ (* (car (getvar "screensize")) (* 0.5 (getvar "viewsize"))) (cadr (getvar "screensize"))) (* 0.5 (getvar "viewsize")) 0.0)) vmax (mapcar '+ (getvar "viewctr") (list (/ (* (car (getvar "screensize")) (* 0.5 (getvar "viewsize"))) (cadr (getvar "screensize"))) (* 0.5 (getvar "viewsize")) 0.0)) minpt (list (eval (cons min (mapcar 'car lst))) (eval (cons min (mapcar 'cadr lst)))) maxpt (list (eval (cons max (mapcar 'car lst))) (eval (cons max (mapcar 'cadr lst)))) ) (setq zt (or (< (car minpt) (car vmin)) (< (cadr minpt) (cadr vmin)) (> (car maxpt) (car vmax)) (> (cadr maxpt) (cadr vmax)))) (if zt (command "_.zoom" "_window" minpt maxpt)) (setvar "aperture" 1) (setvar "pickbox" 1) (if (zerop (getvar "pickfirst")) (setvar "pickfirst" 1)) (while (car lst) (setq lst2 (cons (car lst) lst2) lst (vl-remove (car lst) lst) ) ) (setq lst (reverse lst2)) (if (zerop closed) (setq ss1 (ssdel (car ent) (ssget "_F" lst))) (progn (initget "SPolygone CPolygone _WPolygon CPolygon") (setq key (getkword "\nSélection par [sPolygone/CPolygone] < CP >: ")) (if (eq key "WPolygon") (setq ss1 (ssget "_WP" lst)) (setq ss1 (ssdel (car ent) (ssget "_CP" lst))) ) ) ) (setvar "pickbox" opkb) (setvar "aperture" oapt) (setq l_ent (if ss1 (ssnamex ss1)) js_all (ssget "_X") ) (foreach n l_ent (if (eq (type (cadr n)) 'ENAME) (setq ss2 (ssdel (cadr n) js_all)))) (if (and ss1 ss2 (= 0 (getvar "CMDACTIVE"))) (progn (princ "\n< Click+gauche > pour inverser la sélection; < Entrée >/[Espace]/Click+droit pour finir!.") (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25)) (sssetfirst nil ss1) (cond ((eq (car key) 3) (setq tmp ss1 ss1 ss2 ss2 tmp) ) ) ) ) ) (setvar "osmode" osmd) ) ) (prin1) ) [Edité le 21/3/2006 par bonuscad]
  15. Je me régale avec la fonction (grread) qui permet vraiment de faire des trucs sympa en dynamique. Ici c'est pour dessiner une ove, qui pourra être une ove allongée. L'utilité? ben je ne sais pas, peut être pour la mécanique pour dessiner des cames. En tout cas ça montre les possibilités et peut vous donnez des idées. (defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o) (setq n (/ (cadr (getvar "screensize")) 5.0)) (setq pt (osnap pt-i str-md)) (while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o)) (repeat 2 (setq rap (/ (getvar "viewsize") n) pt1 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt)) pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt)) pt3 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt)) pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt)) pt5 (list (car pt) (- (cadr pt) rap) (caddr pt)) pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt)) pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt)) pt8 (list (- (car pt) rap) (cadr pt) (caddr pt)) pt56 (polar pt (- (/ pi 4.0)) rap) pt67 (polar pt (/ pi 4.0) rap) pt78 (polar pt (- pi (/ pi 4.0)) rap) pt85 (polar pt (+ pi (/ pi 4.0)) rap) n (- n 16) ) (if (equal (osnap pt-i md) pt) (setq one_o T)) (cond ((and (eq "_end" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1) ) ((and (eq "_mid" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1) ) ((and (eq "_cen" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt5 pt7 7) (grdraw pt6 pt8 7) ) ((and (eq "_nod" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt1 pt3 1) (grdraw pt2 pt4 1) ) ((and (eq "_qua" md) one_o) (grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1) ) ((and (eq "_int" md) one_o) (grdraw pt1 pt3 1) (grdraw pt2 pt4 1) ) ((and (eq "_ins" md) one_o) (grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1) ) ((and (eq "_per" md) one_o) (grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1) ) ((and (eq "_tan" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt3 pt4 1) ) ((and (eq "_nea" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1) ) ) ) (setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0)) ) ) (defun fig_pts (pt_cen pt_begin pt_end rad / inc ang nm p1 p2 p3) (setq inc (angle pt_cen pt_begin) ang (+ (* 2.0 pi) (angle pt_cen pt_end)) nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0))) ) (repeat nm (setq p1 (polar pt_cen inc rad) inc (+ inc (/ (* pi 2.0) 36.0)) p2 (polar pt_cen inc rad) lst (append lst (list p1 p2)) ) ) (if lst (setq p3 (polar pt_cen ang rad) lst (append lst (list p2 p3)) ) ) ) (defun c:ove ( / o loop value mod ptx l l2 lw el th key pt_drag rad rad2 pt1 pt2 pt3 pt4 cc1 lst a_dir) (setq o (getvar "osmode") loop T value "") (if (or (zerop o) (eq (boole 1 o 16384) 16384)) (setq mod "_none") (progn (setq mod "") (mapcar '(lambda (xi xs) (if (not (zerop (boole 1 o xi))) (if (zerop (strlen mod)) (setq mod (strcat mod xs)) (setq mod (strcat mod "," xs)) ) ) ) '(1 2 4 8 16 32 64 128 256 512) '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea") ) ) ) (initget 1 "Cotes Largeur ELevation EPaisseur _Dimensions Width Elevation Thickness") (while (not (listp (setq ptx (getpoint "\nSpécifiez le point centre de l'ove ou [Cotes/Largeur/ELévation/EPaisseur]: ")))) (cond ((eq ptx "Dimensions") (setq l (getdist (strcat "\nSpécifiez le rayon principal de l'ove <" (rtos (getvar "USERR3")) ">:"))) (if l (setvar "USERR3" l) (setq l (getvar "USERR3"))) (setq l2 (getdist (strcat "\nSpécifiez le rayon secondaire de l'ove <" (rtos (* 2.0 (getvar "USERR3"))) ">:"))) (if l2 (while (or (>= l2 (+ (* 2.0 (getvar "USERR3")) (* (getvar "USERR3") (sqrt 2.0)))) (< l2 (* 2.0 (getvar "USERR3")))) (princ (strcat "\nLe rayon doit être > ou = à " (rtos (* 2.0 (getvar "USERR3"))) " et < à " (rtos (+ (* 2.0 (getvar "USERR3")) (* (getvar "USERR3") (sqrt 2.0)))))) (setq l2 (getdist (strcat "\nSpécifiez le rayon secondaire de l'ove <" (rtos (* 2.0 (getvar "USERR3"))) ">:"))) (if (not l2) (setq l2 (* 2.0 (getvar "USERR3")))) ) (setq l2 (* 2.0 (getvar "USERR3"))) ) ) ((eq ptx "Width") (initget 4) (setq lw (getdist (strcat "\nSpécifiez la largeur de la polyligne <" (rtos (getvar "PLINEWID")) ">: "))) (if lw (setvar "PLINEWID" lw)) ) ((eq ptx "Elevation") (setq el (getdist (strcat "\nSpécifiez l'élévation de l'ovale <" (rtos (getvar "ELEVATION")) ">: "))) (if el (setvar "ELEVATION" el)) ) ((eq ptx "Thickness") (setq th (getdist (strcat "\nSpécifiez l'épaisseur de l'ovale <" (rtos (getvar "THICKNESS")) ">: "))) (if th (setvar "THICKNESS" th)) ) ) (initget 1 "Cotes Largeur ELevation EPaisseur _Dimensions Width Elevation Thickness") ) (if (not l) (progn (princ (strcat "\nSpécifiez le rayon principal de l'ove : <" (rtos (getvar "USERR3")) ">: ")) (while (and (setq key (grread T 4 0)) (/= (car key) 3) loop) (cond ((eq (car key) 5) (redraw) (if (and (/= mod "_none") (osnap (cadr key) mod)) (progn (gr-osmode (cadr key) mod) (setq pt_drag (osnap (cadr key) mod) pt_drag (list (car pt_drag) (cadr pt_drag) (caddr ptx)) ) ) (setq pt_drag (list (caadr key) (cadadr key) (caddr ptx))) ) (setq rad (distance (list (car ptx) (cadr ptx)) (list (car pt_drag) (cadr pt_drag))) pt1 (polar ptx (- (angle ptx pt_drag) (/ pi 2.0)) rad) pt2 (polar ptx (+ (angle ptx pt_drag) (/ pi 2.0)) rad) pt3 (polar pt1 (+ (angle pt1 pt_drag) (/ pi 2.0)) (* 2.0 rad)) pt4 (polar pt2 (- (angle pt2 pt_drag) (/ pi 2.0)) (* 2.0 rad)) cc1 (polar pt1 (+ (angle pt1 pt2) (/ pi 4.0)) (* (sqrt 2.0) rad)) ) (fig_pts ptx pt1 pt2 rad) (fig_pts pt1 pt2 pt3 (* rad 2.0)) (fig_pts cc1 pt3 pt4 (- (* 2.0 rad) (* (sqrt 2.0) rad))) (fig_pts pt2 pt4 pt1 (* rad 2.0)) (if lst (progn (grvecs lst) (grdraw ptx pt_drag 7))) (setq lst nil) ) ((or (member key '((2 13) (2 32))) (eq (car key) 25)) (if (and (not (zerop (strlen value))) (or (eq (type (read value)) 'INT) (eq (type (read value)) 'REAL))) (setvar "USERR3" (read value)) ) (setq pt_drag (polar ptx (angle ptx pt_drag) (getvar "USERR3")) rad (getvar "USERR3") pt1 (polar ptx (- (angle ptx pt_drag) (/ pi 2.0)) rad) pt2 (polar ptx (+ (angle ptx pt_drag) (/ pi 2.0)) rad) pt3 (polar pt1 (+ (angle pt1 pt_drag) (/ pi 2.0)) (* 2.0 rad)) pt4 (polar pt2 (- (angle pt2 pt_drag) (/ pi 2.0)) (* 2.0 rad)) cc1 (polar pt1 (+ (angle pt1 pt2) (/ pi 4.0)) (* (sqrt 2.0) rad)) loop nil ) (princ "\n") ) (T (if (eq (cadr key) 8) (progn (setq value (substr value 1 (1- (strlen value)))) (princ (chr 8)) (princ (chr 32)) ) (setq value (strcat value (chr (cadr key)))) ) (princ (chr (cadr key))) ) ) ) (setvar "USERR3" (distance (list (car ptx) (cadr ptx)) (list (car pt1) (cadr pt1)))) (setq a_dir (angle cc1 ptx) loop T) (princ (strcat "\nSpécifiez le rayon secondaire de l'ove : <" (rtos (* 2.0 (getvar "USERR3"))) ">: ")) (while (and (setq key (grread T 4 0)) (/= (car key) 3) loop) (cond ((eq (car key) 5) (redraw) (if (and (/= mod "_none") (osnap (cadr key) mod)) (progn (gr-osmode (cadr key) mod) (setq pt_drag (osnap (cadr key) mod) pt_drag (list (car pt_drag) (cadr pt_drag) (caddr ptx)) ) ) (setq pt_drag (list (caadr key) (cadadr key) (caddr ptx))) ) (setq rad2 (distance (list (car ptx) (cadr ptx)) (list (car pt_drag) (cadr pt_drag)))) (cond ((>= rad2 (+ (* 2.0 rad) (* rad (sqrt 2.0)))) (setq rad2 (- (+ (* 2.0 rad) (* rad (sqrt 2.0))) 1E-08)) ) ((< rad2 (* 2.0 rad)) (setq rad2 (* 2.0 rad)) ) ) (setq pt3 (polar (polar pt2 (angle pt2 pt1) rad2) (+ (angle pt1 pt2) (/ pi 4.0)) rad2) pt4 (polar (polar pt1 (angle pt1 pt2) rad2) (- (angle pt2 pt1) (/ pi 4.0)) rad2) cc1 (polar ptx (+ (angle pt1 pt2) (/ pi 2.0)) (- rad2 rad)) ) (fig_pts ptx pt1 pt2 rad) (fig_pts (polar pt2 (angle pt2 pt1) rad2) pt2 pt3 rad2) (fig_pts cc1 pt3 pt4 (distance cc1 pt3)) (fig_pts (polar pt1 (angle pt1 pt2) rad2) pt4 pt1 rad2) (if lst (progn (grvecs lst) (grdraw ptx pt_drag 7))) (setq lst nil) ) ((or (member key '((2 13) (2 32))) (eq (car key) 25)) (if (and (not (zerop (strlen value))) (or (eq (type (read value)) 'INT) (eq (type (read value)) 'REAL))) (setq rad2 (read value)) (setq rad2 (* 2.0 rad)) ) (cond ((and (< rad2 (+ (* 2.0 rad) (* rad (sqrt 2.0)))) (>= rad2 (* 2.0 rad))) (setq pt3 (polar (polar pt2 (angle pt2 pt1) rad2) (+ (angle pt1 pt2) (/ pi 4.0)) rad2) pt4 (polar (polar pt1 (angle pt1 pt2) rad2) (- (angle pt2 pt1) (/ pi 4.0)) rad2) cc1 (polar ptx (+ (angle pt1 pt2) (/ pi 2.0)) (- rad2 rad)) loop nil ) (princ "\n") ) (T (princ (strcat "\nLe rayon doit être > ou = à " (rtos (* 2.0 (getvar "USERR3"))) " et < à " (rtos (+ (* 2.0 (getvar "USERR3")) (* (getvar "USERR3") (sqrt 2.0)))))) (princ (strcat "\nSpécifiez le rayon secondaire de l'ove : <" (rtos (* 2.0 (getvar "USERR3"))) ">: ")) (setq value "") ) ) ) (T (if (eq (cadr key) 8) (progn (setq value (substr value 1 (1- (strlen value)))) (princ (chr 8)) (princ (chr 32)) ) (setq value (strcat value (chr (cadr key)))) ) (princ (chr (cadr key))) ) ) ) (redraw) ) (setq pt1 (polar ptx 0.0 l) pt2 (polar ptx pi l) pt3 (polar (polar pt2 0.0 l2) (/ (* 5.0 pi) 4.0) l2) pt4 (polar (polar pt1 pi l2) (- (/ pi 4.0)) l2) ) ) (if (not (zerop (getvar "ELEVATION"))) (setq e (getvar "ELEVATION"))) (setq th (getvar "THICKNESS") w (getvar "PLINEWID")) (cond ((and ptx pt1 pt2 pt3 pt4) (setvar "USERR3" (distance (list (car ptx) (cadr ptx)) (list (car pt1) (cadr pt1)))) (setvar "osmode" 0) (setvar "cmdecho" 0) (command "_.pline" pt1 "_arc" "_ce" ptx pt2 pt3 pt4 "_close") (if e (command "_.change" (entlast) "" "_properties" "_elevation" e "")) (if th (command "_.change" (entlast) "" "_properties" "_thickness" th "")) (setvar "osmode" o) (setvar "cmdecho" 1) (if (not a_dir) (command "_.rotate" (entlast) "" "_none" ptx)) ) ) (prin1) )
  16. Dire que jusqu'à maintenant je procédais de la même manière que toi, c'est à dire que je reécrivais entièrement la commande que je voulais simulée. Ta question et surtout ton premier exemple avec ton interrogation sur la manière d'interrompre la boucle m'a fais penser à cette formulation: (defun c:my_pline (/) (command "_.pline" (while (not (zerop (getvar "cmdactive"))) (command pause) ) ) (command "_.change" (entlast) "" "_properties" "_color" 3 "") (princ) ) Et cela à l'aire de fonctionner à merveille, même avec des zooms en transparence, à tester encore cependant. Alors MERCI pour ta question, car la solution est vraiment simple. (il faudra que je revoie certaine de mes routines) ;)
  17. bonuscad

    rendu et lisp

    Salut mlon ;) Ravi que tu puisse partir en vacance en toute quiètude, profites en bien. Les images seront elles bien toutes générées, je te le souhaite, car le processeur va calculer dur et lui ne sera pas en vacance. :casstet: pour répondre à thierryd. Les images générées sont en TIFF , tu peux modifier ce format dans le lisp pour choisir un TGA, PCX,BMP,PS ou TIFF Par contre j'ai remarqué que l'enregistrement de ces images se faisait dans le dernier dossier ayant servir pour un enregistrement, donc pas forcément dans le dossier du dessin ouvert. Cela aussi doit pouvoir se modifier dans le lisp. Si tu te sens pas le courage fais une rechercher de fichiers :exclam: Pour le fmontage AVI mlon pourra peut être t'en dire plus.
  18. Pour ton information, Sous win98SE et Win XP avec Office 2000 (Version 9.0 Build 4430) Ta routine retourne bien la bonne info d'Excel dans les 2 cas (avec 1 "\" ou les 2 "\\")
  19. Bon je ne vais pas marcher sur les plates-bande de Tramber. Mais au premier coup d'oeil je vois que ca routine fait appel a des (command) d'édition et de création. Or si on ne prend pas soin d'inactiver les accroche objets avant, il arrive souvent que la routine avorte. Essaye d'abord d'inactiver les ACCROBJ avant de lancer la routine, pour voir si ca ce déroule mieux. Je sens qu'une correction est proche ;)
  20. Une cause possible! Si tes attributs sont renseigner à tavers une routine lisp, il y a de forte chance pour que l'entrée utilisateur se fasse à travers (getstring). Or cette fonction posséde une option sous la forme: (getstring T "\nEntrez votre attribut: ") Si cette option n'a pas été prévue, aucun espace ne pourra être entré, il sera interprété comme un RETURN, ce qui expliquerai ton souci. Si c'est le cas, rectifier le Lisp.
  21. bonuscad

    Objets sans réponses

    Regarde ce fil, peut être la solution? mais pas miraculeuse ICI
  22. Si c'est une image qui a été amenée par un copier-coller (lien OLE) et non par insertion d'image, un click-droit SUR l'image te donnera un menu contextuel avec une option à cocher pour mettre l'objet sélectionable ou non.
  23. Un exemple vaut peut être mieux qu'un long discour. Voici une macro pour un bouton personnalisé. Celui ci est basé sur le modèle Utilisateur pour hachurer UN seul objet de l'espace objet. (On peut le faire avec d'autres modèles, mais il faut savoir que l'espacement sera tributaire de l'espacement défini dans le modèle FICHIER.PAT) Il vous faudra fourni l'angle (au clavier) et l'échelle de votre fenêtre dans l'espace papier ex: si vous êtes en centimètres 100/200xp pour avoir un espace de 1 unité entre les hachures dans l'espace papier dans une fenêtre au 200 et en mètre cela aurait été 1000/500xp avoir 1 unité d"espace dans l'EP dans une fenêtre au 500 ^C^C^P$M=$(if,$(!=,$(getvar,cvport),2),_.mspace;)_.-bhatch;_properties;_u;\\_no;_select;\;;^Z
  24. Patrick m'a devancé, j'allais dire de voir: http://www.cadxp.com/sujetXForum-106.htm et de faire ces 3 lignes: (setq nam_blk (getstring T "\nNom du bloc a insérer: ")) (setq l_som (GETVERTICES (car (entsel "\nChoisir la polyligne: ")))) (foreach n l_som (command "_.-insert" nam_blk n "" "" ""))
  25. Cela irait-il ? (defun c:calque_existe ( / name_lay first_lay lst_lay next_lay) (setq name_lay (strcase (getstring T "\nEntrez le nom de calque recherché (joker * accepté): "))) (setq first_lay (tblnext "LAYER" T) lst_lay (list (cdr (assoc 2 first_lay))) ) (while (setq next_lay (tblnext "LAYER" nil)) (setq lst_lay (cons (cdr (assoc 2 next_lay)) lst_lay)) ) (textscr) (foreach n lst_lay (if (wcmatch (strcase n) name_lay) (princ (strcat "\nCalque " n " correspond au critère de recherche (" name_lay ")")))) (prin1) )
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité