Aller au contenu

(gile)

Moderateurs
  • Compteur de contenus

    12 247
  • Inscription

  • Dernière visite

  • Jours gagnés

    208

Tout ce qui a été posté par (gile)

  1. Salut, Peut-être un bloc dynamique (2006 ?) avec son point d'insertion à son centre de gravité (c'est aussi une notion de géométrie, pas que de RDM), un paramètre XY sur sa longueur et sa largeur et 4 actions d'étirement : 2 types de distance X et 2 types de distance Y dont 1 Variateur de distance à 1 l'autre à -1 dans chaque cas. L'étirement du rectangle en X ou enY se fait symétriquement, les dimmensions peuvent être rentrée dans la fenêtre Propriétés
  2. Merci Zebulon_ J'ai ressorti cette routine que j'avais faite avant de connaître la moindre fonction en VisualLISP. De plus, les StartParam et EndParam restent assez obscurs pour moi, ils ne correspondent pas à la même chose suivant les entités, mais je vais essayer de creuser un peu la chose. D'autre part, si le VisualLISP est plus pratique et parfois incontournable pour récupérer et modifier les propriétés des objets, je suis plus à l'aise avec AutoLISP qui a aussi l'avantage d'être presque entièrement compatible avec les logiciel IntelliDesk/IntelliCad.
  3. Salut, Vite fait en compilant quelques routines de ma boite à outils : ;;; Retourne la valeur du code dxf (defun val_dxf (code ent) (cdr (assoc code (entget ent))) ) ;;; LONGOBJT Retourne la longueur ou le périmètre d'un objet (ename) (defun LONGOBJT (objt) (cond ((= (val_dxf 0 objt) "LINE") (distance (val_dxf 10 objt) (val_dxf 11 objt)) ) ((= (val_dxf 0 objt) "ARC") (* (ANGARC objt) (val_dxf 40 objt)) ) ((member (val_dxf 0 objt) '("CIRCLE" "ELLIPSE" "LWPOLYLINE" "SPLINE") ) (command "_area" "_object" objt) (getvar "perimeter") ) ((= (type (car objt)) 'ENAME) (princ "\nLa longueur de cet objet n'est pas définie.") ) ) ) ;;; C:LONG_LINE Calcule la longueur des lignes et lwpolylignes du calque spécifié (defun c:long_line (/ clq js cnt tot) (if (setq clq (entsel "\nSélectionnez un objet sur le calque ou : ") ) (setq clq (val_dxf 8 (car clq))) (setq clq (getstring "\nNom du calque: ")) ) (if (tblsearch "LAYER" clq) (progn (setq js (ssget "_X" (list (cons 0 "LINE,LWPOLYLINE") (cons 8 clq))) cnt 0 tot 0.0 ) (repeat (sslength js) (setq tot (+ tot (LONGOBJT (ssname js cnt))) cnt (1+ cnt) ) ) (princ (strcat (itoa cnt) " entités mesurées \nLongueur totale :" (rtos tot) ) ) ) (princ "\nNom de calque invalide.") ) (princ) ) Il faut charger les 3 routines et taper long_line pour lancer la commande. PS : tel quel, les longueurs des arcs des polylignes seront mesurées aussi. On pourrait ajouter les cercles, les arcs, les ellipses et les splines simplement en modifiant le filtre de sélection.[Edité le 20/12/2005 par (gile)] PS2 : Si on ajoute les arcs au filtre de séléction il faudra aussi charger cette routine : ;;; ANGARC Retourne l'angle décrit par un arc de cercle. (defun ANGARC (arc / ang) (setq ang (- (val_dxf 51 arc) (val_dxf 50 arc))) (if (minusp ang) (setq ang (+ (* 2 pi) ang)) ) ang ) [Edité le 20/12/2005 par (gile)]
  4. (gile)

    texte multiple

    Super ! Çà mérite une petite macro : ^C^C_mtext;\l;0;
  5. (gile)

    Réseau hélicoïdal

    Salut Zebulon_ D'abord, merci pour le compliment. Je ne suis pas expert en maths, mais je pense que le principe est celui d'une helice, en tout cas les sommets de chaque segments de la poly sont situés sur une hélice (comme dans 3dSpiral), les segments qui les réunissent étant des segments de droite. De mon côté, dans Hélicoïde, j'ai rejoins le même type de points par des arcs elliptiques. La courbe est plus lisse, mais on ne peut extruder que segment par segment. PS : Juste une petite remarque sur ton LISP, si je peux me permettre, j'aurais mis le (setvar "osmode" 0) après les (getxxx).
  6. Si tu envisages de refaire ta main courante en solide : si un profil ciculaire te convient : Ressort3D si le profil n'est pas circulaire, tu peux dessiner les arrêtes avec 3dSpiral, constuire la partie supérieure du profil en surface réglée ou surface gauche, l'extruder vers le plan horizontal avec M2S (laisses au moins la hauteur du profil sous le point le plus bas), même opération avec la partie inférieure du profil et soustraction de la partie inférieure à la partie supérieure. 3dSpiral crée une polyligne 3d, donc des facettes, tu peux augmenter le nombre de segments ou "spliner" la polyligne. Personnellement, j'utilise plutôt Helicoide pour les arrêtes des profils débillardés (limons, mains courantes) en spécifiant un nombre de segments par spire égal au nombre de marche sur 360° et option [segments] : 1 segment à tracer, puis même méthode qu'avec 3dSpiral. Une fois créés les solides (1 marche + sa contre-marche, les tronçon de limon et de main courante correspondants) je fais un réseau hélicoïdal avec ces objets.
  7. Un petit LISP pour mettre une sélection d'objets en réseau hélicoïdal. Nouvelle version Ammélioration des entrées utilisateurs concernant les angles, accepte désormais : - soit l'angle décrit, soit l'angle entre les éléments - des angles supérieurs à un tour complet - des entrés directement sous forme de formules mathématiques (du types de celles utilisées avec la calculatrice géométrique d'AutoCAD). En attendant une petite boite de dialogue... ;;; C:RES_HEL Crée un réseau hélicoïdal ;;; Redéfinition de *error* (defun RES_HEL_ERR (msg) (if (or (= msg "Fonction annulée") (= msg "quitter / sortir abandon") ) (princ) (princ (strcat "\nErreur: " msg)) ) (command) (command "_undo" "_end") (setvar "cmdecho" v1) (setvar "osmode" v2) (setq *error* m:err m:err nil ) (princ) ) ;;;Fonction principale (defun C:RES_HEL (/ ss nb ang ht axe) (setq m:err *error* *error* RES_HEL_ERR v1 (getvar "cmdecho") v2 (getvar "osmode") ) (command "_undo" "_begin") (setvar "cmdecho" 0) (while (not (setq ss (ssget)))) (initget 7) (setq nb (getint "\nEntrez le nombre d'éléments du réseau: ")) (initget 1) (setq ht (getdist "\nSpécifiez le décalage en hauteur: ")) (initget 1) (setq axe (getpoint "\nSpécifiez le centre du réseau: ")) (initget "Décrit Elément") (if (= (getkword "\nPrécisez : angle décrit ou angle entre les éléments [Décrit/Elément] : " ) "Elément" ) (setq ang_t "angle entre les éléments") (setq ang_t "angle décrit") ) (initget 4) (if (not (setq ang (getreal (strcat "\nEntrez l'" ang_t " ou : ") ) ) ) (setq ang (atof (angtos (+ (getangle axe "\nSpécifiez le second point: ") (getvar "ANGBASE") ) ) ) ) ) (if (= ang_t "angle décrit") (setq ang (/ ang nb)) ) (initget "Horaire Trigonométrique") (if (= (getkword "\nSpécifiez le sens de rotation [Horaire/Trigonométrique] : " ) "Horaire" ) (setq ang (- ang)) ) (if (= (getvar "ANGDIR") 1) (setq ang (- ang)) ) (setvar "osmode" 0) (repeat (1- nb) (command "_copy" ss "" axe axe) (command "_rotate" ss "" axe ang) (command "_move" ss "" '(0 0) (list 0 0 ht)) ) (command "_undo" "_end") (setvar "cmdecho" v1) (setvar "osmode" v2) (setq *error* m:err m:err nil ) (princ) ) Code modifié pour pouvoir être utlisé par ceux qui,comme les géomètres, utilisent des unités angulaires autres que les degrés et/ou mettent ANGBASE à une valeur autre que 0.[Edité le 20/12/2005 par (gile)][Edité le 31/12/2005 par (gile)] [Edité le 1/1/2006 par (gile)]
  8. (gile)

    applicatif pour geometre ?

    C'est dans l'Aide aux développeurs -> Référence DXF et c'est en français !
  9. (gile)

    applicatif pour geometre ?

    Salut, Le nombre 10 correspond au code dxf 10 de la liste renvoyée par entget (10 est en général le code du point de départ des entités : point d'insertion d'un bloc, centre d'un cercle, premier point d'uneligne ...) La fonction (assoc ...) permet de récupérer un membre d'une "liste associative" (de dotted pairs (paires pointées) dans les listes renvoyées par (entget)). Le premier terme de chaque membre de cette liste agit comme un index pour la fonction (assoc). exemple : (setq lst '((0 . "circle") (10 20.0 30.0 0.0) (40 . 50.0))) ensuite : (assoc 0 lst) retourne (0 . "circle") (cdr (assoc 10 lst)) retourne (20.0 30.0 0.0)
  10. Salut, Une version de M2S avec les invites en français ici, mais comme le dit Tramber, çà ne fonctionne qu'avec les surface maillées ouvertes.
  11. (gile)

    boundingbox

    Merci aussi à toi, on apprend aussi en essayant de répondre aux question qu'on ne s'était pas posées. J'ai apporté une petite correction aux deux codes ci-dessus.
  12. Salut Oli553, Dans le menu Outils de FireFox -> Extensions et cliquer/glisser de cadxp_fr.xpi dans la fenêtre.
  13. Salut, J'ai, bien sûr, trouvé des solutions dans CADxp, à chaque fois que j'ai posé une question, mais aussi souvent en lisant les messages d'autres. Je serais curieux de savoir si quequ'un n'a jamais trouvé de solution sur CADxp !?
  14. (gile)

    boundingbox

    En utilisant le VisualLISP uniquement pour récupérer les points de la bounding box, je trouve çà beacoup plus lisible : Nouvelle version (correction d'un dysfonctionnement avec align le19/12/05 à 17h11) ;;; Retourne les coordonnées des points de la "Bounding Box" (liste) ou un message d'erreur (defun getbbox (ent / bb minpoint maxpoint) (vl-load-com) (setq bb (vl-catch-all-apply 'vla-getboundingbox (list (vlax-ename->vla-object ent) 'minpoint 'maxpoint ) ) ) (if (vl-catch-all-error-p bb) (strcat "; erreur: " (vl-catch-all-error-message bb)) (list (vlax-safearray->list minpoint) (vlax-safearray->list maxpoint) ) ) ) ;;; Redéfinition de *error* (defun bbox_err (msg) (if (/= msg "Fonction annulée") (princ msg) ) (command "_undo" "_end") (setvar "cmdecho" v1) (setvar "osmode" v2) (setq *error* m:err m:err nil ) ) ;;; Fonction principale (defun c:bbox (/ js lst pt1 pt2 l) (setq m:err *error* *error* bbox_err ) (setq v1 (getvar "cmdecho") v2 (getvar "osmode") ) (command "_undo" "_begin") (setvar "cmdecho" 0) (setvar "osmode" 0) (while (not (setq js (ssget "_:S")))) (if (not (member "geom3d.arx" (arx))) (arxload "geom3d") ) (align js '(0.0 0.0 0.0) (trans '(0.0 0.0 0.0) 0 1) '(1.0 0.0 0.0) (trans '(1.0 0.0 0.0) 0 1) '(0.0 1.0 0.0) (trans '(0.0 1.0 0.0) 0 1) ) (if (listp (setq lst (getbbox (ssname js 0)))) (progn (setq pt1 (trans (car lst) 0 1) pt2 (trans (cadr lst) 0 1) ) (command "_line" pt1 pt2 "") (ssadd (entlast) js) (align js (trans '(0.0 0.0 0.0) 0 1) '(0.0 0.0 0.0) (trans '(1.0 0.0 0.0) 0 1) '(1.0 0.0 0.0) (trans '(0.0 1.0 0.0) 0 1) '(0.0 1.0 0.0) ) (setq pt1 (trans (cdr (assoc 10 (entget (entlast)))) 0 1) pt2 (trans (cdr (assoc 11 (entget (entlast)))) 0 1) ) (entdel (entlast)) (if (equal (caddr pt1) (caddr pt2) 1e-007) (command "_rectangle" pt1 pt2) (command "_box" pt1 pt2) ) ) (progn (command "_undo" "1") (princ lst) ) ) (command "_undo" "_end") (setvar "cmdecho" v1) (setvar "osmode" v2) (setq *error* m:err m:err nil ) (princ) ) [Edité le 19/12/2005 par (gile)] [Edité le 19/12/2005 par (gile)]
  15. C'est carrément Noël, tous ces cadeaux !!!
  16. (gile)

    boundingbox

    Çà y est ! Cette nouvelle version semble marcher quelque soit le SCU et l'élévation de l'objet par rapport au plan du SCU. J'ai été obligé de faire un mix d'AutoLISP et de VisualLISP : je n'ai pas trouvé de fonction en Visual équivalente à (align). Si l'objet est un objet 2D parallèle au plan du SCU la bounding box, parallèle aux axes XY du SCU, est matérialisée par un rectangle (polyligne), sinon par une box (solide 3D). Nouvelle version (correction d'un dysfonctionnement avec align le19/12/05 à 17h13) (defun c:bbox (/ AcDoc ModSp js obj bb minpoint maxpoint pt1 pt2 pt3 pt4 line lst ucszdir pline cen ) (vl-load-com) (setq AcDoc (vla-get-activedocument (vlax-get-acad-object)) ModSp (vla-get-ModelSpace AcDoc) ) (vla-startUndoMark AcDoc) (while (not (setq js (ssget "_:S")))) (setq obj (vlax-ename->vla-object (ssname js 0))) (if (not (member "geom3d.arx" (arx))) (arxload "geom3d") ) (align js '(0.0 0.0 0.0) (trans '(0.0 0.0 0.0) 0 1) '(1.0 0.0 0.0) (trans '(1.0 0.0 0.0) 0 1) '(0.0 1.0 0.0) (trans '(0.0 1.0 0.0) 0 1) ) (setq bb (vl-catch-all-apply 'vla-getboundingbox (list obj 'minpoint 'maxpoint ) ) ) (if (vl-catch-all-error-p bb) (progn (princ (strcat "; erreur: " (vl-catch-all-error-message bb)) ) (align js (trans '(0.0 0.0 0.0) 0 1) '(0.0 0.0 0.0) (trans '(1.0 0.0 0.0) 0 1) '(1.0 0.0 0.0) (trans '(0.0 1.0 0.0) 0 1) '(0.0 1.0 0.0) ) ) (progn ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq pt1 (vlax-safearray->list minpoint) pt2 (vlax-safearray->list maxpoint) ) (if (equal (caddr pt1) (caddr pt2) 1e-007) (progn (setq line (vla-addLine ModSp minpoint maxpoint)) (ssadd (entlast) js) (align js (trans '(0.0 0.0 0.0) 0 1) '(0.0 0.0 0.0) (trans '(1.0 0.0 0.0) 0 1) '(1.0 0.0 0.0) (trans '(0.0 1.0 0.0) 0 1) '(0.0 1.0 0.0) ) (setq pt1 (trans (vlax-safearray->list (vlax-variant-value (vla-get-startPoint line)) ) 0 1 ) pt3 (trans (vlax-safearray->list (vlax-variant-value (vla-get-endPoint line)) ) 0 1 ) pt2 (list (car pt3) (cadr pt1)) pt4 (list (car pt1) (cadr pt3)) lst (list pt1 pt2 pt3 pt4) ) (setq ucszdir (trans '(0 0 1) 1 0 T) lst (apply 'append (mapcar '(lambda (x) (setq x (trans x 1 ucszdir)) (list (car x) (cadr x)) ) lst ) ) ) (setq pline (vla-addLightweightPolyline ModSp (vlax-make-variant (vlax-SafeArray-fill (vlax-make-SafeArray vlax-vbDouble (cons 0 (- (length lst) 1) ) ) lst ) ) ) ) (vla-put-Closed pline T) (vla-put-Elevation pline (- (caddr pt1) (caddr (trans '(0 0) 0 1))) ) (vla-delete line) ) (progn (setq cen (mapcar '(lambda (x) (/ x 2)) (mapcar '+ pt1 pt2)) pt2 (mapcar '- pt2 pt1) ) (vla-addBox ModSp (vlax-3d-point cen) (car pt2) (cadr pt2) (caddr pt2) ) (ssadd (entlast) js) (align js (trans '(0.0 0.0 0.0) 0 1) '(0.0 0.0 0.0) (trans '(1.0 0.0 0.0) 0 1) '(1.0 0.0 0.0) (trans '(0.0 1.0 0.0) 0 1) '(0.0 1.0 0.0) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ) ) (vla-endUndoMark AcDoc) (princ) ) PS1 : si tu préfères matérialiser la bounding box par une ligne, comme dans ton exemple, remplace la partie de code entre les ;;;;;;;;; par celle-ci : (vla-addLine ModSp minpoint maxpoint) (ssadd (entlast) js) (align js (trans '(0.0 0.0 0.0) 0 1) '(0.0 0.0 0.0) (trans '(1.0 0.0 0.0) 0 1) '(1.0 0.0 0.0) (trans '(0.0 1.0 0.0) 0 1) '(0.0 1.0 0.0) )[Edité le 18/12/2005 par (gile)][Edité le 19/12/2005 par (gile)] [Edité le 19/12/2005 par (gile)]
  17. (gile)

    boundingbox

    Je bute toujours pour les SCU non parallèles au SCG (rotation sur X ou Y), je pensais avoir trouvé en utilisant (vla-put-Normal), mais tous les objets ne réagissent pas pareil et les ellipses, par exemple, n'ont pas cette propriété. J'ai "mis au propre" la routine ci-dessus, ajout de marques "undo" et d'un test de parallélisme des plans XY du SCU et du SCG, j'ai aussi remplacé la ligne par un rectangle pour matérialiser le Bounding box. Le rectangle est donc dans l'axe XY du SCU et dans le plan de l'objet quelque soit son élévation par rapport au SCU. À plus ... [Edité le 17/12/2005 par (gile)]
  18. Très pratique, en effet ! merci
  19. (gile)

    boundingbox

    Salut, Ma méthode n'est pas très élégante. Elle consiste en une rotation de l'objet de l'angle du SCU à l'angle du SCG avant de faire le getboundingbox et une rotation inverse de de l'objet et de la ligne. Elle ne fonctionne qu'en 2D (SCU parllèle au SCG). Je te laisse le soin de la tester en profondeur et de l'améliorer. (defun c:al-getboundingbox (/ AcDoc ModSp ucszdir ang util obj ip cen minpoint maxpoint pt1 pt2 pt3 pt4 lst pline ) (vl-load-com) (setq AcDoc (vla-get-activedocument (vlax-get-acad-object)) ModSp (vla-get-ModelSpace AcDoc) ) (vla-startUndoMark AcDoc) (setq ucszdir (trans '(0 0 1) 1 0 T) ang (angle '(0 0) (trans (getvar "UCSXDIR") 0 ucszdir)) ) (if (equal ucszdir '(0.0 0.0 1.0) 1e-009) (progn (setq util (vla-get-utility (vla-get-activedocument (vlax-get-acad-object) ) ) ) (vla-getentity util 'obj 'ip "\nSelectionner Objet: ") (setq cen (vlax-3d-point '(0.0 0.0 0.0))) (vla-rotate obj cen (- ang)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pt1 (vlax-safearray->list minpoint) pt3 (vlax-safearray->list maxpoint) pt2 (list (car pt3) (cadr pt1)) pt4 (list (car pt1) (cadr pt3)) lst (list pt1 pt2 pt3 pt4) lst (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x)) ) lst ) ) ) (setq pline (vla-addLightweightPolyline ModSp (vlax-make-variant (vlax-SafeArray-fill (vlax-make-SafeArray vlax-vbDouble (cons 0 (- (length lst) 1) ) ) lst ) ) ) ) (vla-put-Closed pline T) (vla-put-elevation pline (caddr pt1)) (vla-rotate pline cen ang) (vla-rotate obj cen ang) ) (alert "Cette commande ne fonctionne que dans un SCU paralèle au SCG." ) ) (vla-endUndoMark AcDoc) (princ) ) PS : pour les traductions entre SCO, SCU et SCG voir ici [Edité le 17/12/2005 par (gile)]
  20. Super, cette amélioration sera très pratique !
  21. Il faut décocher la case "Invité" (eh oui !) et taper ton mot de passe. Après je crois que dans les option il y a un truc comme "mémoriser le mot de passe".
  22. Salut, Tu peux créer des alias pour les commandes dans le fichier acad.pgp. Pour l'ouvrir vas dans Outils -> Personnaliser -> Paramètres de prgramme (acad.pgp) Pour recharger ton fichier modifié il faut taper reinit à la ligne de commande, cocher fichier pgp et OK Trop lent, encore une fois ;) [Edité le 16/12/2005 par (gile)]
  23. (gile)

    applicatif pour geometre ?

    Si tu supprime : (if (and (eq (type cod) 'INT) ( (progn Il faut supprimer deux paranthèses fermantes entre la fin du dernier(command ...) et (setq n (+ 1 n)) Mais était-ce bien la question ? [Edité le 16/12/2005 par (gile)]
  24. Pour ceux qui, comme moi, aiment bien pouvoir sélectionner un (ou des) objet(s) avant ou après avoir lancé une commande de modification et pouvoir mettre cette commande dans un menu contextuel (sélection -> clic droit -> commande dans le menu). Voici deux petites sous-routines qui retiennent la sélection d'une entité (ou un jeu de sélection) faite avant le lancement du LISP, sinon, invitent l'utilisateur à choisir un (ou des) objet(s). Les arguments requis sont une liste de filtres de sélection (ou nil) et un message d'invite (ou ""). Par exemple : (setq ent (presel_ent '((0 . "CIRCLE")) "\nSélectionnez un cercle.")) pour un LISP nécessitant une entité "cercle". Pour une seule entité : ;;; Presel_ent ;;; Retourne le nom d'une entité sélectionnée avant ou après le lancement de la commande ;;; fltr_lst : la liste des filtres de sélection pour ssget (ou nil) ;;; msg : l'invite pour le choix des objets (ou "") (defun presel_ent (fltr_lst msg / set1 ent) (if (and (= 1 (getvar "pickfirst")) (setq set1 (ssget "_i" fltr_lst)) (eq 1 (sslength set1)) ) (sssetfirst nil nil) (progn (sssetfirst nil nil) (princ msg) (while (not (setq set1 (ssget "_:S" fltr_lst))) (princ msg) ) ) ) (setq ent (ssname set1 0)) ent ) Pour un jeu de sélection : ;;; Presel_jsel ;;; Retourne un jeu de sélection établi avant ou après le lancement de la commande ;;; fltr_lst : la liste des filtres de sélection pour ssget (ou nil) ;;; msg : l'invite pour le choix des objets (ou "") (defun presel_jsel (fltr_lst msg / jsel) (if (and (= 1 (getvar "pickfirst")) (setq jsel (ssget "_i" fltr_lst)) ) (sssetfirst nil nil) (progn (sssetfirst nil nil) (princ msg) (while (not (setq jsel (ssget fltr_lst))) (princ msg) ) ) ) jsel ) PS : il peut être avantageux de les mettre (avec d'autres) dans un fichier "Mes_Utils.lsp" chargé à chaque démarrage, pour les appeler dans différents LISP sans avoir à les redéfinir à chaque fois.
  25. Pour transformer un cercle en polyligne circulaire : ;;; Presel_ent ;;; Retourne le nom d'une entité sélectionnée avant ou après le lancement de la commande ;;; fltr_lst : la liste des filtres de sélection pour ssget (ou nil) ;;; msg : l'invite pour le choix des objets (ou "") (defun presel_ent (fltr_lst msg / set1 ent) (if (and (= 1 (getvar "pickfirst")) (setq set1 (ssget "_i" fltr_lst)) (eq 1 (sslength set1)) ) (sssetfirst nil nil) (progn (sssetfirst nil nil) (princ msg) (while (not (setq set1 (ssget "_:S" fltr_lst))) (princ msg) ) ) ) (setq ent (ssname set1 0)) ent ) ;;; C:C2PL Transforme un cercle en polyligne (2 arcs) (defun c:c2pl (/ ent lst cen ray pt1 pt2 elv) (if (setq ent (presel_ent '((0 . "CIRCLE")) "\nSélectionnez un cercle.") ) (setq lst (entget ent) cen (cdr (assoc 10 lst)) ray (cdr (assoc 40 lst)) pt1 (polar cen 0.0 ray) pt2 (polar cen pi ray) elv (caddr pt1) ) ) (foreach pt '(pt1 pt2) (set pt (list (car (eval pt)) (cadr (eval pt)))) ) (foreach code '(-1 0 330 5 100 10 40) (setq lst (vl-remove-if '(lambda (x) (= (car x) code)) lst) ) ) (command "_regen") (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) '(70 . 1) (cons 10 pt1) '(42 . 1.0) (cons 10 pt2) '(42 . 1.0) (cons 38 elv) ) lst ) ) (entdel ent) (princ) )
×
×
  • 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é