lecrabe

Hello MERCI Quentin pour cette Info ... Je suis prudent : je n ai pas encore installe MAP 2024 ! https://www.autodesk.com/support/technical/article/caas/tsarticles/ts/4kEliTRRBFrX6PvcWcYwTS.html?mktvar002=45103257008|EML Qu on se le dise ... La Sante, Bye, lecrabe

Hello A priori pour ces problemes de surfaces, zones, etc, ACAD Archi est "plus mieux" que REVIT ! Steven est le Grand Maitre de AutoCAD Archi !! Bye, lecrabe

Hello WAOUH MERCI pour les explications ... Car la presence de Covadis me faisait "douter" ! Bye, lecrabe

Hello @rebcao Le message #18 de CE sujet devrait te plaire !? https://forums.autodesk.com/t5/autocad-forum/autocad-2024-is-here-what-s-your-thoughts/td-p/11854067 Bon dimanche, Bye, lecrabe

Hello @bonuscad Bravo www.drcauto.com Bye, lecrabe

Hello @rebcao SVP Cool / Zen, nous savons tous combien tu t es investis comme un "fou" sur AutoCAD LT depuis longtemps ! SVP ne joues pas a Don Quichotte, il ne sert a rien de se battre contre des moulins a vent (Autodesk) Tu connais tres bien AutoCAD , AutoCAD LT et je sais que tu fais aussi du Lisp et de l Inventor ... Tu sais bien que Malheureusement / Heureusement il faut suivre Autodesk ! Bonne journee, Bon WE, La Sante, Bye, lecrabe

Hello Alors si je me souviens bien, il me semble avoir vu chez Autodesk Suisse en 1992/1993 une version ALPHA de AutoCAD LT avec du Lisp !? La gestation a ete tres longue ! Bon WE Fabcad, Bye, lecrabe

Hello NON pour moi, on ne touche pas aux Forums Lisp actuels ! Bye, lecrabe

Hello 1) Je pense que l on peut renommer le forum "ACAD 2020-2023" en "ACAD 2020-2024" Car comme d habitude, il n y a RIEN de revolutionnaire dans AutoCAD 2024 !? 2) PAR CONTRE, ACAD LT 2024 Windows apporte le Lisp et VLisp Et CA c une REVOLUTION ... Donc cela merite un Nouveau Forum ! 3) Qu en pensez vous Collegues AutoCADiens ?? Bye, lecrabe

Hello @Fraid A priori aucune Fonction DBX ! Voir mon message avec le probleme de la routine ImportUCS ... Autre truc non supporte : (setq myxl (vlax-get-object "Excel.Application")) (setq myxl (vlax-get-or-create-object "excel.Application")) Bye, lecrabe

Hello RAPPEL : les Lisps "simples" sont censes TOUS fonctionner ! Et la plupart des routines VLisp vont aussi fonctionner SAUF ... Voir plus loin ... -- Pas de commande "3DFACE" donc impossible de construire un MNT 3D en 3DFACEs avec une routine qui partirait de Points XYZ !! MAIS on dispose de la commande : POLY3D / _3DPOLY ---- Infos interessantes de Vladimir Michl ---- https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/whats-your-thoughts-on-autolisp-in-autocad-lt-2024/td-p/11858520 Yes, .FAS and .VLX do work (but you cannot compile them in LT). Even the .bundle mechanism does work. You just need to add "ACADLT" to the RuntimeRequirements section in the manifest XML file (and this is not documented AFAIK). Vladimir Michl, www.arkance-systems.cz - www.cadforum.cz You also can't use Express Tools commands or its libraries or "acet-" functions in LT. Of course, you can't call VBA or ARX or .NET functions either. A surprisingly low number of limitations of AutoLISP in LT. So most existing LISP routines will work. And I also like the silent handling of unsupported calls/errors. Alas, some kind of "debug mode" might be useful to track the not executed functions. My list of limitations (found so far): https://www.cadforum.cz/en/limitations-of-the-lisp-language-autolisp-visuallisp-autocad-lt-tip13683 Vladimir Michl, www.arkance-systems.cz - www.cadforum.cz -------- ATTENTION : Routines ne fonctionnant pas ou Fonctions / Commandes NOK -------- -- Commande 3DFACE non supportee -- StripMText : semble ne pas fonctionner -- ImportUCS : ne fonctionne pas - Car Fonction : (OpenDrawingDBX filename) Donc impossible d intervenir sur des DWGs "exterieurs" ou d en recuperer des Infos !! -- Autre truc non supporte : (setq myxl (vlax-get-object "Excel.Application")) (setq myxl (vlax-get-or-create-object "excel.Application")) -------- Alors Merci aux Multiples Testeurs -------- -- COUNT de Lee Mac. On peut donc faire des tableaux de quantitatif avec l'aperçu des blocs sur LT -- BLOCKCOUNT de Lee Mac qui permet de faire comme BCOUNT mais qu'on peut ensuite extraire en TXT / CSV -- CND qui permet de quantifier les Blocs dynamiques avec leurs Etats de visibilités ou leurs dimensions (sur l Ecran texte) -- DETACALL qui permet de détacher toutes les XREFs d'un fichier en même temps -- JAV de Patrick35 pour "nettoyer / purger" les DWGs -------- Par votre serviteur -------- -- I0__I1__X0__X1 de Gilles : Decharger / Recharger toutes les Images / XREFs DWGs -- ALTXT et ALBLOC pour aligner les Blocs et Text/MText par rapport a un segment = OK -- BROT__BECH (Rotation / Echelle de N Blocs relativement a leur point de base) = OK -- TXROT__TXECH (Idem pour les Texts / MTexts) = OK -- POLYAREA et POLYLENGTH de Gilles qui generent un champ dynamique sur N Entites selectionnees = OK -- INCR vs1.20 de Gilles pour Incrementer Textes, Attributs, Inserer Bloc avec Incrementation, etc = OK -- RB_Zero_ByBlock (ou ByLayer) de Patrick35 = OK (Remettre le graphique des Blocs sur Calque ZERO + ByBlock ou ByLayer x 3) -- TRI de Patrick35 qui "eclate" la selection sur N Calques en fonction du type d Entite = OK -- E2LBC de "dlanorh" qui "eclate" la selection sur N Calques en fonction de la couleur (0-256, TrueColor, Pantone, Ral, etc) = OK -- DYN_READ_XDATA de Bonuscad pour voir en Infobulle les XDATAs = OK -- MODIF_XDATA de Bonuscad pour modifier le contenu des XDATAs = OK -- XDA de Gilles pour voir (en case de dialogue) le contenu des XDATAs = OK -- COPY_XD de Gilles pour copier les XDATAs (IDEM le "Pinceau") = OK -- XDLIST d Autodesk pour afficher sur Ecran texte les XDATAs = OK MAIS la routine "XDATA" d Autodesk pour creer des XDATAs ne marche pas car appel a la fonction "ACET-STR-FORMAT" des Express/Bonus Tools -- AVX_DVX et BISS_MED de Gilles = OK -- ListBlock de Gilles (Idem BLOCKCOUNT de Lee-Mac) = OK -- TLEN_PL_LAY et TSUR_PL_LAY : Total des Longueurs / Surfaces par Calque de Gilles (Resultat sur Ecran texte) = OK -- SEGLEN : Ecris un texte montrant la longueur des Segments / Arcs de N Polylignes de Gilles = OK -- EL2PL et PELL de Gilles pour creer Polyligne depuis Ellipse et aussi Creer une Ellipse directement en Polyligne = OK -- Stretch_To_Nearest_Block (by hak_vz) : Deplace les Vertex des Polylignes 2D/3D pour accrocher le Point d Insertion d un Bloc proche = OK -- TABSORT de Lee-Mac (pour re-organiser les Presentations / Layouts) = OK -- Count_Object_Per_Layer de "marko_ribar" (Resultat sur Ecran texte - Idem la routine CND) = OK Bye, lecrabe

Bonjour J ai cree CE sujet pour que l on y repertorie tous les Lisps / VLisps qui fonctionnent sur AutoCAD LT 2024 Windows Cela va faire "mal" aux Licences "classiques" ACAD 20xx Toolset mais aussi a ZWCAD, BricsCAD, GStarCAD, etc ... La Sante, Bye, lecrabe

Hello ============================================================ ==== RECTIFICATIF : de tres nombreuses fonctions VLisp vla sont PRESENTES !! ==== DONC la majorite des Routines VLisp doivent fonctionner !! ============================================================ Bye, lecrabe

Hello @Olivier Eckmann & @didier OUI Didier est un "jeune" homme souple, agile, multi-taches ! Bonne fin de semaine, Bye, lecrabe

Hello Peut etre : STARTUP = 3 !? Bye, lecrabe

Hello Je ne vois pas bien ! 1) Si tu fais un REGEN, est ce OK ? 2) As tu bien : DIMASSOC = 2 ? 3) Est ce que tu corriges le probleme avec la commande : COTREASSOCIER ? Bye, lecrabe

Hello OUI la R13 avec l ARX v1.0 etait la version la plus buggee d AutoCAD ! Mais elle a apporte tant de choses ... Souvenirs indelebiles de la R13c1 , c2 , c3 , c4 , c4a ... https://forums.autodesk.com/t5/annonces-de-la-communaute/autodesk-a-40-ans/td-p/10877228/page/2 Vous pouvez telecharger sur mon message No 23 les pages importantes des OOPS Magazines (1988 a 1955 - Magazines ecris par votre serviteur) avec toutes les nouveautes de AutoCAD R9 R10 R11 R12 R13 Apres les OOPS Magazines qui se sont arretes en 1995, j ai beaucoup contribue a AutoCAD Magazine ... Bonne soiree, Bye, lecrabe

Hello Je suis PATIENT ! Confucius a dit : restes assis au bord de la riviere, un jour tu verras passer le cadavre de ton ennemi !? Bye, lecrabe

Hello En effet j ai falli inclure AutoCAD R14.01 sous Win NT 4.0 Une excellente version ! Bye, lecrabe

Hello Christian Je propose : - Le retour a la planche a dessins - ACAD 2.5/2.6 sous DOS 3.X avec carte Hercules (noir et vert) en 720 x 348 - ACAD 2004 sous Win 98 - ACAD 2008 sous Win 2000 - ACAD 2014 sous Win XP Votre choix ? Bye, lecrabe

Hello @KevM OUI SVP tu dois etre dans un Style de texte avec Hauteur par defaut = ZERO Et si tu veux une hauteur specifique, tu changes la variable System TEXTSIZE avant d executer la routine "AddZCoordText" ! MERCI @didier pour le boulot ! La Sante, Bye, lecrabe

Hello @Vincent P. , @Fraid , @didier , @thierry.garré Si ton DWG a le BON Systeme de Projection , tu peux l afficher dans un champ dynamique en allant chercher la variable System : CGEOCS Resultat : %<\AcVar cgeocs>% Bye, lecrabe PS: Post corrige, merci Didier !

Hello ---- Nouveautes AutoCAD 2024 et AutoCAD LT 2024 en Francais ---- https://help.autodesk.com/view/ACD/2024/FRA/ https://help.autodesk.com/view/ACDLT/2024/FRA/?guid=GUID-86C522B8-9D44-43F5-B1E7-FC4BECAEBDCE Sinon qq Infos AutoCAD 2024 importantes : 1) Nous restons avec le format DWG2018 ! 2) La Nouveaute : c est l apparition de l AutoLisp (Pas le VLisp) sur AutoCAD LT 2024 Windows (et non pas sur la version Mac) En fait c pour contrer ZWCAD et BricsCAD ... 3) https://www.autodesk.com/campaigns/apac/webinars/discover-autocad-2024-apr13 Bye, lecrabe ============================================================ ==== RECTIFICATIF : de tres nombreuses fonctions VLisp vla sont PRESENTES !! ==== DONC la majorite des Routines VLisp doivent fonctionner !! ============================================================

Hello @JVC Voici une autre routine "EL2PL" et "PELL" de notre grand Maitre Gilles -- "EL2PL" convertit en Polyligne une Ellipse ou Arc elliptique ATTENTION : EL2PL ne traite pas les ODs de MAP/CIVIL NI les XDATAs d'AutoCAD ! NOTE : cela serait SYMPA de l ameliorer a "ce niveau" !? IDEM ce que fait la routine "ArcToSegMAP" ... -- "PELL" dessine a la volee une Ellipse ou Arc elliptique ... ( J adore PELL ! ) Bye, lecrabe ;; ;; http://cadxp.com/index.php?/topic/25364-ellipses-polylignes-2/page__pid__204830 ;; ;; J'ai trouvé, ici : http://www.paris-lavillette.archi.fr/d1301/cours_web_d1301/cours-lpu/courbes.pdf ;; la méthode utilisée par AutoCAD pour les approximations d'ellipses ;; en polylignes (succession d'arcs) quand PELLIPSE = 1 ;; ;; Voilà donc une nouvelle version (plus rapide) des commandes : ;; EL2PL : pour convertir une sélection d'ellipses ou arcs elliptiques en polylignes ;; PELL : pour dessiner "à la volée" des approximations d'ellipses ou d'arcs elliptiques(polylignes) ;; ;; Ces commandes appellent la routine EllipseToPolyline qui implémente la méthode sus-citée. ;; Les objets source sont supprimés ou conservés en fonction de la valeur de la variable DELOBJ. ;; La routine fonctionne quel que soit le plan de construction de l'ellipse. ;; La polyligne est créée sur le calque courant avec les propriétés courantes. ;; Pour une compatibilité avec les version < 2007, j'ai évité d'utiliser vla-put-Coordinates. ;; ;; !!! ATTENTION : les ODs de MAP/CIVIL et/ou les XDATAs d'AutOCAD ne sont pas conserves !!! ;; ;; ;; EllipseToPolyline (gile) ;; Retourne une polyline (vla-object) qui est une approximation de l'ellipse (ou de l'arc elliptique) ;; L'ellipse source est conservée ou supprimée en fonction de la valeur de DELOBJ ;; ;; Argument : une ellipse (vla-object) ;; (defun EllipseToPolyline (el / doc cl norm cen elv pt0 pt1 pt2 pt3 pt4 ac0 ac4 a04 a02 a24 bsc1 bsc2 bsc3 bsc4 plst blst spt spa fspa srat ept epa fepa erat n ) (vl-load-com) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) spc (if (= 1 (getvar 'cvport)) (vla-get-PaperSpace doc) (vla-get-ModelSpace doc) ) cl (and (= (vla-get-StartAngle el) 0.0) (= (vla-get-EndAngle el) (* 2 pi)) ) norm (vlax-get el 'Normal) cen (trans (vlax-get el 'Center) 0 norm) elv (caddr cen) cen (3dTo2dPt cen) pt0 (mapcar '+ (trans (vlax-get el 'MajorAxis) 0 norm) cen) ac0 (angle cen pt0) pt4 (mapcar '+ cen (trans (vlax-get el 'MinorAxis) 0 norm)) pt2 (3dTo2dPt (trans (vlax-curve-getPointAtparam el (/ pi 4.)) 0 norm)) ac4 (angle cen pt4) a04 (angle pt0 pt4) a02 (angle pt0 pt2) a24 (angle pt2 pt4) bsc1 (/ (ang<2pi (- a02 ac4)) 2.) bsc2 (/ (ang<2pi (- a04 a02)) 2.) bsc3 (/ (ang<2pi (- a24 a04)) 2.) bsc4 (/ (ang<2pi (- (+ ac0 pi) a24)) 2.) pt1 (inters pt0 (polar pt0 (+ ac0 (/ pi 2.) bsc1) 1.) pt2 (polar pt2 (+ a02 bsc2) 1.) nil ) pt3 (inters pt2 (polar pt2 (+ a04 bsc3) 1.) pt4 (polar pt4 (+ a24 bsc4) 1.) nil ) plst (list pt4 pt3 pt2 pt1 pt0) blst (mapcar '(lambda (B) (tan (/ b 2.))) (list bsc4 bsc3 bsc2 bsc1) ) ) (repeat 2 (foreach b blst (setq blst (cons b blst)) ) ) (foreach p (cdr plst) (setq ang (angle cen p) plst (cons (polar cen (+ ang (* 2 (- ac4 ang))) (distance cen p)) plst ) ) ) (foreach p (cdr plst) (setq ang (angle cen p) plst (cons (polar cen (+ ang (* 2 (- ac0 ang))) (distance cen p)) plst ) ) ) (setq pl (vlax-invoke spc 'AddLightWeightPolyline (apply 'append (setq plst (reverse (if cl (cdr plst) plst ) ) ) ) ) ) (vlax-put pl 'Normal norm) (vla-put-Elevation pl elv) (mapcar '(lambda (i v) (vla-SetBulge pl i v)) '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) blst ) (if cl (vla-put-Closed pl :vlax-true) (progn (setq spt (vlax-curve-getClosestPointTo pl (vlax-get el 'Startpoint)) spa (vlax-curve-getParamAtPoint pl spt) fspa (fix spa) ept (vlax-curve-getClosestPointTo pl (vlax-get el 'Endpoint)) epa (vlax-curve-getParamAtPoint pl ept) fepa (fix epa) n 0 ) (cond ((equal spt (trans pt0 norm 0) 1e-9) (if (= epa fepa) (setq plst (sublist plst 0 (1+ fepa)) blst (sublist blst 0 (1+ fepa)) ) (setq erat (/ (- (vlax-curve-getDistAtParam pl epa) (vlax-curve-getDistAtParam pl fepa) ) (- (vlax-curve-getDistAtParam pl (1+ fepa)) (vlax-curve-getDistAtParam pl fepa) ) ) plst (append (sublist plst 0 (1+ fepa)) (list (3dTo2dPt (trans ept 0 norm))) ) blst (append (sublist blst 0 (1+ fepa)) (list (k*bulge (nth fepa blst) erat)) ) ) ) ) ((equal ept (trans pt0 norm 0) 1e-9) (if (= spa fspa) (setq plst (sublist plst fspa nil) blst (sublist blst fspa nil) ) (setq srat (/ (- (vlax-curve-getDistAtParam pl (1+ fspa)) (vlax-curve-getDistAtParam pl spa) ) (- (vlax-curve-getDistAtParam pl (1+ fspa)) (vlax-curve-getDistAtParam pl fspa) ) ) plst (cons (3dTo2dPt (trans spt 0 norm)) (sublist plst (1+ fspa) nil) ) blst (cons (k*bulge (nth fspa blst) srat) (sublist blst (1+ fspa) nil) ) ) ) ) (T (setq srat (/ (- (vlax-curve-getDistAtParam pl (1+ fspa)) (vlax-curve-getDistAtParam pl spa) ) (- (vlax-curve-getDistAtParam pl (1+ fspa)) (vlax-curve-getDistAtParam pl fspa) ) ) erat (/ (- (vlax-curve-getDistAtParam pl epa) (vlax-curve-getDistAtParam pl fepa) ) (- (vlax-curve-getDistAtParam pl (1+ fepa)) (vlax-curve-getDistAtParam pl fepa) ) ) ) (if (< epa spa) (setq plst (append (if (= spa fspa) (sublist plst fspa nil) (cons (3dTo2dPt (trans spt 0 norm)) (sublist plst (1+ fspa) nil) ) ) (cdr (sublist plst 0 (1+ fepa))) (if (/= epa fepa) (list (3dTo2dPt (trans ept 0 norm))) ) ) blst (append (if (= spa fspa) (sublist blst fspa nil) (cons (k*bulge (nth fspa blst) srat) (sublist blst (1+ fspa) nil) ) ) (sublist blst 0 fepa) (if (= epa fepa) (list (nth fepa blst)) (list (k*bulge (nth fepa blst) erat)) ) ) ) (setq plst (append (if (= spa fspa) (sublist plst fspa (1+ (- fepa fspa))) (cons (3dTo2dPt (trans spt 0 norm)) (sublist plst (1+ fspa) (- fepa fspa)) ) ) (list (3dTo2dPt (trans ept 0 norm))) ) blst (append (if (= spa fspa) (sublist blst fspa (- fepa fspa)) (cons (k*bulge (nth fspa blst) srat) (sublist blst (1+ fspa) (- fepa fspa)) ) ) (if (= epa fepa) (list (nth fepa blst)) (list (k*bulge (nth fepa blst) erat)) ) ) ) ) ) ) (vla-delete pl) (setq pl (vlax-invoke spc 'AddLightWeightPolyline (apply 'append plst))) (vlax-put pl 'Normal norm) (vla-put-Elevation pl elv) (foreach b blst (vla-SetBulge pl n B) (setq n (1+ n)) ) ) ) (or (zerop (getvar 'delobj)) (vla-delete el)) pl ) ;; Ang<2pi ;; Retourne l'angle, à 2*k*pi près, compris entre 0 et 2*pi (defun ang<2pi (ang) (if (and (<= 0 ang) (< ang (* 2 pi))) ang (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi))) ) ) ;; 3dTo2dPt ;; Retourne le point 2d (x y) d'un point 3d (x y z) (defun 3dTo2dPt (pt) (list (car pt) (cadr pt))) ;; Tan ;; Retourne la tangent de l'angle (defun tan (a) (/ (sin a) (cos a))) ;;; SUBLIST Retourne une sous-liste ;;; ;;; Arguments ;;; lst : une liste ;;; start : l'index de départ de la sous liste (premier élément = 0) ;;; leng : la longueur (nombre d'éléments) de la sous-liste (ou nil) (defun sublist (lst start leng / n r) (if (or (not leng) (< (- (length lst) start) leng)) (setq leng (- (length lst) start)) ) (setq n (+ start leng)) (while (< start n) (setq r (cons (nth (setq n (1- n)) lst) r)) ) ) ;; K*BULGE ;; Retourne le bulge proportionnel au bulge de référence ;; Arguments : ;; b : le bulge ;; k : le rapport de proportion (entre les angles ou les longueurs d'arcs) (defun k*bulge (b k / a) (setq a (atan B)) (/ (sin (* k a)) (cos (* k a))) ) ;; ;; EL2PL (GC) ;; Convertit ellipses et arcs elliptiques en polylignes ;; Les objets source sont conservés si la variable DELOBJ = 0, ;; supprimés sinon. ;; (defun c:el2pl (/ *error* fra acdoc ss) (vl-load-com) (defun *error* (msg) (if (and (/= msg "Fonction annulée") (/= msg "Function cancelled") ) (princ (strcat (if (= "FRA" (getvar 'locale)) "\nErreur: " "\Error: " ) msg ) ) ) (vla-endUndoMark acdoc) (princ) ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (if (ssget '((0 . "ELLIPSE"))) (progn (vla-StartUndoMark acdoc) (vlax-for e (setq ss (vla-get-ActiveSelectionSet acdoc)) (EllipseToPolyline e) ) (vla-delete ss) (vla-EndUndoMark acdoc) ) ) (princ) ) ;; ;; PELL (GC) ;; Dessine "à la volée" une approximation d'ellipse ou arc elliptique (polyligne) ;; (defun c:pell (/ *error* ec pe do old ent) (vl-load-com) (defun *error* (msg) (if (and msg (/= msg "Fonction annulée") (/= msg "Function cancelled") ) (princ (strcat (if (= "FRA" (getvar 'locale)) "\nErreur: " "\Error: " ) msg ) ) ) (setvar 'cmdecho ec) (setvar 'pellipse pe) (setvar 'delobj do) (princ) ) (setq ec (getvar 'cmdecho) pe (getvar 'pellipse) do (getvar 'delobj) old (entlast) ) (setvar 'cmdecho 1) (setvar 'pellipse 0) (command "_.ellipse") (while (/= 0 (getvar "cmdactive")) (command pause) ) (if (not (eq old (setq ent (entlast)))) (progn (setvar 'delobj 1) (EllipseToPolyline (vlax-ename->vla-object ent)) ) ) (*error* nil) )

Hello 1) CLIC sur une SPline , Bouton droit , Convertir en Polyligne est une Nouveaute d'AutoCAD 2010 ! 2) Sinon apres pour convertir une Polyligne 2D contenant des Arcs, ou un Arc ou un Cercle en Polyligne 2D avec N segments en CONSERVANT les eventuels ODs (Object Data de MAP /CIVIL) et/ou eventuels XDATAs d'AutoCAD, il faut la superbe routine "ArcToSegMAP" de notre Grand Maitre Gilles ci apres ... Pour MAP et/ou CIVIL : SVP ne pas oublier de charger AVANT la fameuse routine COPY_OD.lsp ! La Sante, Bonne semaine, Bye, lecrabe ;;; ;;; ARC2SEGMAP par GC (pour Patrice B.) - 2009/03/06 - Special pour MAP & CIVIL ;;; ;;; Transforme les Arcs, Cercles et PolyArcs en Polylignes constituees de segments droits ;;; ;;; Les XDATAs sont copiees dans les nouveaux objets ;;; ;;; Ainsi que les donnees d'objet (OD) de MAP/CIVIL SI ET SEULEMENT SI ;;; !!!!!! "COPY_OD.lsp" est PREALABLEMENT CHARGE !!!!!! ;;; (vl-load-com) (defun c:Arc2SegMAP (/ arc2pol pol2pol seg del org ss n ent elst) ;; Retourne la liste dxf de la polyligne (d'après un arc ou un cercle) (defun arc2pol (elst seg org / closed alpha delta cen elv rad lay nlst) (and (= (cdr (assoc 0 elst)) "CIRCLE") (setq closed T)) (setq alpha (if closed (* pi 2) (cdr (assoc 51 elst)) ) delta (if closed (/ alpha seg) (/ (ang<2pi (- alpha (cdr (assoc 50 elst)))) seg) ) cen (cdr (assoc 10 elst)) elv (caddr cen) cen (list (car cen) (cadr cen)) rad (cdr (assoc 40 elst)) lay (if org (assoc 8 elst) (cons 8 (getvar "CLAYER")) ) nlst (vl-remove-if-not (function (lambda (x) (member (car x) '(210 -3)))) elst ) nlst (cons (cons 10 (polar cen alpha rad)) nlst) ) (repeat (if closed (1- seg) seg ) (setq nlst (cons (cons 10 (polar cen (setq alpha (- alpha delta)) rad) ) nlst ) ) ) (setq nlst (cons '(0 . "LWPOLYLINE") (cons '(100 . "AcDbEntity") (cons (cons 410 (getvar "CTAB")) (cons lay (cons '(100 . "AcDbPolyline") (cons (cons 90 (if closed seg (1+ seg) ) ) (cons (cons 70 (if closed 1 0 ) ) (cons (cons 38 elv) nlst) ) ) ) ) ) ) ) ) ) ;; Retourne la liste dxf de la polyligne modifiee (d'apres une polyligne) (defun pol2pol (elst seg org / cnt closed nlst p0 p1 p2 bu larg inc bdata delta cen rad alpha n ) (setq closed (logand 1 (cdr (assoc 70 elst))) cnt 0 ) (and (= closed 1) (setq p0 (cdr (assoc 10 elst)))) (while elst (if (= (caar elst) 10) (progn (setq p1 (cdar elst) p2 (cdr (assoc 10 (cdr elst))) bu (cdr (assoc 42 elst)) ) (if (or (= 0 bu) (and (zerop closed) (null p2)) ) (setq nlst (cons (cadddr elst) (cons (caddr elst) (cons (cadr elst) (cons (car elst) nlst) ) ) ) elst (cddddr elst) ) (progn (and (not p2) (= closed 1) (setq p2 p0)) (setq larg (cdr (assoc 40 elst)) inc (/ (- (cdr (assoc 41 elst)) larg) seg) bdata (BulgeData bu p1 p2) delta (/ (car bdata) seg) rad (abs (cadr bdata)) cen (caddr bdata) alpha (angle cen p1) n 0 cnt (+ cnt seg -1) ) (while (< n seg) (setq nlst (cons (cons 10 (polar cen (+ alpha (* delta n)) rad ) ) nlst ) nlst (cons (cons 40 larg) nlst) nlst (cons (cons 41 (setq larg (+ larg inc))) nlst) nlst (cons '(42 . 0.0) nlst) n (1+ n) ) ) (setq elst (cddddr elst)) ) ) ) (setq nlst (cons (car elst) nlst) elst (cdr elst) ) ) ) (or org (setq nlst (subst (cons 8 (getvar "CLAYER")) (assoc 8 nlst) nlst)) ) ((lambda (dxf90) (subst (cons 90 (+ (cdr dxf90) cnt)) dxf90 (reverse (subst '(42 . 0.0) (assoc 42 nlst) nlst)) ) ) (assoc 90 nlst) ) ) ;; Fonction principale (or (getenv "SegmentsNumberPerCircle") (setenv "SegmentsNumberPerCircle" "64") ) (initget 6) (if (setq seg (getint (strcat "\nNombre de segments par arc <" (getenv "SegmentsNumberPerCircle") ">: " ) ) ) (setenv "SegmentsNumberPerCircle" (itoa seg)) (setq seg (atoi (getenv "SegmentsNumberPerCircle"))) ) (initget "Oui Non") (if (= "Oui" (getkword "\nEffacer les objets source [Oui/Non] ? <N>: ") ) (setq del T) ) (initget "Courant Origine") (if (= "Origine" (getkword "\nCalque des nouveaux objets [Courant/Origine] ? <C>: " ) ) (setq org T) ) (prompt "\nSelectionner les objets a traiter ou <tous>." ) (and (or (setq ss (ssget '((0 . "ARC,CIRCLE,LWPOLYLINE")))) (setq ss (ssget "_X" '((0 . "ARC,CIRCLE,LWPOLYLINE")))) ) (setq n 0) (while (setq ent (ssname ss n)) (setq elst (entget ent '("*"))) (if (= (cdr (assoc 0 elst)) "LWPOLYLINE") (if del (entmod (pol2pol elst seg org)) (progn (entmake (pol2pol elst seg org)) (and ade_odgettables ade_odrecordqty ade_oddelrecord ade_odtabledefn ade_odgetfield ade_odaddrecord copy_data (copy_data ent (entlast) nil) ) ) ) (progn (entmake (arc2pol elst seg org)) (and ade_odgettables ade_odrecordqty ade_oddelrecord ade_odtabledefn ade_odgetfield ade_odaddrecord copy_data (copy_data ent (entlast) nil) ) (and del (entdel ent)) ) ) (setq n (1+ n)) ) ) (princ) ) ;; BulgeData ;; Retourne les données d'un polyarc (angle rayon centre) (defun BulgeData (bu p1 p2 / alpha rad cen) (setq alpha (* 2 (atan bu)) rad (/ (distance p1 p2) (* 2 (sin alpha)) ) cen (polar p1 (+ (angle p1 p2) (- (/ pi 2) alpha)) rad ) ) (list (* alpha 2.0) rad cen) ) ;;; Ang<2pi ;;; Retourne l'angle, à 2*k*pi près, compris entre 0 et 2*pi (defun ang<2pi (ang) (if (and (<= 0 ang) (< ang (* 2 pi))) ang (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi))) ) )