Little complicated lisp...assign Z coord to a point

[Lee Mac]

Thanks Eldon for solving the problem.

 

Goldy in reference to my original code -

 

The Layer was the layer that the Z-elevation text was on, and you would select the point, and it would pick the closest text item to each point and use its value as the Z-coord.

 

Lee

[eldon]

The trouble with Survey drawings is that the elevation text is moved around for legibility. It is sometimes rotated as well. This is why a purely automatic solution may not cater for every situation found. A manual tool is very handy.

[alanjt]

I have a very simple routine I use to elevate flat contours, based on elevation of text object.

Here's a modified version of that (will allow you to select the point and text object at the same time):

 

(defun c:EP (/ #SS #Elev)
 (vl-load-com)
 (and
   (setq #SS (ssget "_:L" '((0 . "POINT,TEXT"))))
   (foreach x (setq #SS (mapcar 'vlax-ename->vla-object
                                (vl-remove-if 'listp (mapcar 'cadr (ssnamex #SS)))
                        ) ;_ mapcar
              ) ;_ setq
     (if (vlax-property-available-p x 'TextString)
       (setq #Elev (atof (vla-get-textstring x)))
     ) ;_ if
     T
   ) ;_ foreach
   (or #Elev (setq #Elev (getreal "\nElevation: ")))
   (foreach x #SS
     (if (eq "AcDbPoint" (vla-get-objectname x))
       (progn
         (vla-put-coordinates
           x
           (vlax-3d-point
             (reverse
               (cons
                 #Elev
                 (cdr (reverse (vlax-safearray->list (vlax-variant-value (vla-get-coordinates x))))
                 ) ;_ cdr
               ) ;_ cons
             ) ;_ reverse
           ) ;_ vlax-3d-point
         ) ;_ vla-put-coordinates
         [color=Red](vla-put-color x 6)[/color]
       ) ;_ progn
     ) ;_ if
   ) ;_ foreach
 ) ;_ and
 (princ)
) ;_ defun

Forgot to mention, you don't have to use the line where it changes the point to color 6 (just comment it out). I just use that to keep track of what I have and have not edited.

 

Oh yeah, it will also prompt you for the elevation if a text object is not selected.

[wizman]

Here is a quick lisp just to reduce the one by one work. This will not be processing the points which are close to more than 1 text.

 

 

(defun c:zpt (/ zpt_dta zpt_ll_ur zpt_pt zpt_set zpt_txt)
   ;;
   ;;
   (vl-load-com)
   ;;
   ;;
   (if
       (setq zpt_set (ssget '((0 . "POINT"))))
          ;;
          ;;
          (foreach x (vl-remove-if
                         (function listp)
                         (mapcar (function cadr) (ssnamex zpt_set))
                     ) ;_ vl-remove-if
              (setq zpt_ll_ur
                       (mapcar
                           (function
                               (lambda (a)
                                   (polar (setq zpt_pt (cdr (assoc 10 (setq zpt_dta (entget x))))) a 1.)
                               ) ;_ lambda
                           ) ;_ function
                           '(3.4383 0.2443)
                       ) ;_ mapcar
              ) ;_ setq
              ;;
              ;;
              (vla-ZoomWindow
                  (vlax-get-acad-object)
                  (vlax-3d-point (car zpt_ll_ur))
                  (vlax-3d-point (cadr zpt_ll_ur))
              ) ;_ vla-ZoomWindow
              ;;
              ;;
              (if (setq zpt_txt (ssget "C" (car zpt_ll_ur) (cadr zpt_ll_ur) '((0 . "TEXT") (8 . "VISINE00"))))
                  (if (= (sslength zpt_txt) 1)
                      (progn
                          (entmod
                              (subst
                                  (cons 10
                                        (reverse
                                            (cons (read (cdr (assoc 1 (entget (ssname zpt_txt 0)))))
                                                  (cdr (reverse zpt_pt))
                                            ) ;_ cons
                                        ) ;_ reverse
                                  ) ;_ cons
                                  (assoc 10 zpt_dta)
                                  zpt_dta
                              ) ;_ subst
                          ) ;_ entmod
                      ) ;_ progn
                  ) ;_ if
              ) ;_ if
          ) ;_ foreach
   ) ;_ if
   ;;
   ;;
   (princ)
) ;_ defun
(prompt ">>>...Zpt.lsp is now loaded, Type ZPT to start command...<<<")
(princ)
;;;WIZ_17DEC09

[alanjt]

Oh yeah, here's my sad attempt of mainstreaming it. It will work if there aren't too many objects, but it craps out when it gets several and congested.

 

I used change to alter the elevation only because it was a quick way to test how the matching was working.

Thought I'd post it anyway...

 

 

 ;http://www.cadtutor.net/forum/showthread.php?t=43103
(defun c:TESt (/ _FlatDist _FlatPnt _Sort #EntPoint #EntText #SSPoint #SSText #ListPoint #ListText)
 (setq _FlatDist (lambda (x y) (distance (list (car x) (cadr x)) (list (car y) (cadr y))))
       _Sort     (lambda (l)
                   (vl-sort l
                            '(lambda (x y) (> (_FlatDist (car x) '(0 0 0)) (_FlatDist (car y) '(0 0 0))))
                   ) ;_ vl-sort
                 ) ;_ lambda
 ) ;_ setq
 (setq _FlatPnt (lambda (x) (list (car x) (cadr x))))
 (setq _Sort2
        (lambda (l)
          (vl-sort l
                   '(lambda (x y) (> (apply '+ (_FlatPnt (car x))) (apply '+ (_FlatPnt (car y)))))
          ) ;_ vl-sort
        ) ;_ lambda
 ) ;_ setq
 (cond
   ((and
;(setq #EntPoint (car (AT:Entsel nil "\nSelect point object on layer to process: " '((0 . "POINT")) nil)))
;(setq #EntText (car (AT:Entsel nil "\nSelect text object on layer to process: " '((0 . "TEXT")) nil)))
      (setq #EntPoint (car (entsel "\nSelect point object on layer to process: ")))
      (eq "POINT" (cdr (assoc 0 (entget #EntPoint))))
      (setq #EntText (car (entsel "\nSelect text object on layer to process: ")))
      (eq "TEXT" (cdr (assoc 0 (entget #EntText))))
      (setq #SSPoint (ssget "_X" (list '(0 . "POINT") (assoc 8 (entget #EntPoint)))))
      (setq #SSText (ssget "_X" (list '(0 . "TEXT") (assoc 8 (entget #EntText)))))
    ) ;_ and
;(vl-cmdf "_.justifytext" #SSText "" "_mc")
    ;; process points
    (foreach x (mapcar 'cadr (ssnamex #SSPoint))
      (setq #ListPoint (cons (cons (cdr (assoc 10 (entget x))) x) #ListPoint))
    ) ;_ foreach
    ;; process text
    (foreach x (mapcar 'cadr (ssnamex #SSText))
      (setq #ListText (cons (cons (cdr (assoc 10 (entget x))) x) #ListText))
    ) ;_ foreach
    ;; combine and change Z value of point
    (mapcar
      '(lambda (po to)
         (vl-cmdf "_.change" (cdr po) "" "_p" "_e" (atof (cdr (assoc 1 (entget (cdr to))))) "")
         (vl-cmdf "_.line" "_non" (car po) "_non" (car to) "")
       ) ;_ lambda
      (_Sort #ListPoint)
      (_Sort #ListText)
    ) ;_ mapcar
   )
 ) ;_ cond
 (princ)
) ;_ defun

[Lee Mac]

Why not just get the closest text, like my original code?

[alanjt]

Why not just get the closest text, like my original code?

 

I did. I just made separate selections for the text and points, then sorted them to match one another. It works sometimes, but it's far from perfect.

 

I tried yours and could only get a 0 elevation.

[Lee Mac]

I tried yours and could only get a 0 elevation.

 

 

Thats weird... I tested mine and got it working perfectly...

 

Bear in mind I did use a filter for the text layer - shown at the top.

[alanjt]

Thats weird... I tested mine and got it working perfectly...

 

Bear in mind I did use a filter for the text layer - shown at the top.

 

Didn't pay attention to that. Oops.

Yours works, mostly. Has the same problems I had of randomly there will be a few off. It's just too shaky of a scenario to try and completely mainstream. I really like your method.

[Lee Mac]

It's just too shaky of a scenario to try and completely mainstream. I really like your method.

 

Thanks dude - yeah, I knew it wouldn't be completely robust... esp for congested drawings...

[eldon]

Ok guys, this is an extract from Goldy2000's drawing.

 

The level of 11.31 clearly belongs to the point to its left, but I guess that your lisps would assign it to the point underneath it. Also the cluster of points to the bottom left would also be wrongly assigned.

 

I get very uneasy when an apparently easy way is offered to solve a problem universally. For accuracy, there is NO quick solution. Stick with the manual version. (You could polish that up, I would not mind)

[wizman]

Closest text may produce a mistake since text is justified at lower left, that's why we need to leave it to the user to manually do it on the congested part.

[alanjt]

I don't disagree with you, as you can see by my first post (just an attempt to save a selection, not made for selecting multiple).

http://www.cadtutor.net/forum/showpost.php?p=290854&postcount=23

 

I only posted the other code for the sake of posting it as an example. I stated that it doesn't really work.

 

Ok guys, this is an extract from Goldy2000's drawing.

 

The level of 11.31 clearly belongs to the point to its left, but I guess that your lisps would assign it to the point underneath it. Also the cluster of points to the bottom left would also be wrongly assigned.

 

I get very uneasy when an apparently easy way is offered to solve a problem universally. For accuracy, there is NO quick solution. Stick with the manual version. (You could polish that up, I would not mind)

[eldon]

Closest text may produce a mistake since text is justified at lower left, that's why we need to leave it to the user to manually do it on the congested part.

 

How do you sort out the congested part of the drawing from the uncongested?

[wizman]

run my lisp, then filter out the points with zero elevation to see which ones are not processed

[eldon]

How do you know that all z values assigned are correct, unless you inspect each one?

[wizman]

it is sure because of the idea that it is an automated zoom on each point then do an ssget "_c" and if there is double text within the window limits then it is not processed, a thousand point to me is an invitation to code it!...'-)

[eldon]

it is sure because of the idea that it is an automated zoom on each point then do an ssget "_c" and if there is double text within the window limits then it is not processed, a thousand point to me is an invitation to code it!...'-)

 

I am only sorry that you did not get your post in at the beginning. It would have saved my bumbling efforts

[eldon]

So it does appear that my offering, with ten lines of code, is the only one that can handle every single point successfully in one go.

[alanjt]

So it does appear that my offering, with ten lines of code, is the only one that can handle every single point successfully in one go.

 

http://www.cadtutor.net/forum/showpost.php?p=290854&postcount=23

My first was designed for just selecting the point and text object.