bonuscad

Une vidéo (très simpliste) mais qui reflète quand même bien cette technologie, j'ai bien aimé. C'est réaliste ...

Pas encore essayé ... Mais pour moi c'est simplement un logiciel d’accès à une énorme base de donné numérique (depuis 2006 pour ChatGPT si l'info est correcte). Il classifie et étiquette les données qu'il exploite ensuite par des algorithme pour les restituer d'une façon la plus ordonnée et cohérente possible. Plus on l'utilisera ET plus on le corrigera dans ses réponses, plus il enchérira sa base de donnée. C'était déjà un peu le concept de ce jeu web en ligne -> Akinator qui a déjà une quinzaine d'années d'existence. (logiciel Français)

Bonjour, Je suis pas de la partie, mais une fois (en 2010) j'avais répondu à une question similaire, mais je n'avais jamais eu de retour... Est ce que cela pourrait te servir? Cela fonctionne avec des LWPOLYLINE,SPLINE,ELLIPSE,CIRCLE,ARC et cela retourne: Demande : Coefficient de Manning et la pente Périmètre mouillé Surface mouillée Rayon hydraulique Débit hydraulique en m3/s (vl-load-com) (defun l-coor2l-pt (lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (caddr lst) 0.0)) (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (defun c:perim_mouille ( / js ename obj l_dxf coeff_manning percent key pth hand_lin dxf_ent lst_pt first_pt secnd_pt lst_pt perim_wet area_wet hydraulic_ray q_deb_Manning) (setq key nil pth nil hand_lin nil) (princ "\nSélectionner le périmètre de la canalisation.") (while (null (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE,SPLINE,ELLIPSE,CIRCLE,ARC"))))) (princ "\nCe n'est pas un objet valable!") ) (setq ename (ssname js 0) obj (vlax-ename->vla-object ename) l_dxf (entget ename) ) (foreach n l_dxf (if (member (car n) '(-1 -2 5 330)) (setq l_dxf (vl-remove n l_dxf)) ) ) (initget 6) (setq coeff_manning (getreal "\Coefficient de Manning? <0.015>: ")) (if (not coeff_manning) (setq coeff_manning 0.015)) (setq percent (getreal "\nEntrer la valeur de la pente en % ?<3%>: ")) (if (not percent) (setq percent 3.0)) (setq percent (/ (abs percent) 100.0)) (princ "\nSpécifiez un point de hauteur d'eau à l'intérieur de la canalisation: ") (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (if hand_lin (entdel (handent hand_lin))) (setq pth (trans (cadr key) 1 0)) (entmake (append '( (0 . "LINE") (100 . "AcDbEntity") ) (if (eq (getvar "CTAB") "Model") '((67 . 0)) '((67 . 1))) (list (cons 410 (getvar "CTAB"))) (list (cons 8 (getvar "CLAYER"))) '( (62 . 256) (6 . "ByLayer") (370 . -2) (100 . "AcDbLine") ) (list (cons 10 pth)) (list (cons 11 (polar pth 0.0 1.0))) '((210 0.0 0.0 1.0)) ) ) (setq dxf_ent (entget (entlast)) hand_lin (cdr (assoc 5 dxf_ent))) (if (and (setq lst_pt (l-coor2l-pt (vlax-invoke (vlax-ename->vla-object (entlast)) 'IntersectWith obj acExtendThisEntity ) T ) ) (eq (length lst_pt) 2) ) (progn (entmod (setq dxf_ent (subst (cons 11 (cadr lst_pt)) (assoc 11 dxf_ent) (setq dxf_ent (subst (cons 10 (car lst_pt)) (assoc 10 dxf_ent) dxf_ent)) ) ) ) (setq first_pt (vlax-curve-getparamatpoint obj (car lst_pt)) secnd_pt (vlax-curve-getparamatpoint obj (cadr lst_pt))) (if (> (cadr (vlax-curve-getpointatparam obj (vlax-curve-getEndParam obj))) (cadr pth)) (setq perim_wet (abs (- (vlax-curve-getDistAtParam obj first_pt) (vlax-curve-getDistAtParam obj secnd_pt)))) (setq perim_wet (+ (- (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)) (vlax-curve-getDistAtParam obj (max first_pt secnd_pt))) (vlax-curve-getDistAtParam obj (min first_pt secnd_pt)) ) ) ) (grtext -1 (strcat "Périmètre mouillé = " (rtos perim_wet 2 2))) ) (progn (setq perim_wet nil) (grtext)) ) ) (T (grtext "")) ) ) (grtext) (if perim_wet (progn (cond ((eq (vla-get-objectname obj) "AcDbEllipse") (entmake l_dxf) (if (> (cadr pth) (caddr (assoc 10 l_dxf))) (progn (vla-put-EndParameter obj (- secnd_pt (* 2 pi))) (vla-put-StartParameter obj first_pt) ) (progn (vla-put-EndParameter obj first_pt) (vla-put-StartParameter obj secnd_pt) ) ) ) ((eq (vla-get-objectname obj) "AcDbArc") (entmake l_dxf) (if (> (cadr pth) (caddr (assoc 10 l_dxf))) (progn (vla-put-StartAngle obj (angle (cdr (assoc 10 l_dxf)) (vlax-curve-getpointatparam obj first_pt))) (vla-put-EndAngle obj (angle (cdr (assoc 10 l_dxf)) (vlax-curve-getpointatparam obj secnd_pt))) ) (progn (vla-put-StartAngle obj (angle (cdr (assoc 10 l_dxf)) (vlax-curve-getpointatparam obj secnd_pt))) (vla-put-EndAngle obj (angle (cdr (assoc 10 l_dxf)) (vlax-curve-getpointatparam obj first_pt))) ) ) ) ((eq (vla-get-objectname obj) "AcDbCircle") (setq l_dxf (append (subst '(0 . "ARC") (assoc 0 l_dxf) l_dxf) (if (> (cadr pth) (caddr (assoc 10 l_dxf))) (list (cons 100 "AcDbArc") (cons 50 (angle (cdr (assoc 10 l_dxf)) (vlax-curve-getpointatparam obj first_pt))) (cons 51 (angle (cdr (assoc 10 l_dxf)) (vlax-curve-getpointatparam obj secnd_pt))) ) (list (cons 100 "AcDbArc") (cons 50 (angle (cdr (assoc 10 l_dxf)) (vlax-curve-getpointatparam obj secnd_pt))) (cons 51 (angle (cdr (assoc 10 l_dxf)) (vlax-curve-getpointatparam obj first_pt))) ) ) ) ) (entmake l_dxf) (setq obj (vlax-ename->vla-object (entlast))) ) ((eq (vla-get-objectname obj) "AcDbPolyline") (setq lst_pt (l-coor2l-pt (vlax-get obj 'Coordinates) nil)) ; (setq lst_pt (l-coor2l-pt (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates obj))) nil)) (vla-addVertex obj (1+ (fix first_pt)) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 1)) (list (car (trans (vlax-curve-getpointatparam obj first_pt) 0 ename)) (cadr (trans (vlax-curve-getpointatparam obj first_pt) 0 ename)) ) ) ) ) (setq bulg (vla-GetBulge obj (fix first_pt))) (vla-SetBulge obj (fix first_pt) (/ (sin (/ (* 4 (atan bulg) (- first_pt (fix first_pt))) 4)) (cos (/ (* 4 (atan bulg) (- first_pt (fix first_pt))) 4)) ) ) (vla-SetBulge obj (1+ (fix first_pt)) (/ (sin (/ (* 4 (atan bulg) (- (1+ (fix first_pt)) first_pt)) 4)) (cos (/ (* 4 (atan bulg) (- (1+ (fix first_pt)) first_pt)) 4)) ) ) ; (vla-update obj) (vla-addVertex obj (1+ (1+ (fix secnd_pt))) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 1)) (list (car (trans (vlax-curve-getpointatparam obj (1+ secnd_pt)) 0 ename)) (cadr (trans (vlax-curve-getpointatparam obj (1+ secnd_pt)) 0 ename)) ) ) ) ) (setq bulg (vla-GetBulge obj (1+ (fix secnd_pt)))) (vla-SetBulge obj (1+ (fix secnd_pt)) (/ (sin (/ (* 4 (atan bulg) (- secnd_pt (fix secnd_pt))) 4)) (cos (/ (* 4 (atan bulg) (- secnd_pt (fix secnd_pt))) 4)) ) ) (vla-SetBulge obj (1+ (1+ (fix secnd_pt))) (/ (sin (/ (* 4 (atan bulg) (- (1+ (fix secnd_pt)) secnd_pt)) 4)) (cos (/ (* 4 (atan bulg) (- (1+ (fix secnd_pt)) secnd_pt)) 4)) ) ) (vla-update obj) ) ) (setq area_wet (vla-get-Area obj) hydraulic_ray (/ area_wet perim_wet) q_deb_Manning (* area_wet (expt hydraulic_ray (/ 2 3.0)) (sqrt percent) (/ 1 coeff_manning)) ) (princ "\nPérimètre mouillé = ") (princ perim_wet) (princ "\nSurface mouillée = ") (princ area_wet) (princ "\nRayon hydraulique = ") (princ hydraulic_ray) (princ "\nDébit hydraulique en m3/s = ") (princ q_deb_Manning) ) (entdel (entlast)) ) (prin1) )

Bonjour, Je confirme que l'utilisation de caractères spéciaux et fortement déconseillé. Néanmoins je pense que la commande fcalque doit permettre l'utilisation de caractères tel que "#" qui permet de remplacer n'importe quel chiffre numérique unique dans le noms de calque. Voir la fonction lisp (wcmatch), ce qui explique le soit disant bug que tu rencontre. Ainsi si tu as les calques "0" "Calque1" "Calque2" "toto" Lors de l'utilisation de la commande fcalque si tu tapes "Calque#" les calques "Calque1" et "Calque2" seront gelés. Si tu veux que ta fonction lisp fonctionne avec des calques comportant le symbole "#", remplace la ligne (setq ent (cdr (assoc 8 (entget ent)))) par (setq ent (vl-string-subst "`#" "#" (cdr (assoc 8 (entget ent))))) Cependant cela ne fonctionnera que si le symbole "#" n'est présent qu'une seul fois dans le nom.

Merci @Olivier Eckmann Je suis tellement obnubilé par le Lisp, je connais (arxload) ou (autoarxload), que j'ignorais cette commande ARX avec ses options donnant des détails bien pratiques...🥴

Bien d'accord Mais ce fichier est constitué de blocs qui ont été récupéré de plein de manières (xrefs liés) et de différentes sources (même chinoise) Au total j'en trouve 621 J'ai ouvert le fichier et exécuté ceci (defun xplore (l / ent ) (while (setq ent (entnext (cdar l))) (setq l (entget ent)) (if (eq (cdr (assoc 0 l)) "INSERT") (xplore (entget (cdr (assoc -2 (tblsearch "BLOCK" (cdr (assoc 2 l))))))) ) (if (eq (cdr (assoc 0 l)) "ATTDEF") (write-line (strcat "Etiquette = " (cdr (assoc 2 l)) " ; Valeur = " (cdr (assoc 1 l))) f_open) ) ) ) (defun c:block_summary ( / first_blk l_blk n_blk js) (setq tmp (vl-filename-mktemp "list_blocks.txt") f_open (open tmp "w") ) (setq first_blk (tblnext "BLOCK" T)) (cond (first_blk (setq l_blk (list first_blk)) (while (setq n_blk (tblnext "BLOCK")) (setq l_blk (cons n_blk l_blk)) ) (foreach n l_blk (setq js (ssget "_X" (list (cons 0 "INSERT") (assoc 2 n)))) (write-line (strcat "BLOC : " (cdr (assoc 2 n)) " " (itoa (if js (sslength js) 0)) " insertion(s)") f_open) (cond ((< (cdr (assoc 70 n)) 4) (setq dxf_lst (entget (cdr (assoc -2 n)))) (xplore dxf_lst) ) (T (princ " -> XREF. Définition ignorée")) ) (print) ) ) (T (princ "\nPas de blocs définis!") ) ) (close f_open) (startapp "notepad" tmp) (prin1) ) Les noms comportant par exemple des "\U+5F00\U+653E\U+529E\U+516C09" correspondent aux caractères chinois...

Je viens de découvrir une info forte intéressante à propos de AcCoreConsole. A priori on ne peut pas utiliser certaines fonctions évoluée car elle ne sont pas simplement chargées. Donc en les chargeant elles seraient accessibles, par exemple (trouvé ICI) (foreach file '("acapp.arx" "acapp.crx" "acautoloader.arx" "acautoloader.crx" "acblock.crx" "accmmgr.crx" "acconnectwebservices.arx" "accoremgd.dll" "accounting.arx" "accounting.crx" "acdim.arx" "acdim.crx" "acetutil.arx" "acexperience.arx" "acfdui.arx" "acgeomentobj.dbx" "acgsconfig.arx" "acgsconfig.crx" "acismobj24.dbx" "acismui.crx" "acjscorestub.crx" "acmapcoordsyscore.dbx" "acmgd.dll" "acobjclassimp.arx" "acocschemautil.arx" "acopm.arx" "acopmext.arx" "acpexctl.arx" "acpi.arx" "acpublish.arx" "acpublish.crx" "acrevcloud.crx" "acsceneoe.dbx" "acshareviewpropsaca.dbx" "acshareviewpropspe.dbx" "acsign.arx" "acsmnav.arx" "actable.arx" "actable.crx" "actrace.crx" "actraceui.arx" "acvdiff.arx" "acvdiff.crx" "acvmtools.arx" "acvmtools.crx" "acxdiff.arx" "acxdiff.crx" "aecarchbase.dbx" "aecareacalculationbase.dbx" "aecbase.dbx" "aecbaseex.dbx" "aecbbldsrv.dbx" "aecbcol.dbx" "aecbelecbase.dbx" "aecbhvacbase.dbx" "aecbpipebase.dbx" "aecbplumbingbase.dbx" "aecbtools.dbx" "aeccivilbase.dbx" "aeccmoduleloader.dbx" "aeccore.crx" "aeccvbase.dbx" "aecloader.arx" "aecmodeler.dbx" "aecprojectbase.dbx" "aecschedule.dbx" "aecsolidmodeler.dbx" "attedit.arx" "units.crx" "vl.arx" "vl.crx" ) (command "_.arx" "Load" file) ) Cela ouvre des perspectives intéressantes pour des scripts (bien que je pense que des commandes faisant usage essentiellement de boite de dialogue poseront toujours problème). Le gros point noir et de savoir quelle application charger pour avoir la fonction désirée car je pense qu'il est inutile de toutes les charger afin de laisser à AcCoreConsole le plus d'aisance possible. De plus en chargeant les bons ARX pour Map, cela pourrait par exemple rendre le script proposé initialement plus rapide. Pour l'instant (et je ne sais pas si je le ferais!) je n'ai rien testé, je voulais surtout partagé l'info.

De même Mais en plus j'ai utilisé ceci ;; RemoveAEC (gile) ;; Supprime tous les dictionnaires AEC du dessin (defun c:RemoveDictCOV&AEC () (foreach p (entget (namedobjdict)) (if (and (= 3 (car p)) (or (wcmatch (cdr p) "COVA_*") (wcmatch (cdr p) "AEC_*")) ) (progn (princ (strcat "\n" (cdr p) " a été effacé!")) (dictremove (namedobjdict) (cdr p))) ) ) (princ) ) C'est un peu radical mais si l'on utilise pas ces produits verticaux (Covadis ou Architectural), ça nettoie... Par contre si l'on veux profiter de ces produits, c'est fortement déconseillé, car on va perdre beaucoup d'information propre à ces applications.

Bon c'est très vieux, mais ces deux discussions peuvent aider si on les maîtrise... Je n'ai plus trop utilisé depuis, mais les retours sont imposant dans les versions récentes, depuis l'apparition du vl et vlax https://cadxp.com/topic/7053-express-tools/#comment-34623 https://cadxp.com/topic/17262-liste-de-fonctions-dun-lisp/#comment-91086

Bonjour, Peux tu réessayer avec ces fichiers? J'ai procéder à une purge approfondie (applications comprises et il y en avait beaucoup) et une correction d'erreurs (beaucoup de contour de hachures mais pas seulement) Ça diminue de moitié la taille des fichiers... Mais il reste aussi des ACAD_PROXY_ENTITIE, est que c'est elles qui poserait problème ? https://we.tl/t-mJmBZVlcz8

Bonjour à tous, En voyant tous ces spams, je conçois que ça puisse décourager les modos... Mais il me semble avoir remarqué (mais je n'ai pas fais super attention) que ça à l'air de faire toujours partie d'un même sujet ou auteur, ce qui pourrait me faire penser qu'un membre c'est fait piraté son compte (donc il posséderait mdp et identifiant) et par un subterfuge arriverai à poster en tant qu'invité. De tout façon que ce soit sur les forums, les boites de courriel, les contacts téléphoniques; on est de plus en plus pollué par des importuns. J'ai même renoncé depuis longtemps de répondre sur mon téléphone fixe (baissé le niveau de sonnerie au minimum), si c'est vraiment important la personne devra me laisser un message, ce qui n'est jamais le cas... Bloctel est une foutaise, à voir si cela ne rends pas les choses encore pire. L'obligation de donner un numéro de téléphone pour une livraison de colis en est une aussi (jamais utilisé par les livreurs, se contentent de déposer le colis en site relais) et ainsi notre numéro fuite sur internet. (revente, piratage?) Si les gouvernements ne cherchent pas à protéger ces citoyens sans qu'on soit obligé de passer par des confirmations d'identification de plus en plus nombreuses et intrusives dans notre identité, le monde numérique va devenir une plaie. Mais ça ne reste que mon avis... Jusqu'à maintenant on a toujours pu constater que les pirates avaient une longueur d'avance sur les mesures prises.

J'ai trouvé l'original ICI c'est exactement le même... Pas très bien monté ce code! Les variables ne sont pas déclarées en locale (j'ai pas corrigé) Les fonctions (defun TxtWidth et (defun GetOrCreateTableStyle sont définis deux fois. Si la première est identique, la seconde est différente mais le lisp fonctionne quand même quelque soit la fonction choisie (j'en ai commentée une au hasard). Il manquait une fonction (defun SelByObj pour l'option "Objet", j'ai pris celle de (gile) car une autre fonction de (gile) était déjà présente. J'ai corrigé la ligne : (list i (nth 2 tyty) blk_name (nth 3 tyty) (nth 1 tyty)) par (situé à la ligne 516): (subst "" nil (list i (nth 2 tyty) blk_name (nth 3 tyty) (nth 1 tyty))) Qui pour mon test succinct à fonctionné, mais cette correction peut se révéler insuffisante... à voir Voilà le code corrigé sommairement, censé fonctionner sous autocad: ;********************************************************** ;******************* DEBUT TABM *************************** ; ; free lisp from cadviet.com ; ; Altered by Greg Battin 1/10/2011 for english use ; ; Find replace 10 with 8 ; ; By : Gia Bach, gia_bach @ www.CadViet.com ; ; Modifie le 11/09/2014 par CHCTB pour ASTEM @CHCTB ; Modifié le 15/09/2014 par hpinchon ASTEM ;*************** Fonction liste blocs dynamiques (defun Fdxf (entite / lstdxf) ; l'argument et la variable (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (setq lstdxf (entget entite)) (progn ;;; definition du nom vba de l'entite (setq Vba-ent (vlax-ename->vla-object entite)) ;;; Si cennte entité est un bloc dynamique (if (= (vla-get-IsDynamicBlock Vba-ent) :vlax-true) ;;; récupération du effectivename et ajout à la lstdxf (progn (setq lstdxf (vla-get-effectivename Vba-ent)) ) (setq lstdxf (cdr (assoc 2 (entget ent)))) ) ) lstdxf ; le rappel de la variable sans rien sert de valeur de retour de la fonction ) ;;; SelByObj -Gilles Chanteau- 10/06/2006 ;;; Creates a selection set from an object (circle ellipse or closed ;;; lwpolyline) by Window polygon or Crossing Polygon. ;;; ;;; Arguments : ;;; - ent: ename or vla-object ;;; - opt: selection mode (Cp or Wp) ;;; - fltr: selection filter or nil ;;; ;;; Added a ZoomExtents to select objects out of the viewport (07/20/2007) (defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst ss) (vl-load-com) (if (= (type ent) 'ENAME) (setq obj (vlax-ename->vla-object ent)) (setq obj ent ent (vlax-vla-object->ename ent) ) ) (cond ((member (vla-get-ObjectName obj) '("AcDbCircle" "AcDbEllipse")) (setq dist (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) 50 ) n 0 ) (repeat 50 (setq lst (cons (trans (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n)))) 0 1 ) lst ) ) ) ) ((and (= (vla-get-ObjectName obj) "AcDbPolyline") (= (vla-get-Closed obj) :vlax-true) ) (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (cons (trans (append (cdr (assoc 10 p_lst)) (list (cdr (assoc 38 (entget ent)))) ) ent 1 ) lst ) ) (if (/= 0 (cdadr p_lst)) (progn (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst)))))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (trans (cdaddr p_lst) ent 0) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (cons (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) (* dist (setq n (1+ n))) ) ) 0 1 ) lst ) ) ) ) ) (setq p_lst (cddr p_lst)) ) ) ) (cond (lst (vla-ZoomExtents (vlax-get-acad-object)) (setq ss (ssget opt lst fltr)) (vla-ZoomPrevious (vlax-get-acad-object)) ss ) ) ) ;********************************************************** ;*** Retourner une valeur à la fin d'une fonction (defun c_return (v_value) v_value) ;********************************************************** ;*** Fonction pour Rechercher la valeur d'un attribut (defun rec_val_att (n_ent etiq / val_att test test1) (while (/= test "SEQEND") (if (/= test1 etiq) (progn (setq n_ent (entnext n_ent)) (setq test (cdr (assoc 0 (entget n_ent)))) (setq test1 (cdr (assoc 2 (entget n_ent)))) ) (progn (setq test "SEQEND") (setq val_att (cdr (assoc 1 (entget n_ent)))) ) ) ) (c_return val_att) ) ;********************************************************** ;*** Fonction pour Remplacer valeur d'un attribut (defun rem_att (n_ent etiq valeur / ent1 test test1) (while (/= test "SEQEND") (if (/= test1 etiq) (progn (setq n_ent (entnext n_ent)) (setq test (cdr (assoc 0 (entget n_ent)))) (setq test1 (cdr (assoc 2 (entget n_ent)))) ) (progn (setq test "SEQEND") (setq ent1 (entget n_ent)) (setq ent1 (subst (cons 1 valeur) (assoc 1 ent1) ent1)) (entmod ent1) ) ) ) ) ;********************************************************** ;*** Fonction pour trouver la largeur d'un texte (defun TxtWidth (val h msp / txt minp maxp) (vl-load-com) (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h)) (vla-getBoundingBox txt 'minp 'maxp) (vla-Erase txt) (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp)) ) ) ;********************************************************** ;*** Fonction pour créer un style de tableau (defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty ) (vl-load-com) (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE")) (foreach itm (vlax-for itm objTblStyDic (setq tabLst (append tabLst (list itm)))) (if (not (vl-catch-all-error-p (setq name (vl-catch-all-apply 'vla-get-Name (list itm))))) (setq nameLst (append nameLst (list name))))) (if (not (vl-position tbl_name nameLst)) (vla-addobject objTblStyDic tbl_name "AcDbTableStyle")) (setq objTblSty (vla-item objTblStyDic tbl_name) TxtSty (variant-value (vla-getvariable *adoc "TextStyle"))) (mapcar '(lambda (x) (vla-settextstyle objTblSty x TxtSty)) (list acTitleRow acHeaderRow acDataRow)) (vla-setvariable *adoc "CTableStyle" tbl_name) ) ;********************************************************** ;*** Processeur 64 (defun GetObjectID (obj) (vl-load-com) (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE")) (vlax-invoke-method *util 'GetObjectIdString obj :vlax-false) (vla-get-Objectid obj) ) ) (defun C:TABM (/ ss refs lst ele ins tbl row lstdxf bdn) ;**************** création du jeu de sélection (initget "Collection Objet Sélection") (setq kw (getkword "\nChoisir une option [Collection/Objet/Sélection] < Sélection >: ")) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) ) (setq blocks (vla-get-Blocks *acdoc*)) (setq liref nil) (setq parnombloc1 (getcfg "APPDATA/PARNOMBLOC1")) ;| (defun TxtWidth (val h msp / txt minp maxp) (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h)) (vla-getBoundingBox txt 'minp 'maxp) (vla-Erase txt) (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp)) ) )|; ;| (defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty) (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE" ) ) (foreach itm (vlax-for itm objTblStyDic (setq tabLst (append tabLst (list itm))) ) (if (not (vl-catch-all-error-p (setq name (vl-catch-all-apply 'vla-get-Name (list itm))) ) ) (setq nameLst (append nameLst (list name))) ) ) (if (not (vl-position tbl_name nameLst)) (vla-addobject objTblStyDic tbl_name "AcDbTableStyle") ) (setq objTblSty (vla-item objTblStyDic tbl_name) TxtSty (variant-value (vla-getvariable *adoc "TextStyle")) ) (mapcar '(lambda (x) (vla-settextstyle objTblSty x TxtSty)) (list acTitleRow acHeaderRow acDataRow) ) (vla-setvariable *adoc "CTableStyle" tbl_name) )|; (defun GetObjectID (obj) (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE")) (vlax-invoke-method *util 'GetObjectIdString obj :vlax-false ) (vla-get-Objectid obj) ) ) ;*********************************************** (cond ((= kw "Objet") (if (setq obj (car (entsel "\nSélectionnez l'objet délimitant la sélection: ") ) ) (if (member (cdr (assoc 0 (entget obj))) '("CIRCLE" "ELLIPSE" "LWPOLYLINE") ) (setq ss (SelByObj obj "_WP" '((0 . "INSERT")))) (princ "\nEntité non valide.") ) (princ "\nAucune entité sélectionnée.") ) ) ((= kw "Collection") (setq ss (ssget "_X" '((0 . "INSERT"))) col T ) ) (T (setq ss (ssget '((0 . "INSERT"))))) ) (if ss (setq liref (mapcar '(lambda (x) (setq x (vlax-ename->vla-object x)) (if (vlax-property-available-p x 'EffectiveName) (vla-get-EffectiveName x) (vla-get-Name x) ) ) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ) ) (setq liref '()) ) (setq sstoto ss) (if ss (progn (vlax-for x (setq ss (vla-get-ActiveSelectionSet *acdoc*)) (or (vlax-property-available-p x 'Path) (setq refs (cons (cons (vla-get-EffectiveName x) (gc:GetVisibilityState x) ) refs ) ) ) ) (vla-delete ss) ) ) (foreach n refs (setq lst (if (setq ele (assoc n lst)) (subst (cons (car ele) (1+ (cdr ele))) ele lst) (cons (cons n 1) lst) ) ) ) ;*****************************Charger les fonctions Visual LISP (vl-load-com) ;*******************************Calcul la longeur maxi des noms de blocs puis création liste lst_blk1 ---> Nom Bloc - Quantité Bloc - Marque - Reference (setq i -1 len0 8 ) ;;; longeur par defaut (setq lst_blk nil lst_blk1 nil) (while (setq ent (ssname sstoto (setq i (1+ i)))) (setq ent (ssname sstoto i)) ; ent est l'entité place en position i du selection-set ss (setq blk_name (Fdxf ent)) ; je stoke dans lstdxf la valeur de retour de la fonction fdxf pour l'élément ent (if (> (strlen blk_name) len0) (setq str blk_name len0 (strlen blk_name) ) ) (setq Ent_Marque (rec_val_att ent "MARQUE")) (setq Ent_Reference (rec_val_att ent "REFERENCE")) (if (not (assoc blk_name lst_blk1)) ;;; Si le bloc n'existe pas dans la liste (progn (setq toto (list blk_name 1 Ent_Marque Ent_Reference)) (setq lst_blk1 (cons toto lst_blk1)) ) ;;; Si le bloc existe dans la liste ;;; Vérification si la marque est la même (progn (setq toto2 nil) (foreach n lst_blk1 (setq crit0 (nth 0 n)) (setq crit2 (nth 2 n)) (setq crit3 (nth 3 n)) (if (and (= crit0 blk_name) (= crit2 Ent_Marque) (= crit3 Ent_Reference)) (setq toto2 n) ) ) ;;; Si la marque est la même, incrémenter la quantité (if toto2 (setq lst_blk1 (subst (list blk_name (1+ (nth 1 toto2)) (nth 2 toto2) (nth 3 toto2) ) toto2 lst_blk1 ) ) ;;; Sinon, ajouter à la liste lst_blk1 (progn (setq toto (list blk_name 1 Ent_Marque Ent_Reference)) (setq lst_blk1 (cons toto lst_blk1)) ) ) ) ) ;;; à effacer (if (not (assoc blk_name lst_blk)) (setq lst_blk (cons (cons blk_name 1) lst_blk)) (setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk)))) (assoc blk_name lst_blk) lst_blk ) ) ) ) ;;; Tri la liste des blocs en fonction de la marque puis nom du bloc (setq lst_blk1 (vl-sort lst_blk1 '(lambda (a B) (if (eq (caddr a) (caddr B)) (if (eq (car a) (car B)) (< (cadddr a) (cadddr B)) (< (car a) (car B)) ) (< (caddr a) (caddr B)) ) ) ) ) ;;; à effacer (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y))))) ;;; Calcul hauteur de texte dans le tableau (or *h* (setq *h* (* (getvar "dimtxt") (getvar "dimscale"))) ) (initget 6) (setq h (getreal (strcat "\nHauteur du text <" (rtos *h*) "> :"))) (if h (setq *h* h) (setq h *h*)) (or *adoc (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq msp (vla-get-modelspace *adoc) *util (vla-get-Utility *adoc) blks (vla-get-blocks *adoc)) (setq width1 (* 8 (TxtWidth " " h msp)) ;largeur de N° width (* 0.8 (TxtWidth "Hauteur du text" h msp)) ; largeur globale height (* 2 h) ) (setq width2 width);***************largeur Marque (if str (setq width3 (* 1.2 (TxtWidth (strcase str) h msp))) ;***************largeur nom du bloc (setq width3 width) ) (setq width4 (1+ width));***************largeur Référence (setq width5 width);********************largeur Quantités (setq width6 width);********************largeur Image du bloc (if (> h 3) (setq width (* (fix (/ width 8)) 8) width1 (* (fix (/ width1 8)) 8) width2 (* (fix (/ width2 8)) 8) width3 (* (fix (/ width2 8)) 8) width4 (* (fix (/ width2 8)) 8) width5 (* (fix (/ width2 8)) 8) width6 (* (fix (/ width2 8)) 8) height (* (fix (/ height 5)) 5) ) ) ;;; Création style du tableau puis création tableau (GetOrCreateTableStyle "tableau espace objet") (setq pt (getpoint "\nPlacer la tableau:") TblObj (vla-addtable msp ;************Espace objet (vlax-3d-point pt) (+ (length lst_blk1) 2);**********Nombre de lignes 6 ;**********Nombre de Colonne height ;**********Hauteur de la ligne par defaut width ;**********Largeur de la ligne par defaut ) ) (vla-put-regeneratetablesuppressed TblObj :vlax-true) (vla-SetColumnWidth TblObj 0 width1);************largeur de N° (vla-SetColumnWidth TblObj 1 width2);************largeur Marque (vla-SetColumnWidth TblObj 2 width3);************largeur nom du bloc (vla-SetColumnWidth TblObj 3 width4);************largeur Référence (vla-SetColumnWidth TblObj 4 width5);************largeur Quantités (vla-SetColumnWidth TblObj 5 width6);************largeur Image du bloc (vla-put-vertcellmargin TblObj (* 0.4 h)) (vla-put-horzcellmargin TblObj (* 0.4 h)) (mapcar '(lambda (x) (vla-setTextHeight TblObj x h)) (list acTitleRow acHeaderRow acDataRow) ) (mapcar '(lambda (x) (vla-setAlignment TblObj x 5)) (list acTitleRow acHeaderRow acDataRow) ) (vla-MergeCells TblObj 0 0 0 3) ;change 4 to 3 ;;; **************************Entête du tableau (vla-setText TblObj 0 0 "TABLEAU DE NOMENCLATURE DES BLOCS") (setq j -1 header_lsp (list "N°" "MARQUE" "NOM DES BLOCS" "REFERENCE" "QTES" "BLOCS") ) ;;;;;;;;;;;;;;;;;;;;;;REMOVE "DON VI" (repeat (length header_lsp) (vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp))) (setq row 2 i 1) (foreach tyty lst_blk1 (setq blk_name (nth 0 tyty) j -1) (mapcar '(lambda (x) (vla-setText TblObj row (setq j (1+ j)) x)) (subst "" nil (list i (nth 2 tyty) blk_name (nth 3 tyty) (nth 1 tyty))) ) ;******************************Colonne 6 (vla-SetBlockTableRecordId TblObj row 5 (GetObjectID (vla-item blks blk_name)) :vlax-true) ;******************************CENTRAGES CELLULES (vla-SetCellAlignment TblObj row 0 5) (vla-SetCellAlignment TblObj row 1 4) (vla-SetCellAlignment TblObj row 2 4) (vla-SetCellAlignment TblObj row 3 4) (vla-SetCellAlignment TblObj row 4 5) ;******************************CHANGE 3 TO 2 (setq row (1+ row) i (1+ i) ) ) (vla-put-regeneratetablesuppressed TblObj :vlax-false) (vlax-release-object TblObj) (prompt "\n(C) Facilo thanks to CHCTB & Autodesk\n")(princ) ) (princ) ;; gc:GetVisibilityState ;; Retourne l'état de visibilité d'un bloc dynamique ou nil (defun gc:GetVisibilityState (blk / state) (if (= (vla-get-IsDynamicblock blk) :vlax-true) (foreach p (vlax-invoke blk 'GetDynamicBlockProperties) (if (= (type (car (vlax-get p 'AllowedValues))) 'STR) (setq state (vlax-get p 'Value)) ) ) ) state ) ;******************fin de tabm

Suite un autre développement, j'avais décelé un "couak" dans la ligne: (command "_.CHSPACE" js_obj "" ) il faudrait essayer de tester en changeant avec ceci: (command "_.CHSPACE" js_obj "" (if (> (cdr (assoc 69 dxf_ent)) 2) "")) J'ai failli croire que c'était moi! 😅

Bonjour, Je te suggère la réponse à un vieux sujet, vois si cela pourrait faire l'affaire pour automatiser ta tâche.

Très étrange ce réseau, je ne comprend pas comment tu as pu arriver à ce résultat... Cependant j'ai trouvé ce qui ne vas pas. Si on fait la commande liste sur ton réseau on obtient ceci: Ce qui semble logique, mais si l'on DECOMPOSE ce réseau (pour retrouver les entités constituantes) et que l'on fait: On voit qu'on à affaire à un bloc anonyme fixe correspondant à ton réseau original (moins une dalle au coin haut gauche) . Le plus étrange est que ces deux retour donne le même "Maintien = 6516e", alors que logiquement il devrait être différent... Donc dans ton réseau tu as une espèce de référence circulaire, comment cela a t-il pu arriver: aucune idée...!

Salut, Tu peux essayer cette procédure. Avant de l'utiliser veiller à ce que les paramètres de la commande CORRESPROP soient bien définis. La procédure va restituer la rotation du texte après l'application de la commande CorresProp. (defun c:MyCopyProperties ( / ss_source ss_cible rot) (princ "\nSélectionner l'objet texte SOURCE") (setq ss_source (ssget "_+.:E:S" '((0 . "*TEXT")))) (cond (ss_source (princ "\nSélectionner l'objet texte CIBLE") (while (setq ss_cible (ssget "_+.:E:S" '((0 . "*TEXT")))) (setq rot (assoc 50 (entget (ssname ss_cible 0)))) (command "_.MATCHPROP" (ssname ss_source 0) (ssname ss_cible 0) "") (entmod (subst rot (assoc 50 (entget (ssname ss_cible 0))) (entget (ssname ss_cible 0)))) (princ "\nSélectionner l'objet texte CIBLE") ) ) ) (prin1) )

Bonjour, Peut être sous cette forme ? (en conservant tes paramètres de Main Levée et de motif de hachure propre à ton dessin.) (defun c:essai ( / Borne ss Suivant) (setvar "SKPOLY" 1) (setq Borne (entlast)) (command "_.SKETCH" 0.001) (while (not (zerop (getvar "CMDACTIVE"))) (command pause) ) (if (and Borne (entget Borne)) (progn (setq ss nil ss (ssadd)) (while (setq Suivant (entnext Borne)) (ssadd Suivant ss) (setq Borne Suivant) ) ss ) ) (command "_.PEDIT" "_Multiple" ss "" "_Close" "_eXit") (command "_.HATCH" "ETOILE-02" 0.2 0 ss "") )

Il n'y a pas de syntaxe tout se fait dans des fenêtres de dialogues avec des options à cocher/choisir et elles sont nombreuses... c'est là qu'on peut se sentir un peu perdu!

Ça ne me rajeuni pas, dire que mes première expériences de discussions sur le logiciel AutoCAD était sur un fil de discussion dans Outlook qui se nommait "manandmachine" piloté par Yvan Messegué (l'orthographe est de mémoire), d'ailleurs @LaurentCAMPEDELL était un intervenant très actif à l'époque. Puis est venu CadXP. Forum ou j'ai découvert des pointures et partager beaucoup d'astuces et de solutions en codage lisp : Merci à tous ces contributeurs... Je trouve qu'on était plus dans le partage que maintenant. Actuellement je trouve que le forum (et tout forums en général) sont plus en la recherche de solution clés en main. Mais cela reste que mon avis.

Pour l'avoir déjà utilisé, IrfanView 64 permet de faire du traitement par lot. Dans mon cas je l'avais utilisé pour passer du scan25 de l'IGN d'un département entier qui sont en couleur pour obtenir des images identiques en 256 niveaux de gris. La raison était que l'insertion de projets en couleur soient très visible lors de présentation. L'opération avait très bien fonctionné. Même s'il y a beaucoup d'options dans ce logiciel qui ne sont pas forcément évidentes lors d'une première utilisation, il est très efficace. Je pense que la création de vignettes est a sa portée.

Bonjour @didier Je suis entièrement d'accord avec toi! Ce que j'ai proposé est seulement un "pis aller" (j'ai bien dis que c'était un code succinct) qui peut répondre à sa demande vu les éléments disponibles dans son DWG. Ce n'est pas la panacée, mais ça peut simplifier le travail tout en sachant qu'un contrôle sera obligatoire en fin d'exécution, on ne peut faire une confiance aveugle au code proposé... Si il ne peut pas avoir d'infos supplémentaire sur ces points levés, je ne voit que cette solution bancale pour approcher à la résolution partielle du problème. Il est certain qu'un codage des points levés serait la solution la plus viable, mais j'ai l'impression que le mal est fait (j’exclue qu'un nouveau levé soit exécuté en bon et du forme sans moyenner finances). Tes explications le rendront plus pertinent pour ses prochaines demandes de travaux de levé 😉

Bonjour, Ce qui peut être envisager; c'est de se baser sur le handle de l'entité bloc pour le classer. Ce n'est pas parfait, mais dans le cercle rouge, cela à l'air de fonctionner: sauf le raccord aux chambres... Utiliser les grips pour ajouter les sommets aux chambres. Exemple succinct du code ((lambda ( / ) (setq js (ssget '((0 . "INSERT") (8 . "EDF-AR_VDC") (62 . 1) (2 . "TP_POINT"))) l nil) (cond (js (repeat (setq n (sslength js)) (setq l (cons (cdr (assoc 5 (entget (ssname js (setq n (1- n)))))) l)) ) (setq l (vl-sort l '<)) (command "_.pline") (foreach e l (command "_none" (cdr (assoc 10 (entget (handent e))))) ) (command "") ) ) ))

Si tu veux un type de ligne avec une forme (shx), je peux te proposer ceci: Tu copie-colle ce qui suit directement en ligne de commande, il va s'occuper de tout; créer le shape (.shp), le compiler (.shx) et écrire le fichier de type de ligne (.lin) et le rendre disponible dans le dessin. ((lambda ( / f_shp f_lin doc) (if (not (findfile "rond_plein.shp")) (progn (setq f_shp (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\rond_plein.shp") "w")) (write-line "*128,66,RONDPLEIN" f_shp) (write-line "2,3,10,010,1,10,(1,000),2,010,1,10,(2,000),2,010,1,10,(3,000),2,010,1,10," f_shp) (write-line "(4,000),2,010,1,10,(5,000),2,010,1,10,(6,000),2,010,1,10,(7,000),2,010,1,10," f_shp) (write-line "(8,000),2,010,1,10,(9,000),2,010,1,10,(10,000),2,3,10,0" f_shp) (close f_shp) ) ) (command "_.compile" (strcat (getvar "ROAMABLEROOTPREFIX") "support\\rond_plein.shp")) (if (not (tblsearch "STYLE" "")) (entmakex '( (0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "") (70 . 1) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 2.5) (3 . "rond_plein.shx") (4 . "") ) ) ) (entmake (list '(0 . "LTYPE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLinetypeTableRecord") '(2 . "DotsLine") '(70 . 0) '(3 . "pointillé shx . . . .") '(72 . 65) '(73 . 2) '(40 . 1.0) '(49 . 1.0) '(74 . 4) '(75 . 128) (CONS 340 (TBLOBJNAME "STYLE" "")) '(46 . 0.1) '(50 . 0.0) '(44 . 0.0) '(45 . 0.0) '(49 . 0.0) '(74 . 0) ) ) (if (not (findfile "DotsLine.lin")) (progn (setq f_lin (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\DotsLine.lin") "w")) (write-line "*DotsLine,cloture shx . . . ." f_lin) (write-line "A,1,[RONDPLEIN,rond_plein.shx,x=0,s=.1],0" f_lin) (close f_lin) ) ) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (if (and (not (vlax-for item (vla-get-linetypes doc) (if (= (strcase (vla-get-name item)) (strcase "DotsLine")) T) ) ) (vl-catch-all-error-p (vl-catch-all-apply 'vla-load (list (vla-get-Linetypes doc) "DotsLine" "DotsLine.lin") ) ) ) nil T ) (princ "\nCréation de Type de Ligne \"DotsLine\" effectué!") (prin1) ))

J'avais fixé le nom du bloc et l'attribut en DUR dans le script selon l'exemple de DWG que tu as posté. Avec ce fichier ça fonctionne, j'avais testé... Si les noms sont différents, cela explique que ça n'a rien fait. Il faut, si tu veux l'utiliser, avoir plus d'info sur les noms possibles.

Pour fabriquer ton script personnalisé, tu peux essayer ceci. Code à copier coller dans un nouveau dessin (avec aucun fichier à traiter ouvert par Autocad) (defun c:make_script ( / f_exe ShlObj Folder FldObj Out_Fld file_scr) (vl-load-com) (setq ShlObj (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 "" 0) ) (vlax-release-object ShlObj) (if Folder (progn (setq FldObj (vlax-get-property Folder 'Self) Out_Fld (vlax-get-property FldObj 'Path) ) (vlax-release-object Folder) (vlax-release-object FldObj) ) ) (setq file_scr (open (strcat Out_Fld "\\" "traiter_dossier.scr") "w")) (foreach dwg (vl-directory-files Out_Fld "*.dwg" 1) (write-line "_.open" file_scr) (write-line (strcat "\"" Out_Fld "\\" dwg "\"") file_scr) ;; ;;debut partie personnalisable ;; (write-line "((lambda ( / jsel i name)" file_scr) (write-line " (defun update_block (block_record / s_e dxf_e)" file_scr) (write-line " (if (/= (getvar \"ATTMODE\") 1) (setvar \"ATTMODE\" 1))" file_scr) (write-line " (setq s_e block_record)" file_scr) (write-line " (while (/= (cdr (assoc 0 (entget (setq s_e (entnext s_e))))) \"SEQEND\")" file_scr) (write-line " (setq dxf_e (entget s_e))" file_scr) (write-line " (if (eq (cdr (assoc 0 dxf_e)) \"ATTRIB\")" file_scr) (write-line " (if (eq (cdr (assoc 2 dxf_e)) \"PROJECTION\")" file_scr) (write-line " (entmod (setq dxf_e (subst (cons 1 \"RGF93 cc47\") (assoc 1 dxf_e) dxf_e)))" file_scr) (write-line " )" file_scr) (write-line " )" file_scr) (write-line " )" file_scr) (write-line " (entupd block_record)" file_scr) (write-line " )" file_scr) (write-line " (and" file_scr) (write-line " (setq jsel (ssget \"_X\" '((0 . \"INSERT\") (67 . 1) (8 . \"VEP CARTOUCHE\") (66 . 1) (2 . \"Format-A1\"))))" file_scr) (write-line " (repeat (setq i (sslength jsel))" file_scr) (write-line " (setq name (ssname jsel (setq i (1- i))))" file_scr) (write-line " (update_block name)" file_scr) (write-line " )" file_scr) (write-line " )" file_scr) (write-line " (princ)" file_scr) (write-line "))" file_scr) (write-line "(command \"_.saveas\" \"_LT2018\" \"\")" file_scr) ;; ;;fin partie personnalisable ;; (write-line "_.close" file_scr) ) (close file_scr) (princ (strcat "\Vous pouvez lancer le SCRIPT :" Out_Fld "\\" "traiter_dossier.scr")) (prin1) ) Tu lance alors la commande MAKE_SCRIPT Tu sélectionne ton dossier à traiter. Une fois le script créé tu lance la commande SCRIPT en sélectionnant le script "traiter_dossier.scr" dans le dossier précédemment sélectionné.