Assigning Elevations to Polylines from Text.

[Bill_Myron]

Here is the situation. I have a survey that is 2d. The elevations are a simple text. The points are a polyline that is a circle.

 

I can change the elevation of the text to match what the text says it is, but the problem I have is that the "points" are not always at the justification point of the text. Therefore, if I made a surface of the text, I would not have the accurate point placement.

 

So I have this lsp to assign the elevations from the text to the polylines, but I was wondering how I would modify it to change the layers of the text and polyline that were jsut selected to a different layer. This way I can freeze the new layer and keep track of all the "points" I have already changed.

 

Any help would be much appreciatted!!

 

 

(defun c:ple (/ e_lst n new_elev ss)
 (prompt "\n>>>...Select Text for  Elevation...<<<")
 (while (not (setq ss (ssget "_:S:E" '((0 . "TEXT,MTEXT")))))
   (prompt "\n>>>...No Text selected...<<<")
 )
 (setq new_elev (cdr (assoc 1 (entget (ssname ss 0)))))
 (prompt "\n>>>...Select polylines to be changed...<<<")
 (if (setq ss (setq ss (ssget '((0 . "LWPOLYLINE")))))
   (repeat (setq n (sslength ss))
     (setq e_lst (entget (ssname ss (setq n (1- n)))))
     (entmod
(subst (cons 38 (atof new_elev)) (assoc 38 e_lst) e_lst)
     )
   )
 )
 (princ)
)

[jvillarreal]

This will automatically elevate polylines according to the nearest text elevation value.

;; © Juan Villarreal
;Routine 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.
(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))
)
(defun c:autoelevate ( / linework number ent elist elevat circle newradius numlines
          ActDoc bb pt1 pt2 insxpt midpoint count maxrad radius)
(vl-load-com)
(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) 4);<-------------------------------------------------Starting radius-Change as necessary
        newradius radius
        maxrad (* 25 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))

Edited January 11, 2012 by jvillarreal

[jvillarreal]

I know it's not exactly what you asked for, but you shouldn't have to keep track of the polylines that have already been changed. If you prefer not to use all *text in model space, this one will allow a selection set of text:

;; © Juan Villarreal
;Routine will automatically elevate flat 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.
(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))
)
(defun c:elevatess ( / linework number ent elist elevat circle newradius numlines
          ActDoc bb pt1 pt2 insxpt midpoint count maxrad radius)
(vl-load-com)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark ActDoc)
(vla-StartUndoMark ActDoc)
(setq count 0)
(foreach i (ssget->vla-list (ssget '((0 . "*TEXT"))))
  (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) 4);<--Starting radius-Change as necessary
        newradius radius
        maxrad (* 25 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 (atoi number))
    (not (vla-put-elevation (nth 0 linework) elevat))
    (setq count (1+ count))
    (grtext -2 (strcat (itoa count) " Flat Segments Elevated."))
   );and
  );while
);foreach
(vla-EndUndoMark ActDoc)
(princ (strcat "\nProcess Complete..." (itoa count) " Flat Segments Elevated."))
(princ)
);defun elevatess
(defun c:ess ()(c:elevatess))

[Bill_Myron]

Unfortunately, I cannot use that. Some of the text has been moved around for viewing purposes. The closest text is not necessarily the correct elevation. I just could not trust the elevetaions to be correct in some places.

[jvillarreal]

So the survey is in 2d AND someone moved the text elevations around?! [oocg]Sounds like some disciplinary action is in order... [/oocg]

Look up entmod.

[alanjt]

Are you able to post a sample of the drawing?

[Bill_Myron]

Here is a sample of part of the survey.

 

Note: I am using Civil3D 2011.

Drawing3.dwg

[BIGAL]

Ignoring the pline bit really you have points and text, problem is the text has been moved from the point so the relationship is lost, the tide is going out in a hurry and you forgot the big paddle.

 

Go back to where you got the dwg from and ask for it again but without changes, even more relevant where did the points come from in the first place maybe a data collector or maybe X,Y,Z txt file.

 

Theres multiple versions of read text and create 3dpoints 1 by me, AlanJT, Lee Mac etc and like wise read straight into CIV3d.

[Bill_Myron]

BIGAL, you are right. I could have figured out most of the elevations, but in some places it is down right impossible to figure out which goes with what.

 

I have given up and am requesting new info from these ******s.

 

 

Thanks!

[Ricardo Machado]

Hello jvillareal,

 

I'm trying to assign the elevation values written in text boxes to the closest polylines. I have tried using your code but it didn't work for me. No error messages appeared but it simply didn't process anything. I'm using AUTOCAD2015, I don't know if that could be the reason.

Anyway, if you have a newer version that works that you don't mind sharing or if you have an idea of what might be going wrong I appreciate your input.

 

Thank you very much,

Ricardo Machado

[Jaccen]

Hello jvillareal,

 

I'm trying to assign the elevation values written in text boxes to the closest polylines. I have tried using your code but it didn't work for me. No error messages appeared but it simply didn't process anything. I'm using AUTOCAD2015, I don't know if that could be the reason.

Anyway, if you have a newer version that works that you don't mind sharing or if you have an idea of what might be going wrong I appreciate your input.

 

Thank you very much,

Ricardo Machado

 

I have attempted to use it with Civil3D 2015 and it works for contour generation (ie. one 2D polyline near one piece of elevation text gets assigned that elevation). It does not seem to to work with 3d polylines and create a vertex beside the text with that elevation.

[Least]

sample.dwg

 

 

Hi, I was wondering if this lisp could be modified to instead of elevating the nearest polyline segment, it would instead elevate the nearest defined block by its insertion point or nearest point?

I have a drawing with blocks and text in 2d, I wish to take the nearby text value and apply the value to the blocks z coordinate. Alsoan option to apply to points instead of blocks as well would be a bonus.

Any help would be appreciated, I can't follow the lisp well enough to make the changes myself. I have attached an example drawing.

 

 

Thanks

 

 

I know it's not exactly what you asked for, but you shouldn't have to keep track of the polylines that have already been changed. If you prefer not to use all *text in model space, this one will allow a selection set of text:

;; © Juan Villarreal
;Routine will automatically elevate flat 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.
(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))
)
(defun c:elevatess ( / linework number ent elist elevat circle newradius numlines
          ActDoc bb pt1 pt2 insxpt midpoint count maxrad radius)
(vl-load-com)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark ActDoc)
(vla-StartUndoMark ActDoc)
(setq count 0)
(foreach i (ssget->vla-list (ssget '((0 . "*TEXT"))))
  (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) 4);<--Starting radius-Change as necessary
        newradius radius
        maxrad (* 25 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 (atoi number))
    (not (vla-put-elevation (nth 0 linework) elevat))
    (setq count (1+ count))
    (grtext -2 (strcat (itoa count) " Flat Segments Elevated."))
   );and
  );while
);foreach
(vla-EndUndoMark ActDoc)
(princ (strcat "\nProcess Complete..." (itoa count) " Flat Segments Elevated."))
(princ)
);defun elevatess
(defun c:ess ()(c:elevatess))

[harshad]

you want that text written value at it's z value??

[BIGAL]

Try this. You would have been better starting a new post this is 3 years old and a bit different request if I have read it right.

 

(defun c:test ( / ss ss2 obj obj2 pt1 pt2)
(setq ss (ssget "x" (list (cons 0 "insert")(cons 2 "058"))))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object(ssname ss (setq x (- x 1)))))
(setq pt1 (vlax-safearray->list (vlax-variant-value(vla-get-insertionpoint obj))))
(setq pt1 (list (car pt1)(cadr pt1)))
(setq pt2(polar (polar pt1 (* 1.5 PI)0.5) 0.0 1.5))
(setq ss2(ssget "F" (list pt1 pt2)(list(cons 0 "*TEXT"))))
(setq obj2 (vlax-ename->vla-object (SSNAME SS2 0)))
(setq txtstr (atof (vla-get-textstring obj2)))
(setq xyz (list(car pt1)(cadr pt1) txtstr))
(vla-put-insertionpoint obj (vlax-3D-point xyz))
(princ x)
(setq ss2 nil)
)
)
(c:test)

[ronjonp]

Here's another:

(defun c:foo (/ _ss2l c p p2 s1 s2)
 (defun _ss2l (s) (cond ((= 'pickset (type s)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))))
 (cond	((and (setq s1 (_ss2l (ssget "_A" '((0 . "text")))))
      (setq s2 (_ss2l (ssget "_A" '((0 . "insert,point")))))
      (setq s2 (mapcar '(lambda (x) (cons (cdr (assoc 10 (entget x))) x)) s2))
 )
 (foreach a s1
   (setq p (cdr (assoc 10 (entget a))))
   (setq c (car (vl-sort s2 '(lambda (r j) (< (distance p (car r)) (distance p (car j)))))))
   (setq p2 (list (caar c) (cadar c) (atof (cdr (assoc 1 (entget a))))))
   (entmod (append (entget (cdr c)) (list (cons 10 p2))))
   (entmakex (list '(0 . "line") '(62 .  (cons 10 p) (cons 11 p2)))
 )
)
 )
 (princ)
)

[Least]

Thanks guys I will give them a go shortly. Sorry I should have also provided an 'after' sample. The key is moving the point or block to the height taken from closest text string. Cheers P

[Least]

Wow fantastic Ron. Thats works amazingly well and the line connecting the points is a great way of checking them.

 

 

BIGAL, I am getting an error with your version.

 

Command: TEST bad argument type: lselsetp nil

 

 

Many thanks to both of you for your time with this, very useful lisp.

 

 

Cheers

P

[ronjonp]

Glad to help

[BIGAL]

Figured it out the text is randomly placed around the block I tested on a few points with text at the same location, will change the code. I work 99% with points like this but they always have a standard pattern.

[Least]

Hi Bigal, separate text and point is always a pain if you want to do anything with the data, but what can you do if that is what has been provided.

They have moved the level blocks around for presentation purposes. Lisps like this one do help enormously. Cheers.