sergeluc

Bonjour bryce, j'utilise la 2011 et je n'ai pas trouvé de lisp équivalant sur le net,c'est pourquoi je voulais faire évoluer ces routines .j'ai bien essayé mais sans résultant convaincant ,pour l'instant.La sélection multiple par fenetre des LWPOLYLINES me pose des problèmes . merci pour ta réponse

bonjour , Je cherche à reconstruire des entités coupées de meme type "lignes polylignes ou arcs" depuis une sélection par fenetre.Les anciennes entités (coplanaires) sont supprimées et remplacées par une nouvelle . Merci d'avance pour toute aide Je joins pour exemple cette routine qui fonctionne mais par sélection de deux entités . Ce lisp n'est pas de moi. (defun c:REC-exct ( / ENTS1 ENTG1 EL ENTS2 ENTG2) (setq CL (getvar "CLAYER")) (setvar "CMDECHO" 0) (setq ENTS1 (car (entsel "\nPremiere entite"))) (setq ENTG1 (entget ENTS1)) (setq EL (cdr (assoc 8 ENTG1))) (setq ENTS2 (car (entsel "\nDeuxieme entite"))) (setq ENTG2 (entget ENTS2)) (cond ((and (= (cdr (assoc 0 ENTG1)) "LINE") (= (cdr (assoc 0 ENTG2)) "LINE") ) ;_ Fin de and (progn (setq P1 (cdr (assoc 10 ENTG1)) P2 (cdr (assoc 11 ENTG1)) P3 (cdr (assoc 10 ENTG2)) P4 (cdr (assoc 11 ENTG2)) ) ;_ Fin de setq (command "_LAYER" "_S" EL "") (entdel ENTS1) (entdel ENTS2) (if (> (distance P1 P3) (distance P1 P4)) (setq P5 P1 P6 P3 ) ;_ Fin de setq (setq P5 P1 P6 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P2 P3) (distance P2 P4)) (setq P7 P2 P8 P3 ) ;_ Fin de setq (setq P7 P2 P8 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P5 P6) (distance P7 P8)) (command "_LINE" P5 P6 "") (command "_LINE" P7 P8 "") ) ;_ Fin de if (command "_LAYER" "_S" CL "") (setvar "CMDECHO" 1) ) ;_ Fin de progn ) ;_ Fin de 1er cond ((and (= (cdr (assoc 0 ENTG1)) "POLYLINE") (= (cdr (assoc 0 ENTG2)) "POLYLINE") ) ;_ Fin de and (progn (setq PW (cdr (assoc 40 ENTG1))) (command "_EXPLODE" ENTS1) (setq ENTS1 (entlast)) (command "_EXPLODE" ENTS2) (setq ENTS2 (entlast)) (setq ENTG1 (entget ENTS1)) (setq ENTG2 (entget ENTS2)) (setq P1 (cdr (assoc 10 ENTG1)) P2 (cdr (assoc 11 ENTG1)) P3 (cdr (assoc 10 ENTG2)) P4 (cdr (assoc 11 ENTG2)) EL (cdr (assoc 8 ENTG1)) ) ;_ Fin de setq (entdel ENTS1) (entdel ENTS2) (command "_LAYER" "_S" EL "") (if (> (distance P1 P3) (distance P1 P4)) (setq P5 P1 P6 P3 ) ;_ Fin de setq (setq P5 P1 P6 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P2 P3) (distance P2 P4)) (setq P7 P2 P8 P3 ) ;_ Fin de setq (setq P7 P2 P8 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P5 P6) (distance P7 P8)) (command "_PLINE" P5 "_W" PW "" P6 "") (command "_PLINE" P7 "_W" PW "" P8 "") ) ;_ Fin de if (command "_LAYER" "_S" CL "") (setvar "CMDECHO" 1) ) ;_ Fin de progn ) ;_ Fin de 2eme cond ((and (= (cdr (assoc 0 ENTG1)) "LWPOLYLINE") (= (cdr (assoc 0 ENTG2)) "LWPOLYLINE") ) ;_ Fin de and (progn (setq PW (cdr (assoc 40 ENTG1))) (command "_EXPLODE" ENTS1) (setq ENTS1 (entlast)) (command "_EXPLODE" ENTS2) (setq ENTS2 (entlast)) (setq ENTG1 (entget ENTS1)) (setq ENTG2 (entget ENTS2)) (setq P1 (cdr (assoc 10 ENTG1)) P2 (cdr (assoc 11 ENTG1)) P3 (cdr (assoc 10 ENTG2)) P4 (cdr (assoc 11 ENTG2)) EL (cdr (assoc 8 ENTG1)) ) ;_ Fin de setq (entdel ENTS1) (entdel ENTS2) (command "_LAYER" "_S" EL "") (if (> (distance P1 P3) (distance P1 P4)) (setq P5 P1 P6 P3 ) ;_ Fin de setq (setq P5 P1 P6 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P2 P3) (distance P2 P4)) (setq P7 P2 P8 P3 ) ;_ Fin de setq (setq P7 P2 P8 P4 ) ;_ Fin de setq ) ;_ Fin de if (if (> (distance P5 P6) (distance P7 P8)) (command "_PLINE" P5 "_W" PW "" P6 "") (command "_PLINE" P7 "_W" PW "" P8 "") ) ;_ Fin de if (command "_LAYER" "_S" CL "") (setvar "CMDECHO" 1) ) ;_ Fin de progn ) ;_ Fin de 3eme cond ((and (= (cdr (assoc 0 ENTG1)) "ARC") (= (cdr (assoc 0 ENTG2)) "ARC") ) ;_ Fin de and (progn (setq CA (strcase (getstring "\nChanger arcs en cercle? Y or <N> ")) ) ;_ Fin de setq (if (= CA "Y") (progn (setq P1 (cdr (assoc 10 ENTG1)) RA (cdr (assoc 40 ENTG1)) ) ;_ Fin de setq (command "_LAYER" "_S" EL "") (entdel ENTS1) (entdel ENTS2) (command "_CIRCLE" P1 RA) (command "_LAYER" "_S" CL "") ) ;_ Fin de progn (progn (setq 150X (car (polar (cdr (assoc 10 ENTG1)) (cdr (assoc 50 ENTG1)) (cdr (assoc 40 ENTG1)) ) ;_ Fin de polar ) ;_ Fin de car 150Y (cadr (polar (cdr (assoc 10 ENTG1)) (cdr (assoc 50 ENTG1)) (cdr (assoc 40 ENTG1)) ) ;_ Fin de polar ) ;_ Fin de cadr 151X (car (polar (cdr (assoc 10 ENTG1)) (cdr (assoc 51 ENTG1)) (cdr (assoc 40 ENTG1)) ) ;_ Fin de polar ) ;_ Fin de car 151Y (cadr (polar (cdr (assoc 10 ENTG1)) (cdr (assoc 51 ENTG1)) (cdr (assoc 40 ENTG1)) ) ;_ Fin de polar ) ;_ Fin de cadr 250X (car (polar (cdr (assoc 10 ENTG2)) (cdr (assoc 50 ENTG2)) (cdr (assoc 40 ENTG2)) ) ;_ Fin de polar ) ;_ Fin de car 250Y (cadr (polar (cdr (assoc 10 ENTG2)) (cdr (assoc 50 ENTG2)) (cdr (assoc 40 ENTG2)) ) ;_ Fin de polar ) ;_ Fin de cadr 251X (car (polar (cdr (assoc 10 ENTG2)) (cdr (assoc 51 ENTG2)) (cdr (assoc 40 ENTG2)) ) ;_ Fin de polar ) ;_ Fin de car 251Y (cadr (polar (cdr (assoc 10 ENTG2)) (cdr (assoc 51 ENTG2)) (cdr (assoc 40 ENTG2)) ) ;_ Fin de polar ) ;_ Fin de cadr AP1 (list 150X 150Y) AP2 (list 151X 151Y) AP3 (list 251X 251Y) ) ;_ Fin de setq (command "_LAYER" "_S" EL "") (entdel ENTS1) (entdel ENTS2) (command "_ARC" AP1 AP2 AP3) (command "_LAYER" "_S" CL "") ) ;_ Fin de progn ) ;_ Fin de if ) ;_ Fin de progn ) ;_ Fin de 3eme cond );cond generales ) ;_ Fin de defun je joins aussi une routine plus significative ,laquelle ne fonctionne que pour des lignes mais c'est exactement ce que je veux reproduire par sélection. ;sert a reconstruire des lignes coupées ,selection fenetre ;============================================================================== ; PROJ Projection du point A sur la droite B C avec verification ; selon D comme la fonction INTERS ;============================================================================== (defun _proj (a b c d) (inters b c a (polar a (+ (* 0.5 pi) (angle b c)) 1.0) d ) ) (defun c:reb-lig ( / p q lot la i lb ea eb d p1 p2 p3 p4 d1 d2 ea10 ea11 eb10 eb11 temp) (setq p nil q nil) (initget 1) (setq p (getpoint "\nPremier coin : ")) (initget 1) (setq q (getcorner p "\nAutre coin : ")) (setvar "cmdecho" 0) (command "_erase" "_w" p q "") (if (setq lot (ssget "c" p q)) (progn (while (setq la (ssname lot 0)) (ssdel la lot) (setq i 0) (repeat (sslength lot) (setq lb (ssname lot i)) (setq ea (entget la)) (setq eb (entget lb)) (setq d (apply '(lambda (e1 e2) (if (= "LINE" (cdr (assoc 0 e1)) (cdr (assoc 0 e2))) (progn (setq p1 (cdr (assoc 10 e1)) p2 (cdr (assoc 11 e1)) p3 (cdr (assoc 10 e2)) p4 (cdr (assoc 11 e2)) d1 (distance p1 (_proj p1 p3 p4 nil)) d2 (distance p2 (_proj p2 p3 p4 nil)) ) (if (> 0.001 (abs (- d1 d2))) d1 nil ) ) ) ) (list ea eb) ) ) (cond ((not d) nil) ((> 0.001 (abs d)) (if (= (cdr (assoc 8 ea)) (cdr (assoc 8 eb))) (progn (setq ea10 (cdr (assoc 10 ea)) ea11 (cdr (assoc 11 ea)) eb10 (cdr (assoc 10 eb)) eb11 (cdr (assoc 11 eb)) ) (if (> (distance ea10 eb10) (distance ea10 eb11) ) (setq temp eb10 eb10 eb11 eb11 temp ) ) (if (< (distance ea10 eb10) (distance ea11 eb10) ) (setq temp ea10 ea10 ea11 ea11 temp ) ) (entdel lb) (entmod (append ea (list (cons 10 ea10) (cons 11 eb11) ) ) ) T ) ) ) (T nil) ) (setq i (1+ i)) ) ) ) ) (setvar "highlight" 1) (redraw) (princ) )

une possibilité mais sans établir la liste réelle des entités sur la couleur en Ducalque ;test de selection d'objets par leur couleur (defun c:le-test ( / e dxf_ent la-couleur lenom) (setq e (car (entsel "Selection de la couleur: "))) (setq dxf_ent (entget e)) (if (= (assoc 62 dxf_ent) nil) (progn (setq la-couleur (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 dxf_ent))))));couleur en Ducalque (setq lenom (cdr (assoc 8 dxf_ent))) (SETQ la-sel (SSGET "_x" (LIST (CONS 8 lenom)))) );progn (progn (setq la-couleur (cdr (assoc 62 dxf_ent)));couleur forcée (setq la-sel (ssget "_x" (ssget-ColorIndex-filter la-couleur))) );progn );if (princ) );defun (defun ssget-ColorIndex-filter ( ColorIndex / ) (list (cons 62 ColorIndex) '(-4 . "<NOT") '(-4 . "*") '(420 . 0) '(-4 . "NOT>"));couleur forcée )

Bonjour tout le monde , je butte sur une sélection d'objets quelconque par leur couleur et lorsqu'elle est en Ducalque. J'ai testé le lisp (Special_selections) de gile "ssc" qui me sélectionne toutes les entités de la couleur (ducalque et forcées). Le but est de ne selectionner que ce qui correspond à l'objet soit couleur en ducalque , soit couleur forcée . ci-dessous le lisp ou j'en suis ;test de selection d'objets par leur couleur (defun c:le-test ( / e dxf_ent) (setq e (car (entsel "Selection de la couleur: "))) (setq dxf_ent (entget e)) (if (= (assoc 62 dxf_ent) nil) (setq la-couleur (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 dxf_ent))))));couleur en Ducalque (setq la-couleur (cdr (assoc 62 dxf_ent)));couleur forcée );if (setq la-sel (ssget "_x" (ssget-ColorIndex-filter la-couleur))) );defun (defun ssget-ColorIndex-filter ( ColorIndex / ) (list (cons 62 ColorIndex) '(-4 . "<NOT") '(-4 . "*") '(420 . 0) '(-4 . "NOT>"));couleur forcée )

avec la commande "FLATTEN" d'autocad , mais attention si beaucoup d'objets le traietement est long

Bonjour, Une petite parenthèse ,la routine "laytable" fonctionne en autocad 2006 fr,en 2004fr l'insertion du tableau semble ne pas se faire ,en autocad 2000 fr les tables n'existent pas . tout cela pour dire ,attention aux versions d'autocad utilisées surtout avec les fonctions "vla-................get-TrueColor........."

Bonjour Gile , Complètement d'accord avec les précisions que tu as apportées . merci , a+

Une astuce trouvée sur le net pour l'utilisation de l'éditeur visual lisp d'autocad. mais attention , comme le dit l'article ce sont des variables locales qu'il faut rajouter après "\" pour les mettre à nil .Personnellement j'utilise cette option comme une aide . http:// http://rkmcswain.blogspot.com/2006/07/vlisp-variables.html

bienvenue ElpanovEvgeniy (chouette , une autre grosse pointure ) merci Gile mais les attributs sont toujours pris en compte dans la boundingbox. Ci-dessous une définition d'un des attributs qui embète tout le monde : DEFINITION DES ATTRIBUTS Calque: "HYRREP" Espace: Espace objet Maintien = 491 Style = "Standard" Fichier de polices = txt départ point, X= 215.4429 Y= 163.5739 Z= 0.0000 hauteur 0.1000 par défaut message (_mes_dwg "hy" 1) étiquette REP rotation angle 0 largeur facteur d'échelle 1.0000 inclinaison angle 0 drapeaux normal(e) génération normal(e)

merci Gile , Je viens de tester ,ils sont toujours pris en compte ,je vais y réfléchir demain .Je te tiens informé dès que je trouve une réponse . encore merci

Bonjour Gile , Je viens d'utiliser ta routine "bbox" 11/8/2006 à 21:55 sur des blocs en 2d elle fonctionne quelque soient le SCU dans lequel a été créé l'objet . C'est parfait . Une seule chose m'ennuie c'est qu'elle tient compte de tous les objets constituants un bloc y compris les attributs .Peux tu m'aider ,si c'est possible ,pour y filtrer les attributs afin qu'ils ne soient pas pris en compte dans l'emprise d'un bloc . merci d'avance et félicitations pour ce travail remarquable une fois de plus [Edité le 26/10/2006 par sergeluc]

merci gile , c'est toujours exceptionnel . Bonne journée

Bonjour à tous , Pour éviter de mettre des " ; " à toutes les lignes de commentaires dans un programme autolisp ou vlisp ,vous pouvez pour un ensemble continu de lignes de caractères utiliser le code ascii " | " Alt 6 au clavier et un " ; " en début et fin de l'ensemble de ces lignes . Ce qui donne : (print "Test debut") |;ceci est un test pour les lignes suivantes qui sont des commentaires ne seront pas interprètées bla bla bla bla bla bla (setq test (car (entsel))) |; bla bla bla (print "Test fin")

mettre un ensemble de lignes en commentaires rapidement reponse dans le message suivant [Edité le 27/9/2006 par sergeluc]

Bonjour à tous ; avec un peu ......de temps on trouve ,voici une solution : ;test de decoupe par la fonction TRIM de lignes , plines , lwpolylines traversant une lwpolyline FERMEE (exemple: un rectangle) et suppression des objets a l'interieur de la fenetre de découpe ;on peut aussi découper des cercles,vertex (defun c:test4 (/ ent) (vl-load-com) (setq ent (entsel "\nChoix d'une polyligne "));pour exemple (setq ent (entget(car ent))) (test4) (princ) );defun (defun test4 ( / pt_lst bbox1 pt1-bbox1 pt2-bbox1 pt3-bbox1 pt4-bbox1 pt5-bbox1) ;sort la liste des points de tous les sommets (cond ((= (cdr (assoc 0 ent)) "LWPOLYLINE");pour exemple (setq nbs (cdr (assoc 90 ent)) cnt 0 pt_lst '() ) ;_ Fin de setq (while (< cnt nbs) (if (= (caar ent) 10) (setq pt_lst (cons (cdar ent) pt_lst) cnt (+ cnt 1) ) ;_ Fin de setq ) ;_ Fin de if (setq ent (cdr ent)) ) ;_ Fin de while (setq pt_lst (reverse pt_lst));sans Z (setq ptscu (mapcar '(lambda (x) (trans x 0 1)) pt_lst));avec Z ;je récupère les points min et max pour dessiner un rectangle (setq p_min (list (apply 'min (mapcar 'car ptscu)) ;pour les cas ou on trouve pwline fermée +lines exct ;(apply 'min (mapcar 'caddr ptscu));a voir pour pwline fermées (apply 'max (mapcar 'cadr ptscu));pour pwline ouvertes 0.0 );list p_max (list (apply 'max (mapcar 'car ptscu)) ;(apply 'max (mapcar 'caddr ptscu));a voir pour pwline fermées (apply 'min (mapcar 'cadr ptscu));pour pwline ouvertes 0.0 );list );setq ;création du rectangle qui sert à la découpe (command "_.rectang" p_min p_max);pour test (setq bbox1 (entlast)) ;je récupére les 4 assoc 10 du rectangle (if bbox1 (progn (setq n-bbox1 (entget bbox1)) (setq nbs (cdr (assoc 90 n-bbox1)) cnt 0 pt_lst '() ) ;_ Fin de setq (while (< cnt nbs) (if (= (caar n-bbox1) 10) (setq pt_lst (cons (cdar n-bbox1) pt_lst) cnt (+ cnt 1) ) ;_ Fin de setq ) ;_ Fin de if (setq n-bbox1 (cdr n-bbox1)) ) ;_ Fin de while (setq pt_lst (reverse pt_lst));sans Z (setq ptscu1 (mapcar '(lambda (x) (trans x 0 1)) pt_lst));liste avec les Z ;les 4 assoc 10 (setq pt1-bbox1 (nth 0 ptscu1) pt2-bbox1 (nth 1 ptscu1) pt3-bbox1 (nth 2 ptscu1) pt4-bbox1 (nth 3 ptscu1) );setq ;suppression des objets superflus a l'interieur de la fenetre (command "_.erase" "_w" pt1-bbox1 pt4-bbox1 "_r" bbox1 "") ;;;;;;;;;DECOUPE DU POINT 1 AU POINT 1;;;;;;;;;;;;;; (command "_.trim" bbox "" "_f" pt1-bbox1 pt2-bbox1 "" "_f" pt2-bbox1 pt3-bbox1 "" "_f" pt3-bbox1 pt4-bbox1 "" "_f" pt4-bbox1 pt1-bbox1 "" "" );command ;suppression du rectangle (entdel bbox1) (alert "terminé");test fin de fonction );progn );if bbox );cond ) ;_ Fin de cond );defun test4 (c:test4) [Edité le 26/9/2006 par sergeluc]