Elever 2DPoly depuis Texte Altitude proche ?

lecrabe · le 18 novembre 2016

Hello

Je pensais avoir la bonne routine mais en fait je ne l'ai pas !?

... CDC/CCTP du Decapode ...

- Soit un DWG avec des Poly2D (Fines/Epaisses) au niveau ZERO

( Ces Polylignes au niveau ZERO sont en fait des courbes de niveau )

- Soit UN texte ou DEUX textes tres proches du depart et/ou fin de CHAQUE polyligne

- But: Monter en Elevation les Polylignes au niveau/altitude du texte proche

Voila comment je vois les choses :

1) Poser question : rayon de recherche (Largeur du "Cote de recherche" en fait) (Defaut = 1)

Un peu comme une fenetre carree de selection capturante "_C" ...

Ou (un peu plus complique) faire une selection "_CP" avec un octogone regulier ...

2) Poser eventuellement question : Effacer 2eme texte "eventuel" (A cote du Point final)

( dans le "meme rayon" de recherche )

3) Selection AutoCAD classique et ne retenir que les TEXTEs simples et les 2D Polys (Fines/Epaisses)

Analyse 1ere Polyligne

On cherche d'abord un texte (dans le carre de selection) pres du depart

Si trouve : alors on monte la Polyligne au niveau voulu

Si NON trouve on cherche un Texte autour du point final ...

Si ZERO Texte ALORS on force la couleur de la Poly (Rouge par exemple)

pour la traiter manuellement plus tard ...

Ensuite je pense qu'il faut effacer le texte "du depart" trouve PAR SECURITE

et voire meme effacer le 2eme texte (si on en trouve UN - Voir question No 2)

Puis on boucle ...

Tant pis si on "choppe" le mauvais texte pour l'elevation !!

Merci d'avance pour votre aide ...

Bye, lecrabe

PS: tout le monde n'a pas Covadis !

thierry.garré · le 18 novembre 2016

Salut Pat,

Va falloir que l'on te fasse une formation sur les rudiments de Covadis... ????

lecrabe · le 18 novembre 2016

Hello Thierry

Attention il s'agit de Poly 2D au niveau ZERO (Des courbes de niveau) !?

Bye, lecrabe

GEGEMATIC · le 18 novembre 2016

Salut mon pauvre Crabe qui sèche !

je n'avais pas sous la main exactement ce que tu voulais, mais je te l'ai bricolé à partir d'une commande proche:

maintenant il s'agit d'un plug-in PowerClic, je n'ai pas le temps de te faire une commande "standalone" aujourd'hui.

voilà le flux:

Avec PowerClic tu sélectionne les textes d'altitude et tu choisis d'appliquer le plug-in "ChelevPolyproche" à ta sélection

le programme te demande le délimiteur (entrée pour rien) par exemple quand le texte est de type: "Levé du 15/16/203 Cote Tn: 1.25" le délimiteur parfait sera "Tn:" pour ne pas avoir comme altitude la date.

Puis il te demande un rayon de recherche: c'est la distance entre le pt d'insertion du texte et la polyligne:

la je te conseille d'utiliser la commande justifier, Milieu centre pour tes textes

puis un filtre de calque pour tes polylignes:

tu peut utiliser des jokers comme ? ou *

exemple : "CNIV*"

Pour l'utiliser, il te faut installer PowerClic et placer le code dans un fichier type ChelevPolyProche.lsp et placer ce fichier dans le répertoire plug-in de powerclic

a+

gégé

; ****************************************************************************
;;§/topo/ inserre un bloc à la place de textes fournies par des géometres a la valeur z du texte/none
;
(pw_pluggin_register '("ChelevPolyProche" (  "TEXT" "MTEXT" "MULTILEADER") ("Change l'élévation des objets proches d'un texte d'altitude")))
(defun ChelevPolyProche( /  sel lent i en  l eng modif z eg tp pins sep  ss)
 (c:stripformatload)
 (setq sep (SPACE=NIL (getstring t "\nChaine marquant le début de la cote Z ? entrée pour aucun")))
 (pw_bydefault "factz" 1.0)
 (pw_getrealmem  "\nfacteur multiplicateur en z ? " "factz")
 (pw_getrealmem  "\nrayon de recherche ? " "rayon")
 (pw_getstringmem  "\nFiltre de calque ? " "calque")
 (setq sel (pw_select_only_ctab (ssget "_p")))
 (setq lent (pw_listsel sel))
 (setq i 0)
 ;(setq blnam (cdr (assoc 2 (entget (car  (entsel (pw_getxt 'PW97 "\nSelectionner le bloc à inserer :")))))))
 (pw_setvar1 "attreq" 0)
 (foreach l lent
   (setq i (+ 1 i))
   (setq eg (entget l))
   (setq tp (cdr (assoc 0 eg)))
   (setq txt (vla-get-TextString (setq eo (pw_to_object l)) ))
   (setq txt (stripformat txt "*"))
   (if  sep
     (setq txt (last (pw_l_word_off_string txt sep)))
   )
   
   (cond
     ((= "MULTILEADER" tp)
      (setq pins (pw_mleader_fleche_position l))
     )
     (t
      (setq pins (PW_scg2scu (cdr (assoc 10 eg))))
     )
   )
   (if (numberp (setq z (pw_find_1st_num txt)))
     (progn

;;suivant pour topocad
;(command "_insert" "Spotblk1" pins "1" "1" "0"  (itoa i) (rtos (last pins))  )
;(command "_insert" blnam pins "1" "1" "0" (rtos (last pins))  )
(setq pins (list (car pins) (cadr pins) (setq z (* factz z))))
(setq ss (SELECT_CROSS_AROUND pins nil rayon (list (cons  8  calque))))
(command "_change" (eval ss) "" "_p" "_elev" z "")

;;;	(command "_point" pins )
      )
  )
 )
 (pw_setvar2 "attreq" )
)
;********************************************************
;§**/SELECTIONS/ selectionne des éléments Nadiaa (selon filtre) au point pt / pt delta-mini delta-maxi filtre
;;effectue une selection par capture polygonale autour d'un point, avec un filtre, en étendant au maximum 4 fois le périmetre
;;de delta-min à delta-max, jusqu'a ce qu'il est trouvé qq chose
;;verifie avec pw_verif_select_crosspolygon
;;ex:(SELECT_CROSS_AROUND (getpoint) 0.1 0.5 '((8 . "E-BOUCLE")))
;;(SELECT_CROSS_AROUND (getpoint) 0.1 1.4 '((8 . "E-TRO*")))
;; si delta-mini = nil, ne cherche qu'une seule fois avec delta-maxi
;;(setq ss (SELECT_CROSS_AROUND (getpoint) nil 1.4 '((8 . "E-TRO*"))))

(defun select_cross_around
      (pt delta-mini delta-maxi filtre / ss delta inc-delta ls)
 (if delta-mini
   (progn
     (if (>= delta-mini delta-maxi)
(progn
  (setq delta-maxi delta-mini)
  (prompt
    "\nIncohérence dans select_cross_around,  delta-mini >= delta-maxi"
  )
)
     )
     (setq inc-delta (/ (- delta-maxi delta-mini) 3.0))
     (if (= 0.0 inc-delta)
(setq inc-delta 1.0)
     )
     (setq delta delta-mini)
   )
   (setq delta delta-maxi
  inc-delta 1000.0 ;_il ne servira qu'une fois
  )
 )
 (while (and (not ss) (<= delta delta-maxi))
   ;;cherche autour du point par un polygone
   (setq ls (pw_mk_lsomPolygon pt delta 8))
   (setq ss (ssget "_Cp" ls filtre))
   (if	ss
     (setq ss (verif_js_around_pt ss pt delta))
;;;	   (setq ss (pw_verif_select_crosspolygon  ss ls));_verifie que le ssget n'a pas été altéré par la taille des pixels (zoom extents)
   )
   (setq delta (+ delta inc-delta))
 )
 ss
)

;;********************************************************
;;§**/SELECTIONS/ verifie que le jeux de selection ss est bien proche de pt à delta pres / ss pt delta
;;retourne le js qui est conforme
;;le jeux de selction ss doit être uniquement composé de curve ou de multilignes
;;(verif_js_around_pt (ssget) (getpoint) 1.0)

(defun verif_js_around_pt (ss pt delta / js ljs)
 (setq pt (pw_pt_2d pt))
 (setq ljs (pw_listsel ss))
 (setq js (ssadd))
 (foreach l ljs
   (if	(setq ptacc (new_pro l pt))
     (if (<= (distance (pw_pt_2d ptacc) pt) delta)
(setq js (ssadd l js))
     )
   )
 )
 js
)

Olivier Eckmann · le 18 novembre 2016

Salut le Crabe,

Bizarre que dans ton tas de routine, tu n'en ai pas une qui associe un texte à la polyligne proche (ou chevauchante) sous forme de données d'objets. L'équivalent de la fonction MAP "Génération de lien" mais appliquée aux linéaires.

Olivier

lecrabe · le 18 novembre 2016

Hello Olivier

1) Qui a dit que je n'avais pas !

2) En fait je n'ai pas "exactement ou presque" ce que je demande ...

3) Malheuresement je suis incapable de modifier la routine "AEV/AutoElevate" ci-dessous pour :

- Avoir une selection AutoCAD classique

- Effacer un texte quand il a ete utilise pour monter une polyligne traitee

- Forcer (en Rouge) les Polylignes NON traitees

Si qq'un sait faire, SVP je suis preneur ...

Merci, Bye, lecrabe


;;;;;; http://www.cadtutor.net/forum/showthread.php?65776-Assigning-Elevations-to-Polylines-from-Text./page2

   ;; (c) Juan Villarreal
   ;; Routine "AutoElevate" will automatically elevate segments by selecting linework within a starting and max radius
   ;; of the midpoint of text or mtext objects
   ;; Starting radius = (/ textheight 4), radius increment = (/ radius 2), max radius = (* radius 25)
   ;; Currently searches using a decagon shape
   ;; (M)Text objects are skipped once max radius is reached.

   ;; Last edited by jvillarreal; 11th Jan 2012 at 06:54 pm. 

   ;; radius = 1.0   Rayon de recherche ???  ... voir aussi maxrad ... MYSTERIEUX !!!


(defun ssget->vla-list (ss / i ename allobj);Charles Alan Butler
(if ss
 (progn
      (setq i -1)
      (while (setq  ename (ssname ss (setq i (1+ i))))
        (setq allobj (cons (vlax-ename->vla-object ename) allobj))
      )
      allobj))
) 

(vl-load-com)

(defun c:autoelevate ( / linework number ent elist elevat circle newradius numlines
          ActDoc bb pt1 pt2 insxpt midpoint count maxrad radius)

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark ActDoc)
(vla-StartUndoMark ActDoc)
(setq count 0)
(vlax-for i (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (member (vla-get-objectname i) '("AcDbMText" "AcDbText"))
 (progn
  (vl-catch-all-apply 'vla-getboundingbox
   (list i 'minpoint 'maxpoint))
  (setq pt1 (vlax-safearray->list minpoint)
        pt2 (vlax-safearray->list maxpoint)
        midpoint (mapcar '(lambda (a B) (/ (+ a B) 2.0)) pt1 pt2)
        inc (/ (* pi 2) 10)
        radius (/ (vla-get-height i) 1.0);<-----------------------------------------------  Starting radius-Change as necessary
        newradius radius
        maxrad (* 2.0 radius);<----------------------------------------------------------  Maximum radius--Change as necessary
        elevat nil)
  (while (and (<= newradius maxrad)(null elevat))
   (setq plist nil n 0)
   (while (<= n 10)
          (setq n (1+ n) plist (append plist (list (polar midpoint (* inc n) newradius))))
   )
   (setq newradius (+ newradius (/ radius 2)))
   (and
    (setq linework
     (ssget->vla-list
      (ssget "_CP" plist (list (cons 0 "*POLYLINE")))))
    (setq number (vla-get-textstring i) elevat (atof number))
    (not (vla-put-elevation (nth 0 linework) elevat))
    (setq count (1+ count))
    (grtext -2 (strcat (itoa count) " Flat Segments Elevated. "))
   );and
  );while
 );progn
);if
);vlax-for
(vla-EndUndoMark ActDoc)
(princ (strcat "\nProcess Complete..." (itoa count) " Segments Elevated. "))
(princ)

);defun autoelevate
(defun c:aev ()(c:autoelevate))

GEGEMATIC · le 18 novembre 2016

Re salut vieux crabe,

je t'ai rajouté:

- un paramètre pour multiplier la hauteur du texte pour la recherche

- un filtre de calque pour ne pas attraper d'autre poly que le cniv

- ça efface les textes

- ca met en rouge les polylignes changéescar les autres on ne les connait pas ...

a+

Gégé

;;;;;; http://www.cadtutor.net/forum/showthread.php?65776-Assigning-Elevations-to-Polylines-from-Text./page2

   ;; (c) Juan Villarreal
   ;; Routine "AutoElevate" will automatically elevate segments by selecting linework within a starting and max radius
   ;; of the midpoint of text or mtext objects
   ;; Starting radius = (/ textheight 4), radius increment = (/ radius 2), max radius = (* radius 25)
   ;; Currently searches using a decagon shape
   ;; (M)Text objects are skipped once max radius is reached.

   ;; Last edited by jvillarreal; 11th Jan 2012 at 06:54 pm. 

   ;; radius = 1.0   Rayon de recherche ???  ... voir aussi maxrad ... MYSTERIEUX !!!


(defun ssget->vla-list (ss / i ename allobj facteur);Charles Alan Butler
(if ss
 (progn
      (setq i -1)
      (while (setq  ename (ssname ss (setq i (1+ i))))
        (setq allobj (cons (vlax-ename->vla-object ename) allobj))
      )
      allobj))
) 

(vl-load-com)

(defun c:autoelevate (/	       linework	number	 ent	  elist
	      elevat   circle	newradius	  numlines
	      ActDoc   bb	pt1	 pt2	  insxpt
	      midpoint count	maxrad	 radius	  j oPol calque
	     )

 (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
 (vla-EndUndoMark ActDoc)
 (vla-StartUndoMark ActDoc)
 (setq count 0)
 (setq	facteur
 (getreal
   "\nFacteur multiplicateur du rayon de recherche basé sur la hauteur du texte ?"
 )
 )
 (setq calque (getstring "\nFiltre de calque pour les polyligne (* ou ? acceptés)"))
 (prompt "\nSélectionnez les texte d'altitude")
 (ssget)
 (vlax-for i (vla-get-activeselectionset
	(vla-get-ActiveDocument (vlax-get-Acad-Object))
      )
   (if	(member (vla-get-objectname i) '("AcDbMText" "AcDbText"))
     (progn
(vl-catch-all-apply
  'vla-getboundingbox
  (list i 'minpoint 'maxpoint)
)
(setq pt1	(vlax-safearray->list minpoint)
      pt2	(vlax-safearray->list maxpoint)
      midpoint	(mapcar '(lambda (a B) (/ (+ a B) 2.0)) pt1 pt2)
      inc	(/ (* pi 2) 10)
      radius	(/ (vla-get-height i) 1.0)
				;<-----------------------------------------------  Starting radius-Change as necessary
      newradius	radius
      maxrad	(* facteur radius)
				;<----------------------------------------------------------  Maximum radius--Change as necessary
      elevat	nil
)
(while (and (<= newradius maxrad) (null elevat))
  (setq	plist nil
	n 0
  )
  (while (<= n 10)
    (setq n	(1+ n)
	  plist	(append	plist
			(list (polar midpoint (* inc n) newradius))
		)
    )
  )
  (setq newradius (+ newradius (/ radius 2)))
  (if
    (and
      (setq linework
	     (ssget->vla-list
	       (ssget "_CP" plist (list (cons 0 "*POLYLINE")(cons 8 calque)))
	     )
      )
      (setq number (vla-get-textstring i))
      (setq elevat (atof number))
    )				;and

     (progn
       (setq j 0)
       (while (< j (length linework))
	 (vla-put-elevation (setq oPol (nth j linework)) elevat)
	 (setq count (1+ count)
	       j     (1+ j)
	 )
	 (vla-put-color oPol 1)
       )

       (vla-erase i)
     )
  )
)				;while
     )					;progn
   )					;if
 )					;vlax-for
 (vla-EndUndoMark ActDoc)
 (princ (strcat "\nProcess Complete..."
	 (itoa count)
	 " Segments Elevated. "
 )
 )
 (princ)

)					;defun autoelevate
(defun c:aev ()(c:autoelevate))

GEGEMATIC · le 19 novembre 2016

J'ai l'impression que tu ne t'es pas aperçu que j'ai adapté ta routine, te pas la mienne !

donc elle est bien autonome

dis moi si ça marche chez toi aussi bien que chez moi !

lecrabe · le 19 novembre 2016

Hello

1) MERCI

2) J'ai bien vu la routine adaptee HIER

mais je n'ai pas de PC avec AutoCAD dispo !

3) Je teste la semaine prochaine ...

Mais j'ai confiance dans le vieux GEGE !!

Bon WE, Bye, lecrabe

Connexion

Elever 2DPoly depuis Texte Altitude proche ?

Messages recommandés

lecrabe

thierry.garré

lecrabe

GEGEMATIC

Olivier Eckmann

lecrabe

GEGEMATIC

GEGEMATIC

lecrabe

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante