Francis

Bonjour :) Pour ma part j'utilise ceci: ;;; SEGLEN par GC version 3.00 - 2011/01 ;;; Crée un texte sur chaque segment de ligne ou polyligne sélectionné ;;; dont la valeur est la longueur du segment. ;;; http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=31392#pid139304 (defun c:seglen300 (/ *error* format temp file dcl_id slst st jlst ju ht pre suf ro fs stat ss space n obj len pa txt fs ent pt) (vl-load-com) (or *acad* (setq *acad* (vlax-get-acad-object))) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*))) ;; redéfintion locale de *error* (defun *error* (msg) (and msg (/= msg "Fonction annulée") (princ (strcat "\nErreur: " msg)) ) (vla-EndUndoMark *acdoc*) (princ) ) ;; sous routine de formatage du texte : justification et rotation (defun format (txt / ang) (vla-put-Alignment txt (cond ((= ju "Gauche") acAlignmentLeft) ((= ju "Centre") acAlignmentCenter) ((= ju "Droite") acAlignmentRight) ((= ju "Milieu") acAlignmentMiddle) ((= ju "Haut Gauche") acAlignmentTopLeft) ((= ju "Haut Centre") acAlignmentTopCenter) ((= ju "Haut Droite") acAlignmentTopRight) ((= ju "Milieu Gauche") acAlignmentMiddleLeft) ((= ju "Milieu Centre") acAlignmentMiddleCenter) ((= ju "Milieu Droite") acAlignmentMiddleRight) ((= ju "Bas Gauche") acAlignmentBottomLeft) ((= ju "Bas Centre") acAlignmentBottomCenter) ((= ju "Bas Droite") acAlignmentBottomRight) ) ) (or (= ju "Gauche") (vla-put-TextAlignmentPoint txt (vlax-3d-point pt)) ) (and (= ro "al") (setq ang (angle '(0. 0. 0.) (vlax-curve-getfirstDeriv obj (vlax-curve-getParamAtPoint obj pt) ) ) ) (if (and (= fs "1") (minusp (cos ang))) (vla-put-Rotation txt (+ pi ang)) (vla-put-Rotation txt ang) ) ) (vla-put-StyleName txt st) ) ;; création de la boite de dialogue (écriture dans un fichier temporaire) (setq temp (vl-filename-mktemp "Tmp.dcl") file (open temp "w") ) (write-line (strcat "IncTxt:dialog{" "label=\"Longueurs de segments\";" ":boxed_column{" "label=\"Mise en forme\";" ":popup_list{" "label=\"Style\";key=\"st\";edit_width=16;}" ":popup_list{" "label=\"Justification\";key=\"ju\";edit_width=16;}" ":edit_box{" "label=\"Hauteur\";key=\"ht\";edit_width=5;allow_accept=true;}" ":edit_box{" "label=\"Préfixe\";key=\"pre\";edit_width=16;allow_accept=true;}" ":edit_box{" "label=\"Suffixe\";key=\"suf\";edit_width=16;allow_accept=true;}" ":boxed_column{label=\"Orientation\";" ":radio_row{key=\"ro\";" ":radio_button{label=\"Horizontal\";key=\"ho\";}" ":radio_button{label=\"Aligné\";key=\"al\";}}" ":toggle{label=\"Forcer le sens de lecture\";key=\"fs\";}}}" "ok_cancel;}" ) file ) (close file) ;; initialisation et chargement de la boite de dialogue (setq dcl_id (load_dialog temp)) (if (not (new_dialog "IncTxt" dcl_id)) (exit) ) (while (setq st (tblnext "STYLE" (not st))) (if (/= (cdr (assoc 2 st)) "") (setq slst (cons (cdr (assoc 2 st)) slst)) ) ) ;; liste déroulante "Style" (setq slst (reverse slst)) (start_list "st") (mapcar 'add_list slst) (end_list) ;; liste déroulante "Justification" (setq jlst '("Gauche" "Centre" "Droite" "Milieu" "Haut Gauche" "Haut Centre" "Haut Droite" "Milieu Gauche" "Milieu Centre" "Milieu Droite" "Bas Gauche" "Bas Centre" "Bas Droite" ) ) (start_list "ju") (mapcar 'add_list jlst) (end_list) ;; initialisation des variables (setq st (getvar "TEXTSTYLE") ; style de texte ju "Bas Centre" ; justification (voir liste) ht (cond ; hauteur de texte ((vlax-ldata-get "SegLen" "TextHeight")) ((getvar "TEXTSIZE")) ) pre "" ; préfixe suf "" ; suffixe ro "al" ; rotation ("al" ou "ho") fs "1" ; sens écriture ("1" ou "0") ) ;; affichage des éléments en fonction des variables (set_tile "st" (itoa (vl-position st slst))) (set_tile "ju" (itoa (vl-position ju jlst))) (set_tile "ht" (rtos ht)) (set_tile "pre" pre) (set_tile "suf" suf) (set_tile "ro" ro) (set_tile "fs" fs) ;; définitions des actions des éléments (action_tile "st" "(setq st (nth (atoi $value) slst))") (action_tile "ju" "(setq ju (nth (atoi $value) jlst))") (action_tile "ht" "(if (and (numberp (distof $value)) (< 0 (distof $value))) (setq ht (distof $value)) (progn (alert \"Nécessite un nombre réel strictement positif\") (set_tile \"ht\" (rtos ht)) (mode_tile \"ht\" 2))))" ) (action_tile "pre" "(setq pre $value)") (action_tile "suf" "(setq suf $value)") (action_tile "ho" "(setq ro $key) (mode_tile \"fs\" 1)") (action_tile "al" "(setq ro $key) (mode_tile \"fs\" 0)") (action_tile "fs" "(setq fs $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq stat (start_dialog)) ;; déchargemet de la boite de dialogue et suppression du fichier DCL (unload_dialog dcl_id) (vl-file-delete temp) ;; Sélection des polylignes et lignes (if (and (= stat 1) (setq ss (ssget '((410 . "Model") (-4 . "<OR") (0 . "LINE") (-4 . "<AND") (0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>") (-4 . "AND>") (-4 . "OR>") ) ) ) ) (progn (vla-StartUndoMark *acdoc*) (vlax-ldata-put "SegLen" "TextHeight" ht) (setq space (vlax-get *acdoc* (if (= (getvar 'cvport) 1) 'PaperSpace 'ModelSpace ) ) ) ;; traitement du jeu de sélection (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *acdoc*)) (if (= (vla-get-ObjectName obj) "AcDbLine") ;; lignes (progn (setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) pt (vlax-curve-getPointAtDist obj (/ len 2.0)) ) (format (vla-addText space (strcat pre (rtos len) suf) (vlax-3d-point pt) ht ) ) ) ;; polylignes (repeat (setq pa (fix (vlax-curve-getEndParam obj))) (setq len (- (vlax-curve-getDistAtParam obj pa) (vlax-curve-getDistAtParam obj (setq pa (1- pa))) ) pt (vlax-curve-getPointAtparam obj (+ pa 0.5)) ) (format (vla-addText space (strcat pre (rtos len) suf) (vlax-3d-point pt) ht ) ) ) ) ) (vla-Delete ss) ) ) (*error* nil) ) Je ne retrouve plus le lien original, mais créé par "GC" peut être (gile)? Bonne journée!

Didier, lorsque je parle du fonctionnement sur plusieurs version d'AutoCAD, c'est plutôt par rapport à la méthode d'Olivier, nécessitant MAP ou Civil 3D. Un lisp fonctionnera sur plus de versions, hormis la LT, si je ne me trompe pas. GEGEMATIC, effectivement le code de didier fonctionne, gros manque de temps pour me pencher sur celui-ci (et approfondir mes connaissances) mais à termes je pense partir sur un fichier texte externe.

Bonjour, Petite journée off hier... Didier, j'ai déjà quelques pistes, je manque un peu de temps mais compte m'y repencher sous peu, je posterai la routine terminée dès que ce sera le cas! Merci pour ce tuto Olivier, cependant pas d'AutoCAD MAP ou CIVIL 3D pour moi (je ne suis même pas sûr que ma licence étudiant me permette le passage), d'autant plus que je cherche plutôt une solution qui pourrait fonctionner sur le plus de versions d'AutoCAD possible. Bonne journée ;)

Bonjour à tous et merci pour vos réponses! :) Effectivement Didier, votre routine est bien plus simple que la mienne et je compte bien essayer cette idée de cette table de codes. Votre approche est tout de même assez différente de la mienne et j'avoue ne pas y avoir pensé sous cet angle. Cependant j'aurai bien aimé savoir si l'un d'entre vous avez une idée sur ce qui engendrerait le plantage de la fonction SSATT lors du passage à l'élément suivant de la liste des codes(ne serait-ce que pour comprendre le problème). Merci d'avance et bon Week-End!

Bonjour et merci pour votre réponse! J'ai bien conscience de ne pas avoir choisi la facilité et que le travail de (gile) est d'un tout autre niveau du mien. J'entends bien vos arguments mais il est vrai le fait de m’attaquer à quelque chose d'un niveau au-dessus me motive généralement J'ai omis de le préciser mais effectivement, ces codes ne s'appliquent qu'à de l'objet ponctuel, c'est peut-être idiot mais j'ai cette tendance à ne pas aimer le lever codifié de A à Z... Je préfère tracer l'ensemble des lignes, courbes, etc de manière à garder un contrôle et une véritable interprétation du terrain. Merci pour l'attention que vous portez à mon problème, bonne soirée :)

Bonjour, Malgré mon modeste niveau en LISP, je me suis essayé à la création d'une routine permettant l'insertion de blocs tiers (chargés dans le dessin) à partir d'une sélection de blocs "TCPOINT" selon la valeur d'un attribut "COD" (par exemple un TCPOINT ayant un attribut COD "Arbre" remplacera le TCPOINT par un arbre, en conservant les valeurs d’attributs). Pour ce faire, j'ai dans un premier temps défini une liste de tous les attributs "COD", puis lancé une boucle qui, pour chaque élément de la liste, sélectionne l’ensemble des blocs avec la valeur d'attribut "COD" valant l'élément de la liste (il s'agit d'une légère modif du SSATT de (gile)). Cette sélection est alors utilisée dans une routine (BRS de kent wood?) qui remplace les blocs par d'autres. Tout fonctionne bien pour la première itération de la boucle sauf que... Ben ça ne va pas plus loin :( Pour une raison que j'ignore, la fonction SSATT plante en me retournant le message "erreur: fonction incorrecte: "xx" ", avec xx le nom du code en question... J'avoue avoir essayé plusieurs méthodes, sans toutefois réussir, quelqu'un aurait-il une idée du pourquoi du comment? Vous trouverez ci-joint mon code (il est encore un peu bordélique, veuillez m'excuser...), en espérant que quelqu'un ait la solution ;) Merci d'avance! (vl-load-com) (defun brerr (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ); if (command "_.undo" "_end") (setvar 'cmdecho cmde) (princ) ); defun -- brerr (defun *ev (ltr); evaluate what's in variable name with letter (eval (read (strcat "*br" ltr "name"))) ); defun - *ev ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun brsetup (this other / temp) (setq cmde (getvar 'cmdecho)) (setvar 'cmdecho 0) (command "_.undo" "_begin") (while (or (not temp); none yet [first time through (while) loop] (and (not (*ev this)) (not (*ev other)) (= temp (getvar 'insname) "")) ; no this-command or other-command or Insert defaults yet, on User Enter (and ; availability check (/= temp ""); User typed something other than Enter, but (not (tblsearch "block" temp)); no such Block in drawing, and (not (findfile (strcat temp ".dwg"))); no such drawing in Search paths ); and ); or (setq temp (getstring (strcat (if (and temp (/= temp "")) "\nNo such Block or Drawing available." "") ;"\nBlock to Replace existing Block(s) with" (cond ((*ev this) (strcat " <" (*ev this) ">")); prior Block in this command, if any ((*ev other) (strcat " <" (*ev other) ">")); prior Block in other command, if any ((/= (getvar 'insname) "") (strcat " <" (getvar 'insname) ">")); Insert's default, if any (""); no default on first use if no this-command or other-command or Insert defaults ); cond ": " ); strcat ); getstring & temp ); setq ); while (set (read (strcat "*br" this "name")) (cond ((/= temp "") temp); User typed something ((*ev this)); default for this command, if any ((*ev other)); default for other command, if any ((getvar 'insname)); Enter on first use with Insert's default ); cond ); set (if (not (tblsearch "block" (*ev this))); external drawing, not yet Block in current drawing (command "_.insert" (*ev this) nil); bring in definition, don't finish Inserting ); if ); defun -- brsetup ;;; Enlever les doublons (gile) (defun remove_doubles (lst) (if lst (cons (car lst) (remove_doubles (vl-remove (car lst) lst))) ) ) ;;start (defun c:codif ( / lst doc attfull att elst tag val name ss1 ss2 blkss ent foundit att *error* cmde repl notrepl ent) (setq dbg 0) ;;; Construit une liste des valeurs d'attributs d'un bloc (if (setq blkss (ssget "_X" '((2 . "TCPOINT")))) (repeat (sslength blkss) ; then (setq ent (ssname blkss 0)) (while (and (not foundit) (setq ent (entnext ent)) (= (cdr (assoc 0 (entget ent))) "ATTRIB") ); end and (setq attfull (vlax-ename->vla-object ent)) (if (= (vla-get-TagString attfull) "COD") (setq foundit T CommentList (cons (vla-get-TextString attfull) CommentList) ); setq ); end if ); end while (setq foundit nil) (ssdel (ssname blkss 0) blkss) ); end repeat ); end if (setq attlist (remove_doubles CommentList)) ; créé une nouvelle liste contenant toutes les valeurs de codes possibles sans doublons (princ) ; end defun (setq count 0) ; initialisation du compteur (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq att (car (nentsel "\nSélectionnez l'attribut source: "))) (setq att (vlax-ename->vla-object att)) (foreach val attlist ;Pour chacun des codes de la liste ((setq val (nth count attlist)) ; la variable val prends la valeur de l'élément i (avec i la valeur du compteur) >> on parcourt donc la liste ;; debut du ssatt modifié (and (= (vla-get-ObjectName att) "AcDbAttribute") (setq tag (vla-get-TagString att) blk (vla-ObjectIDToObject doc (vla-get-OwnerId att)) name (if (vlax-property-available-p blk 'EffectiveName) (vla-get-EffectiveName blk) (vla-get-Name blk) ) ss2 (ssadd) ) (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat name ",`*U*")) ) ) (vlax-for blk (setq ss1 (vla-get-ActiveSelectionSet doc)) (if (= name (if (vlax-property-available-p blk 'EffectiveName) (vla-get-EffectiveName blk) (vla-get-Name blk) ) ) (foreach a (vlax-invoke blk 'GetAttributes) (if (and (= (vla-get-TagString a) tag) (= (vla-get-TextString a) val) ) (ssadd (vlax-vla-object->ename blk) ss2) T ) ) T ) ) (not (vla-delete ss1)) (sssetfirst nil ss2) ) (princ) ;;;insertion ;;; ;(setq *error* brerr) (brsetup "s" "a") ;(prompt (strcat "\nTo replace Block insertion(s) with " val ",")) (setq ;ss2 (ssget ":L" '((0 . "INSERT"))); Blocks/Xrefs/Minserts/WMFs on unlocked Layers repl (sslength ss2) notrepl 0 ); setq (repeat repl (setq ent (ssname ss2 0)) (if (not (assoc 1 (tblsearch "block" (cdr (assoc 2 (entget ent)))))); not Xref (vla-put-Name (vlax-ename->vla-object ent) val); then (setq notrepl (1+ notrepl) repl (1- repl)); else ); if (ssdel ent ss2) ); repeat ;(prompt (strcat "\n" (itoa repl) " Block(s) replaced with " val ".")) (if (> notrepl 0) (prompt (strcat "\n" (itoa notrepl) " Xref(s) not replaced."))) (command "_.undo" "_end") (setvar 'cmdecho cmde) (princ) (setq val nil) (setq ss2 nil) (setq ss1 nil) (sssetfirst) (setq count (+ 1 count)) )); fin foreach );fin defun

Bonjour bonjour, Je ne pensais pas que mon post serait à l'origine de ce genre de discussions :(rires forts): Je vous remercie pour vos réponses respectives ;) Didier, je sais que je ne regarde pas assez votre site mais je pense que cela va changer en m’attaquant plus profondément aux boîtes DCL :(rires forts): Lili, vos sujets sont bien intéressants, mais je trouve assez dommage de ne plus voir ce genre de choses en BTS (et même plus loin...). Et merci bonuscad pour la mise à disposition, je vais voir si je peux en faire quelque chose voir coupler cette routine au sein de même programme... A méditer! Bonne soirée!

En effet, cela fonctionne parfaitement dans un trapèze et même dans des quadrilatères biscornus, je l'avais testé dans un polygone quelconque d'où le fait que cela ne fonctionne pas... Ça me donne matière à réfléchir, est ce que cela te dérange si je l'incorpore dans une autre routine? Mais intéressant ce formulaire, par contre je suis assez étonné de ne pas avoir vu cette formule de Sarron en BTS MGTMN (ou alors je n'étais pas assez assidu :(rires forts): )

Merci pour ce petit code, malheureusement il ne marche pas chez moi... Par contre ça pourrait être une piste à méditer, je vais me pencher dessus et voir avec d'autres outils mathématiques s'il n'y a pas moyen d'optimiser tout ça... Merci beaucoup en tout cas :)

Bonjour bonjour, Réponse quelque peu tardive et je m'en excuse... Voici le Lisp corrigé, même s'il n'est pas d'une rapidité incroyable il a au moins le mérite de fonctionner Quand j'aurais un poil plus de temps, je rajouterai une petite fonction (voir une boîte dcl!) permettant de paramétrer la tolérance lors des calculs de surfaces. Voici le code: ;;;DIVAREA.LSP Land division utility - Modifié et traduit par Francis ;;; Supposez que vous devez diviser une parcelle en un certain nombre de lots ;;; ou que vous vouez seulement retrancher une certaine surface à une parcelle plus grande ;;; ;;; Vous avez seulement besoin d'une polyligne de contour fermée ;;; ;;; ;;; ;;; Lorsqu'il vous sera demandé d'indiquer approximativement 2 points de ;;; la limite, prenez en compte que ;;; ;;; 1. Cette limite va subir une rotation ou être décalée et ;;; aucun de ses points d’extrémité ne doit être en dehors des limites de la parcelle, ;;; ;;; Donc choisissez des points le plus loin possible de la limite ;;; sans excéder, bien entendu, les limites de votre parcelle ;;; Pour la méthode dite "du point fixe", ;;; les points doivent être situé sur la polyligne de contour ou ;;; à l’extérieur mais jamais à l'intérieur ;;; ;;; 2. Lorsque vous pointerez la parcelle qui aura la surface désirée ;;; vous devrez pointer dans le contour de la parcelle et le plus loin possible de la limite divisoire ;;; Ainsi, ce point ne sera pas en dehors de la zone désirée lorsque la limite se déplacera. ;;; ;;; ;;; 3. Enfin, vous aurez à pointer exactement de la même manière, ;;; loin de la limite divisoire et dans la parcelle restante. ;;; ;;;************************************************* (defun prerr (s) (if (/= s "Interruption") (princ (strcat "\nErreur: " s)) );endif (setq *error* olderr) (princ) );close defun (Defun C:TRDiv(/ osm strpf strdc ex arxset arx arxon k scl ok d p1 p2 pts ptb deln ar par tem stp stp1 stp2 ) (setq olderr *error* *error* prerr) (setq osm(getvar "osmode")) (setvar "osmode" 0) (setvar "cmdecho" 0) (setq ex 0 stp 0.01 stp1 0.005 stp2 0.0005 ) (setq arxset (entsel "\nSelectionner une Polyligne de contour fermee: ") arx (entget(car arxset)) arxon (cdr (assoc -1 arx)) ) (if (not(and(equal (cdr(assoc 0 arx)) "LWPOLYLINE") (= (cdr(assoc 70 arx)) 1))) (progn (princ "\nCeci n'est pas une polyligne de contour fermee...") (setq ex 1) ) ) (if (= ex 0) (progn (command "_undo" "_m") ;if something goes bad, you may return here (command "_layer" "_m" "Division" "") (command "_area" "_e" arxon) (setq ar(getvar "area")) (initget "Divide Cut") (setq strdc(getkword "\nDiviser par un nombre ou deCouper une surface? (D/C) :")) (if (= strdc "Divide") (progn (setq k (getreal "\nSpecifier le nombre de lots: ")) (setq tem(/ ar k)) ) ) (if (= strdc "Cut") (setq tem (getreal "\nSpecifier l'aire extraite depuis la parcelle (m2) : ")) ) (initget "Parallel Fixed") (setq strpf(getkword "\nParallele a une direction ou Fixe par rapport a un cote? (P/F) :")) (if (= strpf "Fixed") (fixpt) ) (if (= strpf "Parallel") (parpt) ) (ready) ) (ready) ) ) ;****************************************************************************** (defun fixpt () (setvar "osmode" osm) (setq scl 0.05 p1 (getpoint "\nChoisir un premier point fixe sur la limite divisoire : ") p2 (getpoint "\nChoisir un second point flottant sur la limite divisoire: ") ) (setvar "osmode" 0) (command "_line" p1 p2 "") (setq deln (entlast)) (setq pts (getpoint "\nChoisir un point dans le premier lot, loin de la limite divisoire: ")) (setq ptb (getpoint "\nChoisir un point dans le reste de la parcelle, loin de la limite divisoire: ")) (setvar "blipmode" 0) (princ "\nPatientez...") (command "_boundary" pts "") (command "_area" "_e" "_l") (setq par(getvar "area")) (setq ok -1) (if (< par tem) (progn (while (< par tem) (entdel (entlast)) (if (< (- tem par) 50)(setq scl stp)) (if (< (- tem par) 10)(setq scl stp2)) (command "_rotate" deln "" p1 (* scl ok)) (command "_boundary" pts "") (command "_area" "_e" "_l") (if (< (getvar "area") par) (setq ok(* ok -1)) ) (setq par(getvar "area")) );endwhile (entdel deln) ) (progn (while (> par tem) (entdel (entlast)) (if (< (- par tem) 50)(setq scl stp)) (if (< (- par tem) 10)(setq scl stp2)) (command "_rotate" deln "" p1 (* scl ok)) (command "_boundary" pts "") (command "_area" "_e" "_l") (if (> (getvar "area") par) (setq ok(* ok -1)) ) (setq par(getvar "area")) );endwhile (entdel deln) ) ) (command "_change" "_l" "" "_p" "_c" "_green" "") (command "_boundary" ptb "") (command "_change" "_l" "" "_p" "_c" "_red" "") (ready) ) ;****************************************************************************** (defun parpt () (setvar "osmode" osm) (setq scl 0.25 p1 (getpoint "\nChoisir un premier point sur la limite divisoire (loin de votre contour) : ") p2 (getpoint "\nChoisir un second point sur la limite divisoire (loin de votre contour) : ") ) (setvar "osmode" 0) (command "_line" p1 p2 "") (setq deln(entlast)) (setq pts (getpoint "\nChoisir un point dans le premier lot, loin de la limite divisoire: ")) (setq ptb (getpoint "\nChoisir un point dans le reste de la parcelle, loin de la limite divisoire: ")) (setvar "blipmode" 0) (princ "\nPatientez...") (command "_boundary" pts "") (command "_area" "_e" "_l") (setq par(getvar "area")) (if (< par tem) (progn (while (< par tem) (entdel (entlast)) (if (< (- tem par) 50)(setq scl stp1)) (if (< (- tem par) 10)(setq scl stp2)) (command "_offset" scl deln ptb "") (entdel deln) (setq deln(entlast)) (command "_boundary" pts "") (command "_area" "_e" "_l") (setq par(getvar "area")) ) (entdel deln) ) (progn (while (> par tem) (entdel (entlast)) (if (< (- par tem) 50)(setq scl stp1)) (if (< (- par tem) 10)(setq scl stp2)) (command "_offset" scl deln pts "") (entdel deln) (setq deln(entlast)) (command "_boundary" pts "") (command "_area" "_e" "_l") (setq par(getvar "area")) ) (entdel deln) ) ) (command "_change" "_l" "" "_p" "_c" "_green" "") (command "_boundary" ptb "") (command "_change" "_l" "" "_p" "_c" "_red" "") ) ;****************************************************************************** (defun ready () (princ scl) (princ "\nValeur dessin : ") (princ par) (princ "\nValeur theorique: ") (princ tem) (setq *error* olderr) (setvar "osmode" osm) (setvar "cmdecho" 1) (setvar "blipmode" 1) (princ "\nFin ") (princ) );close defun Bonne journée :)

Mais bien sûr, pourquoi je n'y ai pas pensé avant?! La version d'AutoCAD que j'avais utilisé avec ce LISP était en Anglais, d'où mon erreur! Comme quoi il m'en reste encore pas mal à apprendre :(rires forts): Merci beaucoup pour vos réponses et pour votre rapidité, bonne journée :)

Je ne l'ai peut-être pas assez précisé, mais ce LISP sert à réaliser des divisions de parcelles! :)

Bonjour à tous! Premier Post sur ce forum que je suis depuis quelque temps déjà. En ces temps de confinement (j'espère que vous vous portez bien), je me retrouve sans Covadis ni aucun autre applicatif... Dans le cadre d'un projet (scolaire!) je vais devoir réaliser une division de parcelle en vue d'un projet de lotissement, j'ai donc ressorti des vieux LISPS que j'avais retouché (et tenté de traduire) en cabinet pour des vieilles versions d'AutoCAD. Or, depuis que ma licence "Étudiant" m'a contraint au passage sur 2020, celui-ci ne fonctionne plus. Message me demandant de sélectionner un calque sans pouvoir en sélectionner un, j'avoue ne pas comprendre d'où ça vient. Ce lisp fonctionne de la manière suivante: on sélectionne une polyligne de contour (fermée) on précise si on veut diviser en un nombre de lots ou decouper une surface seulement Si découpage en lots, on précise le nombre de lots Si découpage d'une surface, on précise combien en m² On choisit comment tracer la limite: parallèle à un coté ou en sélectionnant 2 points de passage dits "fixes" En fonction, on sélectionne Ensuite le LISP trace et adapte de manière a conserver ce qui est demandé Le LISP en question: ;;;DIVAREA.LSP Land division utility - Modifié et traduit par Francis ;;; Supposez que vous devez diviser une parcelle en un certain nombre de lots ;;; ou que vous vouez seulement retrancher une certaine surface à une parcelle plus grande ;;; ;;; Vous avez seulement besoin d'une polyligne de contour fermée ;;; ;;; Repondez aux quelques questions et rappelez-vous: ;;; ;;; Lorsqu'il vous sera demandé d'indiquer approximativement 2 points de ;;; la limite, prenez en compte que ;;; ;;; 1. Cette limite va subir une rotation ou être décallée et ;;; aucun de ses points d'éxtrémité ne doit être en dehors des limites de la parcelle, ;;; ;;; Donc choisissez des points le plus loin possible de la limite ;;; sans exceder, bien entendu, les limites de votre parcelle ;;; Pour la méthode dite "fixe", ;;; les points doivent être situé sur la polyligne de contour ou ;;; à l'exterieur mais jamais à l'intérieur ;;; ;;; 2. Lorsque vous pointerez la parcelle qui aura la surface désirée ;;; vous devrez pointer dans le contour de la parcelle et le plus loin possible de la limite divisoire ;;; Ainsi, ce point ne sera pas en dehors de la zone désirée lorsque la limite se déplacera. ;;; ;;; ;;; 3. Enfin, vous aurez à pointer exactement de la même manière, ;;; loin de la limite divisoire et dans la parcelle restante. ;;; ;;;************************************************* (defun prerr (s) (if (/= s "Fonction Annulée") (princ (strcat "\nErreur: " s)) );endif (setq *error* olderr) (princ) );close defun (Defun C:DDIVAREA(/ osm strpf strdc ex arxset arx arxon k scl ok d p1 p2 pts ptb deln ar par tem stp stp1 stp2 ) (setq olderr *error* *error* prerr) (setq osm(getvar "osmode")) (setvar "osmode" 0) (setvar "cmdecho" 0) (setq ex 0 stp 0.01 stp1 0.005 stp2 0.0005 ) (setq arxset (entsel "\nSelectionnez une Polyligne de contour fermee: ") arx (entget(car arxset)) arxon (cdr (assoc -1 arx)) ) (if (not(and(equal (cdr(assoc 0 arx)) "LWPOLYLINE") (= (cdr(assoc 70 arx)) 1))) (progn (princ "\nCeci n'est pas une polyligne de contour fermee... :-( ") (setq ex 1) ) ) (if (= ex 0) (progn (command "_undo" "m") ;if something goes bad, you may return here (command "_layer" "m" "div" "") (command "_area" "e" arxon) (setq ar(getvar "area")) (initget "Divide Cut") (setq strdc(getkword "\nDIVISER par un nombre ou DECOUPER une surface? (D/C) :")) (if (= strdc "Divide") (progn (setq k (getreal "\nSpecifiez le nombre de lots à diviser: ")) (setq tem(/ ar k)) ) ) (if (= strdc "Cut") (setq tem (getreal "\nSpécifiez l'aire à decouper depuis la parcelle(m2) : ")) ) (initget "Parallel Fixed") (setq strpf(getkword "\nPARALLELE a une direction ou FIXE par rapport à un côté? (P/F) :")) (if (= strpf "Fixed") (fixpt) ) (if (= strpf "Parallel") (parpt) ) (ready) ) (ready) ) ) ;****************************************************************************** (defun fixpt () (setvar "osmode" osm) (setq scl 0.05 p1 (getpoint "\nChoisissez un premier point fixe sur la limite divisoire : ") p2 (getpoint "\nChoisissez un second point fixe sur la limite divisoire: ") ) (setvar "osmode" 0) (command "_line" p1 p2 "") (setq deln (entlast)) (setq pts (getpoint "\nChoisissez un point dans le premier lot, eloigné de la limite divisoire: ")) (setq ptb (getpoint "\nChoisissez un point dans le reste de la parcelle, eloigné de la limite divisoire: ")) (setvar "blipmode" 0) (princ "\nPatientez...") (command "_boundary" pts "") (command "_area" "e" "l") (setq par(getvar "area")) (setq ok -1) (if (< par tem) (progn (while (< par tem) (entdel (entlast)) (if (< (- tem par) 50)(setq scl stp)) (if (< (- tem par) 10)(setq scl stp2)) (command "_rotate" deln "" p1 (* scl ok)) (command "_boundary" pts "") (command "_area" "e" "l") (if (< (getvar "area") par) (setq ok(* ok -1)) ) (setq par(getvar "area")) );endwhile (entdel deln) ) (progn (while (> par tem) (entdel (entlast)) (if (< (- par tem) 50)(setq scl stp)) (if (< (- par tem) 10)(setq scl stp2)) (command "_rotate" deln "" p1 (* scl ok)) (command "_boundary" pts "") (command "_area" "e" "l") (if (> (getvar "area") par) (setq ok(* ok -1)) ) (setq par(getvar "area")) );endwhile (entdel deln) ) ) (command "_change" "l" "" "p" "c" "green" "") (command "_boundary" ptb "") (command "_change" "l" "" "p" "c" "red" "") (ready) ) ;****************************************************************************** (defun parpt () (setvar "osmode" osm) (setq scl 0.25 p1 (getpoint "\nChoisissez un premier point sur la limite divisoire (Eloigné de votre contour) : ") p2 (getpoint "\nChoisissez un second point sur la limite divisoire (Eloigné de votre contour) : ") ) (setvar "osmode" 0) (command "_line" p1 p2 "") (setq deln(entlast)) (setq pts (getpoint "\nChoisissez un point dans le premier lot, eloigné de la limite divisoire: ")) (setq ptb (getpoint "\nChoisissez un point dans le reste de la parcelle, eloigné de la limite divisoire: ")) (setvar "blipmode" 0) (princ "\nPatientez...") (command "_boundary" pts "") (command "_area" "e" "l") (setq par(getvar "area")) (if (< par tem) (progn (while (< par tem) (entdel (entlast)) (if (< (- tem par) 50)(setq scl stp1)) (if (< (- tem par) 10)(setq scl stp2)) (command "_offset" scl deln ptb "") (entdel deln) (setq deln(entlast)) (command "_boundary" pts "") (command "_area" "e" "l") (setq par(getvar "area")) ) (entdel deln) ) (progn (while (> par tem) (entdel (entlast)) (if (< (- par tem) 50)(setq scl stp1)) (if (< (- par tem) 10)(setq scl stp2)) (command "_offset" scl deln pts "") (entdel deln) (setq deln(entlast)) (command "_boundary" pts "") (command "_area" "e" "l") (setq par(getvar "area")) ) (entdel deln) ) ) (command "_change" "l" "" "p" "c" "green" "") (command "_boundary" ptb "") (command "_change" "l" "" "p" "c" "red" "") ) ;****************************************************************************** (defun ready () (princ scl) (princ "\nActuelle : ") (princ par) (princ "\nDoit être: ") (princ tem) (setq *error* olderr) (setvar "osmode" osm) (setvar "cmdecho" 1) (setvar "blipmode" 1) (princ "\nFini! :-) ") (princ) );close defun Si quelqu'un a un petit peu de temps pour m'aider à résoudre mon problème... Merci d'avance, Francis :)