DenisHen

Bonjour à tous. Voilà, aujourd'hui, j'ai un petit soucis avec un (entlast. Je ne sais pas si je m'y prend bien, mais ça ne fait rien, et je n'ai aucune idée du problème... Voici un extrait du code : (command "-inserer" (cdr PosLstBlk) "_non" Coord (/ EchX 1000) (/ EchY 1000) (angtos Rot 2 3) ) ;_ Fin de command (setq ent_bloc (entget (entlast))) ;;; (setq NomBlk (cdr (assoc 2 ent_bloc)) ;;; pntLLRGF93 (ade_projptforward Coord) ;;; ) ;_ Fin de setq (vl-catch-all-apply 'setpropertyvalue (list ent_bloc "X" "25")) (vl-catch-all-apply 'setpropertyvalue (list ent_bloc "Y" "18")) (vl-catch-all-apply 'setpropertyvalue (list ent_bloc "Z-TN" "9")) Les valeurs 25, 18 et 9 ne sont pas les bonnes, c'est juste pour le test. Si quelqu'un a une astuce, un conseil... Je suis preneur...

Bonjour à tous. Jusqu'à présent, j'avais une routine en LiSP qui fonctionnait très bien. Elle plaçait quelques données dans différents attributs des blocs. Cette macro ne m'a jamais posé problème, car je traitais que quelques blocs, mais là, j'ai 8500 blocs à traiter, et le code se met soudain à ralentir. Il traitait plus de cent blocs/seconde, mais arrivé à environ 4000 blocs, il se met sérieusement à ralentir et à 5000 bloc, il n'en traite plus que un par seconde... Arrivé à 5200, c'est 1 toutes les deux secondes... Et c'est de pire en pire... Si quelqu'un a une idée, une astuce voir un conseil, je suis preneur... Voici la boucle qui ralenti...: (princ "\nRemplissage des données géographiques des blocs.") (if (setq ss (ssget "_X" '((0 . "INSERT")))) (progn (setq i 0) (while (setq ent (ssname ss i)) (setq i (1+ i)) (if (= (cdr (assoc 0 elst)) "INSERT") (progn (setq elst (entget ent) dxf10 (assoc 10 elst) att (entget (entnext ent)) Coord (cdr (assoc 10 elst)) NomBlk (cdr (assoc 2 elst)) ) ;_ Fin de setq (princ "\nTraitement : ") (princ i) (ade_projsetsrc (ade_projgetwscode)) (ade_projsetdest "LL-RGF93") (setq pntLLRGF93 (ade_projptforward Coord)) ;;Ecriture des coordonnées dans un fichier CSV (write-line (strcat NomBlk "," (rtos (car pntLLRGF93) 2 15) "," (rtos (cadr pntLLRGF93) 2 15)) FileCSV) (while (/= (cdr (assoc 0 att)) "SEQEND") (cond ((= (cdr (assoc 2 att)) "X") (setq att (subst (cons 1 (rtos (car pntLLRGF93) 2 15)) (assoc 1 att) att)) (entmod att) ) ;_ Fin de cond ((= (cdr (assoc 2 att)) "Y") (setq att (subst (cons 1 (rtos (cadr pntLLRGF93) 2 15)) (assoc 1 att) att)) (entmod att) ) ((= (cdr (assoc 2 att)) "Z-TN") (setq att (subst (cons 1 (rtos (caddr Coord) 2 3)) (assoc 1 att) att)) (entmod att) ) ((= (cdr (assoc 2 att)) "NOMENTRGEO") (setq att (subst (cons 1 "CERENE") (assoc 1 att) att)) (entmod att) ) ((= (cdr (assoc 2 att)) "DATERELEVE") (setq Now (menucmd "M=$(edtime,$(getvar,date),DD/MO/YYYY)")) (setq att (subst (cons 1 Now) (assoc 1 att) att)) (entmod att) ) ((= (cdr (assoc 2 att)) "NOMPRESTACERTIGEO") (setq att (subst (cons 1 NomOp) (assoc 1 att) att)) (entmod att) ) ((= (cdr (assoc 2 att)) "MARQUEAPP") (setq att (subst (cons 1 NomMateriel) (assoc 1 att) att)) (entmod att) ) ((= (cdr (assoc 2 att)) "NUMSERIEAPP") (setq att (subst (cons 1 NumMateriel) (assoc 1 att) att)) (entmod att) ) ((= (cdr (assoc 2 att)) "NUMSERIE") (setq att (subst (cons 1 NumMateriel) (assoc 1 att) att)) (entmod att) ) ((= (cdr (assoc 2 att)) "INCERTXY") (setq att (subst (cons 1 "5cm") (assoc 1 att) att)) (entmod att) ) ((= (cdr (assoc 2 att)) "INCERTZ") (setq att (subst (cons 1 "5cm") (assoc 1 att) att)) (entmod att) ) ) ;_ Fin de cond (setq att (entget (entnext (cdr (assoc -1 att))))) ) ;_ Fin de while ) ;_ Fin de progn ) ;_ Fin de if ) ;_ Fin de while ) ;_ Fin de progn ) ;_ Fin de if

Effectivement, si je ne choisi pas le bon bloc... (setq elst (subst (cons 2 (car PosLstBlk)) (assoc 2 elst) elst)) remplacé par (setq elst (subst (cons 2 (cdr PosLstBlk)) (assoc 2 elst) elst))

Re. Alors curieusement, ça a fonctionné une seule fois... Mais plus maintenant. ;;; Début de la boucle (foreach PosLstBlk LstBlk (setq n 0) (if (setq Select (ssget "_X" (list (cons 0 "INSERT") (cons 2 (car PosLstBlk))))) (while (setq ent (ssname Select n)) (setq elst (entget ent)) (setq elst (subst (cons 2 (car PosLstBlk)) (assoc 2 elst) elst)) (entmod elst) (setq n (+ n 1)) ) ;_ Fin de while ) ;_ Fin de if ) ;_ Fin de foreach

Eh ben ça y est... Si ça peut être utile à d'autres, voici la boucle corrigée selon le super conseil de Patrick_35 (encore une fois)...: (foreach PosLstBlk LstBlk (setq n 0) (if (setq Select (ssget "_X" (list (cons 0 "INSERT") (cons 2 (car PosLstBlk))))) (while (setq ent (ssname Select n)) (setq elst (entget ent)) (setq elst (subst (cons 2 (car PosLstBlk)) (assoc 2 elst) elst)) (entmod elst) (setq n (+ n 1)) ) ;_ Fin de while ) ;_ Fin de if ) ;_ Fin de foreach

Salut Patrick_35, et merci pour ton aide. Le truc, c'est que le même bloc (ex "FPLPT3") peut se placer correctement sur un point et à coté, ce même bloc se place à perpette...!?! Le code dxf 2, avec un (entmod ? Je vais regarder ça... Mais je n'y connais rien à cette commande... Merci encore...

J'ai encore fait des testes... EN fait, les blocs qui "déconnent" se retrouvent en miroir avec l'axe des Y !?! Comprend rien...

Bonjour à tous. Voilà, aujourd'hui, je cherche à remplacer certains blocs qui ont une incrémentation dans leur nom (FPLPT2_44, FPLPT2_45,FPLPT2_46...) par le bloc FPLPT2 avec les bonnes échelles et rotation d'origine... Voici le lien du DWG et mon code : ;;; ********************************************************************************************* ;;; Routine de traitement des fichiers bruts (issus d'un DGN) pour en faire un Fond de Plan ***** ;;; ********************************************************************************************* (defun c:Test_Adriatel (/) (princ "\nDéveloppé par Denis H.") (command "_undo" "_mark") (setq old_osmd (getvar "osmode") old_abase (getvar "angbase") old_adir (getvar "angdir") old_aunits (getvar "aunits") old_cmdecho (getvar "cmdecho") old_AttDia (getvar "attdia") old_AttReq (getvar "attreq") old_layer (getvar "clayer") old_Insunits (getvar "insunits") ) ;_ Fin de setq (setvar "osmode" 1) (setvar "cmdecho" 0) (setvar "aunits" 2) (setvar "ATTDIA" 0) (setvar "ATTREQ" 0) (setvar "angbase" (/ pi 2)) (setvar "angdir" 1) (setvar "clayer" "0") (setvar "insunits" 4) (command "filedia" 0) (command "-unites" "2" "2" "3" "2" "0,0" "@0,1" "O") (command "pdmode" "32") (command "pdsize" ".1") (command "PLINEGEN" "1") (command "-couleur" "ducalque") ;;; ************************************ ;;; Remplacement des blocs incrémentés * (princ "\nRemplacement des blocs incrémentés...") (setq Select nil) (setq LstBlk '(;;;.... ("FPLPT1_*" . "FPLPT1") ("FPLPT2_*" . "FPLPT2") ("FPLPT3_*" . "FPLPT3") ("FPLPT4_*" . "FPLPT4") ;;;.... ;;;.... ) ) ;_ Fin de setq ;;; Début de la boucle (foreach PosLstBlk LstBlk (setq n 0) (if (setq Select (ssget "_X" (list (cons 0 "INSERT") (cons 2 (car PosLstBlk))))) (while (setq ent (ssname Select n)) (setq elst (entget ent) Coord (cdr (assoc 10 elst)) EchX (/ (cdr (assoc 41 elst)) 1000) EchY (/ (cdr (assoc 42 elst)) 1000) Rot (cdr (assoc 50 elst)) Calq (cdr (assoc 8 elst)) n (1+ n) ) ;_ Fin de setq (setvar "clayer" Calq) (command "_erase" ent "") (setq Coord (strcat (rtos (car Coord) 2 3) "," (rtos (cadr Coord) 2 3) ",0")) (setq Rot (+ Rot (/ pi 2))) (command "-inserer" (cdr PosLstBlk) "_non" Coord EchX EchY (angtos Rot 2 3)) ) ;_ Fin de while ) ;_ Fin de if ) ;_ Fin de foreach ) ;_ Fin de defun Je n'arrive pas à l'expliquer, mais parfois, certains blocs se retrouve à perpette... Vers 1200km à l'OUEST...? Si quelqu'un a une astuce, une idée... Je suis preneur... PS : après quelques testes et essais, je pense que c'est une question d'angle ou de rotation...

Bonjour à tous. Je viens de tomber sur une série de LiSP "hyper complexes" pour créer des lotissements que j'avais fait en 2005/2006. J'entends par "hyper complexes" une suite de LiSp imbuvables, mais extrêmement efficaces, mais fait pour UNE SEUL PERSONNE, moi, une méthode qui n'autorise aucune liberté. J'entend par là : - le gestion de plusieurs projet sur un même lieu (projet A, B, C, D...) - l'utilisation de deux échelles (à la construction, faire en même temps, le plan de situation ET le plan de détail) - la gestion des données fixes (style de texte, et autre depuis un fichier simple (.xls) pour une gestion facile) Dans ma méthode, on construit les contours des lots dans un calque "non imprimable" lié à l'incrémentation du lotissement (A, B, C, D...) Puis, une fois les contours définis, on "dessine" le contour des lots et, tout se fait automatiquement, les cotes périmétriques se places dans les calques des deux échelles choisies, une trame colorée (se terminant par 1, ex : 91, 131, 191...) se dessine dans le périmètre du lot, on demande un clique pour placer le numéro du lot et un clique pour sa surface... Ma suite de LiSP est extrêmement complexe, mais pourrait répondre à TOUT LES BESOIN des lotisseurs... Si cela intéresse quelqu'un, je pourrais m'investir dans ce développement... Je sais un peu de quoi je parle, j'en ai fait pendant 10 ans... Si ça vous intéresse, fait-le moi savoir... ;)

Petite amélioration, ce code supprime le "=" et le ":" en deuxième position dans le texte sélectionné, il replace le premier caractère après l'opération : ;;;Arrondi une valeur dans "R10.233" (defun c:TestArrondi ( / Select Texte elst) (setq Select (entsel "\nChoisissez votre texte :")) (setq Texte (cdr (assoc 1 (entget (car Select))))) (setq Prefix (substr Texte 1 1)) (setq Texte (substr Texte 2 (- (strlen Texte) 1))) (setq Texte (vl-string-left-trim ":" Texte)) (setq Texte (vl-string-left-trim "=" Texte)) (setq Texte (rtos (atof Texte) 2 2)) ;_ Fin de setq (setq Texte (strcat Prefix Texte)) (setq elst (entget (car Select))) (setq elst (subst (cons 1 Texte) (assoc 1 elst) elst)) (entmod elst) (princ) ) ;_ Fin de defun Pour ajouter un "=" après le premier caractère après l'opération, il suffit de changer la ligne (setq Texte (strcat Prefix Texte)) Par (setq Texte (strcat Prefix "=" Texte)) Cette opération transformera "T22.238" par "T=22.24"

Ce code fonctionne en supprimant tout premier caractère, comme "F12.369", "R10.233", "S55.297"...: ;;;Arrondi une valeur dans "R10.233" (defun c:TestArrondi ( / Select Texte elst) (setq Select (entsel "\nChoisissez votre texte :")) (setq Texte (cdr (assoc 1 (entget (car Select))))) (setq Texte (substr Texte 2 (- (strlen Texte) 1))) (setq Texte (rtos (atof Texte) 2 2)) ;_ Fin de setq (setq Texte (strcat "R" Texte)) (setq elst (entget (car Select))) (setq elst (subst (cons 1 Texte) (assoc 1 elst) elst)) (entmod elst) (princ) ) ;_ Fin de defun

Par contre, ça ne fonctionne QUE si le texte commence par "R"...

Salut. Je pense que ça doit être un truc dans ce genre : ;;;Arrondi une valeur dans "R10.233" (defun c:TestArrondi ( / Select Texte elst) (setq Select (entsel "\nChoisissez votre texte :")) (setq Texte (cdr (assoc 1 (entget (car Select))))) (setq Texte (vl-string-left-trim "R" Texte)) (setq Texte (rtos (atof Texte) 2 2)) ;_ Fin de setq (setq Texte (strcat "R" Texte)) (setq elst (entget (car Select))) (setq elst (subst (cons 1 Texte) (assoc 1 elst) elst)) (entmod elst) (princ) ) ;_ Fin de defun EDIT : correction d'une petite erreur...

Salut. Et sans le "u=0" ?

Arg... Je tombe forcément sur une c***lle... Dans la sélection du texte contenant ma valeur Prof (profondeur), j'ai parfois des mises en forme déjà faites, comme "Pf:55cm", ou "Prof = 0.69m". Raison pour laquelle, j'avais ça dans mon ancien code... : (setq Prof (vl-string-left-trim "Pf:" (vl-string-right-trim "m" Prof))) (setq Prof (vl-string-left-trim "Prof = " (vl-string-right-trim "M" Prof))) (setq Prof (vl-string-left-trim "P:" (vl-string-right-trim "M" Prof))) (setq Prof (vl-string-left-trim "P" (vl-string-right-trim "CM" Prof))) (setq Prof (vl-string-left-trim "p" (vl-string-right-trim "cm" Prof))) (setq Prof (vl-string-left-trim "(" (vl-string-right-trim ")" Prof))) Et là, je rame encore plus... :( Car je n'arrive pas à voir la valeur str au moment ou je devrais trier cette mise en forme... :huh: PS du lendemain : j'ai trouvé la solution... Encore merci à tous...

Wouaouw... En fait, tu passes par le clique de la souris ? ! ? Alors ça, c'est vicueux... Mais diablement efficace... ;)

Salut (gile), et merci pour ton aide... Et que c'est joli tout ça... J'intègre immédiatement ce code qui va me permettre de ne pas trop toucher mon ancien code... Encore merci à vous... Denis...

Content de voir que je suis dans tes pensées... ;) Associer ma personne et le mot "développeur" me flatte... B) Mais effectivement, moi seul utilise les lisp des autres (surtout des CadXPiens)...

Salut. Je pense que SuperAutoScript est ton ami... Si Eric passe par ici, il pourra t'en dire plus, le l'ai utilisé il y a pas mal de temps, mais ça m'a fait gagner plusieurs heures, voir plusieurs jour de boulo...

Forcément, je viens d'intégré ton code au mien, mais rien ne se passe, le voici : ;;;********************************************************** ;;; Teste de sélection d'une profondeur OU saisi de celle-ci ;;;********************************************************** (defun c:TestProf (/) (defun nentsel-getreal (/ ent key n nbr) (setq Prof (vlax-ldata-get "DenisH" "EtiqPRD_OldProf" "")) (if (= Prof "") (princ (strcat "\nSélectionnez la profondeur : ")) (princ (strcat "\nSélectionnez la profondeur <" Prof "> : ")) ) ;_ Fin de if ;;; (setq Txt_Prof "") (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25) (/= (car key) 3)) (cond ((eq (car key) 2) (if (member (cadr key) '(8 46 48 49 50 51 52 53 54 55 56 57)) (if (eq (cadr key) 8) (progn (princ (chr 8)) (princ (chr 32)) (princ (chr 8)) (setq Txt_Prof (substr Txt_Prof 1 (1- (strlen nbr)))) ) ;_ Fin de progn (progn (setq n (chr (cadr key))) (princ n) (setq Txt_Prof (strcat Txt_Prof n))) ) ;_ Fin de if ) ;_ Fin de if ) ) ;_ Fin de cond ) ;_ Fin de while (if (eq (car key) 3) (if (setq ent (nentselp (cadr key))) (progn (setq ent (entget (car ent))) (if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "ATTRIB")) (progn (setq ent (read (cdr (assoc 1 ent)))) (if (or (eq (type ent) 'INT) (eq (type ent) 'REAL)) (progn (vlax-ldata-put "DenisH" "EtiqPRD_OldProf" (rtos ent 2 2)) ent) (progn (princ "\nLe texte n'est pas valide!") (nentsel-getreal)) ) ;_ Fin de if ) ;_ Fin de progn (progn (princ "\nObjet n'est pas un Texte!") (nentsel-getreal)) ) ;_ Fin de if ) ;_ Fin de progn (progn (princ "\nSélection vide!") (setq ent nil) (nentsel-getreal)) ) ;_ Fin de if (if (/= Txt_Prof "") (progn (princ (strcat "\nProf = " Txt_Prof)) (atof Txt_Prof) (vlax-ldata-put "DenisH" "EtiqPRD_OldProf" Txt_Prof) ) ;_ Fin de progn ) ;_ Fin de if ) ;_ Fin de if ) ;_ Fin de defun ;;; (nentsel-getreal) (princ) ) ;_ Fin de defun PS : j'ai modifier le code posté, ça fonctionne nickel... Encore merci BonusCAD... Denis...

Salut BonusCad, et merci pour ton aide, je vais de ce pas jeter un œil dessus...

Bonjour à la communauté. Aujourd'hui, et pour les besoins d'une vieille routine, je dois : - soit cliquer sur un texte (qui est un nombre), - soit taper ce nombre en ligne de commande. J'ai donc modifier mon Lisp d'origine, mais je rame. J'ai donc fais un petit bout de Lisp test mais toujours rien. Voici mon code : ;;;********************************************************** ;;; Teste de sélection d'une profondeur OU saisi de celle-ci ;;;********************************************************** (defun c:TestProf (/) (setq Prof (vlax-ldata-get "DenisH" "EtiqPRD_OldProf" "")) (if (= Prof "") (setq Phrase (strcat "\nSélectionnez la profondeur : ")) (setq Phrase (strcat "\nSélectionnez la profondeur <" Prof "> : ")) ) ;_ Fin de if (princ "\nType Txt_Prof = ") (setq Txt_Prof (car (entsel Phrase))) (if (= (type Txt_Prof) 'ENAME) ;; Si Txt_Prof est une sélection (princ (type Txt_Prof)) ) ;_ Fin de if (if (= (type Txt_Prof) 'STR) ;; Si Txt_Prof est un string (princ (type Txt_Prof)) ) ;_ Fin de if (princ) ) ;_ Fin de defun Lorsque je clique sur une entité, (type Txt_Prof est bien ENAME. Mais si je tape un texte, (type Txt_Prof n'est pas un string... Je pense que ça vient du (entsel... Si quelqu'un a une astuce, un conseil ou même la solution, je suis preneur... Denis...

Salut. A ma boite, on a eut besoin d'un AutoCAD "light" en orix, mais avec intégration de mes lisp... Donc, je ne voyais que ZWCad... Et bien j'ai été agréablement surpris de ce clone. En fait, c'est une collègue qui l'a utilisé, mais comme elle ne connaissait pas AutoCAD, elle me posait souvent des questions, et les réponses auraient été les mêmes sous AutoCAD. Vraiment très ressemblant... Vite fait, à la louche... Je dirais 9/10. Denis...

C'est presque évident qu'en levant deux fois la même plaque, elles ne seront jamais exactement superposées. Mais la moyenne des deux s'approchera de la réalité... C'est ce que je tente de faire avec ma routine... On peut aussi imaginer faire les moyennes des échelles d'un même bloc inséré plusieurs fois et réinjecter ces nouvelles échelles à ces blocs... De la grande folie, car il se pourra que les mêmes blocs aient réellement des cotes différentes sur un même chantier... Mais là, on commence le capilo-tractage... ;)

Merci Didier, je m'attendais un peu à ce genre de réponse, surtout que nous travaillons dans la France entière... Demander à mes collègues de "perdre du temps" pour mesurer les plaques, c'est pi**er dans un violon. Ils ne le feront jamais... Ça fait 30 ans qu'ils font du "carto200" (une norme pour l'EDF dans laquelle, toutes les entités topographiques sont dans 3 calques : Batiment, Limite et hydro, Route), et c'est tout. Pour les blocs, c'est le même tonneau, ils sont levés par trois points et n'ont jamais les mêmes échelles... Ah, il est loin le temps ou je sévissais dans les Hauts de Seine, avec, un point d'insertion du bloc, un deuxième point pour l'orientation et deux cotes, longueur et largeur... En tous cas, merci Didier pour ton aide... Et bon dimanche à vous... Denis...