# Level lines -calculate height

## Recommended Posts

Hi to everyone

Does anyone have or know of a LISP application that

will making the selection of a group of level lines, it is possible to click freely among them, and the application calculates (and writes in the drawing) the height by interpolation of the two pairs of points closer to the adjacent level curves.

- select Pair of points (two texts) and calculate the beween elevetions (photo1)

- select level lines (polilynes with angle of inclination) and calculate the beween elevetions (photo2)

Thanks

Edited by prodromosm

• Replies 33
• Created

• 12

• 11

• 3

• 3

#### Posted Images

Can any one Help !

##### Share on other sites

You're looking for a lisp routine that will calculate and input a spot elevation based upon a random point you select that falls between two contours. Does that accurately describe it?

##### Share on other sites

I need a lisp to do two things

1) if i have two points with elevetion text click the first elevetion text then the second elevetion text and when i click between them like the (photo 1) to caclulate the elevetion and write the text

2) if i have contours (polylines ith elevetion) to select them all and when i pick to any point writes me the correct elevetion

Is it possible?

##### Share on other sites

I believe the first one could be done but I don't know about the second.

##### Share on other sites

I need a lisp to do two things

1) if i have two points with elevetion text click the first elevetion text then the second elevetion text and when i click between them like the (photo 1) to caclulate the elevetion and write the text

2) if i have contours (polylines ith elevetion) to select them all and when i pick to any point writes me the correct elevetion

Is it possible?

I believe the same logic applies to both, for number 1) are the points elevated to correspond with the text value? are these attribute values? [bTW, i dont see any point entity on the snapshot], for number 2), yes, but whats confusing is the "select them all" part, or do you mean two at a time regardless if its adjacent to each other or not?

##### Share on other sites

I believe the same logic applies to both, for number 1) are the points elevated to correspond with the text value? are these attribute values? [bTW, i dont see any point entity on the snapshot], for number 2), yes, but whats confusing is the "select them all" part, or do you mean two at a time regardless if its adjacent to each other or not?

1) From the first (Pick the endpoints of the line)

2) I don't know what is possible (to select them all or two at a time)

##### Share on other sites

1) From the first (Pick the endpoints of the line)

There lies the problem prodromosm.

Hi to everyone

- select Pair of points (two texts) and calculate the beween elevetions (photo1)

I need a lisp to do two things

1) if i have two points with elevetion text click the first elevetion text then the second elevetion text and when i click between them like the (photo 1) to caclulate the elevetion and write the text

The first two statements pointing to the TEXT string as the source now you're saying its the Endpoints of the line?

To write an effective code you need the distance between two points. so can we assume if it is indeed the text entity the "point" will be the insertion point?

How about posting a sample drawing file to clear the confusion.

Edited by pBe
##### Share on other sites

How about posting a sample drawing file to clear the confusion.

Here is a sample drawing

contous.dwg

##### Share on other sites

Here is a sample drawing

Here is a simple code for item number 1. Not sure it'll work as you wanted>

```(defun c:LLCH (/ dxf txt np p1 p2 nld low high zhp zlp)
(setq dxf (lambda (x e) (cdr (assoc x (entget e)))))
(foreach itm '("High" "Low")
(while
(not
(and (setq txt
(car (entsel (Strcat "\nSelect " itm " String Value")))
)
(eq (dxf 0 txt) "TEXT")
(numberp (setq zv (read (dxf 1 txt))))
(setq pt (if (zerop (dxf 72 txt))
(dxf 10 txt)(dxf 11 txt)))
)
)
(princ "\nInvalid selection, Try again")
)
(set (read itm) (list pt zv txt))
)
(if (and
(setq p1 (list (caar low) (cadar low))
p2 (list (caar high) (cadar high))
)
(< (setq zlp (cadr low))
(setq zhp (cadr high))
)

)
(while (setq np (getpoint "\nPoint for new Mark: "))
(setq hld	(- zhp zlp)
d1	(+ (distance p1 np)(distance p2 np))
d2	(distance p1
(list (car np) (cadr np))
)
)
(vla-move
(progn
(vla-put-textstring
(setq nstr (vla-copy (vlax-ename->vla-object (last low))))
(rtos (+ (* (/ hld d1) d2) zlp) 2 3)
)
nstr
)
(vlax-3d-point (car low))
(vlax-3d-point np)
)
)
(princ "\n<<Invalid Sequence, Select High Value first>>")
)
(princ)
)
```

As for item number 2. Still doable, i still think its the same logic, say, what about upgrading to Civil 3D?

EDIT: For attribute or text

```(defun c:LLCH (/ dxf txt np p1 p2 nld low high zhp zlp  tag typ)
(setq dxf (lambda (x e) (cdr (assoc x (entget e)))))
(foreach itm '("High" "Low")
(while
(not
(and (setq txt
(car (nentsel (Strcat "\nSelect " itm " String Value")))
)
(setq typ (Car (member (dxf 0 txt) '("TEXT" "ATTRIB"))))
(numberp (setq zv (read (dxf 1 txt))))
(setq
pt (if (eq typ "ATTRIB")
(vlax-get (setq txt	(vla-ObjectIdToObject
(vla-get-ActiveDocument
)
(vla-get-OwnerId
(setq atb (vlax-ename->vla-object
txt
)
)
)
)
)
'Insertionpoint
)
(if	(zerop (dxf 72 txt))
(dxf 10 txt)
(dxf 11 txt)
)
)
)
)
)
(princ "\nInvalid selection, Try again")
)
(set (read itm) (list pt zv txt))
)
(if (and
(setq p1 (list (caar low) (cadar low))
p2 (list (caar high) (cadar high))
)
(< (setq zlp (cadr low))
(setq zhp (cadr high))
)

)
(progn
(setq target
(if (and atb (setq att (eq (type (last low)) 'Vla-object)))
(last low)
(vlax-ename->vla-object (last low))
)
)
(while (setq np (getpoint "\nPoint for new Mark: "))
(setq hld	(- zhp zlp)
d1	(+ (distance p1 np) (distance p2 np))
d2	(distance p1
(list (car np) (cadr np))
)
)
(vla-move
(progn
(setq	nstr (vla-copy target ))
(vla-put-textstring
(if	att
(progn
(setq tag (vla-get-tagstring atb))
(vl-some '(lambda (x)
(if	(eq (vla-get-tagstring x) tag)
x
)
)
(vlax-invoke nstr 'Getattributes)
)
)
nstr
)

(rtos (+ (* (/ hld d1) d2) zlp) 2 3)
)
nstr
)
(vlax-3d-point (car low))
(vlax-3d-point np)
)
)
)
(princ "\n<<Invalid Sequence, Select High Value first>>")
)
(princ)
)
```

Edited by pBe
Insertion/alignment issue'/Attribute or TEXT
##### Share on other sites

Nice try but i think that the calculation is wrong. Can you do something for the second part.

##### Share on other sites

Nice try but i think that the calculation is wrong. Can you do something for the second part.

I see, show me the correct value if i select the middle of the line? 150.20?

I see why.i'm guessing ts a TEXT alignment point/Insertion point issue. changing 10 to 11 is the quick fix.

Code at post #10 updated

Edited by pBe
##### Share on other sites

With the yellow collor is your results. Some calculations are the same with mine but same other are difference.I add some red points to speak about specific position

contous2.dwg

Edited by prodromosm
##### Share on other sites

With the yellow collor is your results. Some calculations are the same with mine but same other are difference.I add some red points to speak about specific position

Update code at post # 10

##### Share on other sites

nice job pBe thanx.The first part of my question is complete.....

Can you do something for the second part.

- select level lines (polilynes with angle of inclination) and calculate the beween elevetions

##### Share on other sites

nice job pBe thanx.The first part of my question is complete.....

Can you do something for the second part.

- select level lines (polilynes with angle of inclination) and calculate the beween elevetions

Glad it works for you.

Wanted to get the feedback on item number 1 first, I'll post a code for number 2 later.

##### Share on other sites

that's really good, but can it be made for block attributes 'instead of / as well as' text?

thanks

Here is a simple code for item number 1. Not sure it'll work as you wanted>

```(defun c:LLCH (/ dxf txt np p1 p2 nld low high zhp zlp)
(setq dxf (lambda (x e) (cdr (assoc x (entget e)))))
(foreach itm '("High" "Low")
(while
(not
(and (setq txt
(car (entsel (Strcat "\nSelect " itm " String Value")))
)
(eq (dxf 0 txt) "TEXT")
(numberp (setq zv (read (dxf 1 txt))))
(setq pt (if (zerop (dxf 72 txt))
(dxf 10 txt)(dxf 11 txt)))
)
)
(princ "\nInvalid selection, Try again")
)
(set (read itm) (list pt zv txt))
)
(if (and
(setq p1 (list (caar low) (cadar low))
p2 (list (caar high) (cadar high))
)
(< (setq zlp (cadr low))
(setq zhp (cadr high))
)

)
(while (setq np (getpoint "\nPoint for new Mark: "))
(setq hld	(- zhp zlp)
d1	(+ (distance p1 np)(distance p2 np))
d2	(distance p1
(list (car np) (cadr np))
)
)
(vla-move
(progn
(vla-put-textstring
(setq nstr (vla-copy (vlax-ename->vla-object (last low))))
(rtos (+ (* (/ hld d1) d2) zlp) 2 3)
)
nstr
)
(vlax-3d-point (car low))
(vlax-3d-point np)
)
)
(princ "\n<<Invalid Sequence, Select High Value first>>")
)
(princ)
)
```

As for item number 2. Still doable, i still think its the same logic, say, what about upgrading to Civil 3D?

##### Share on other sites

that's really good, but can it be made for block attributes 'instead of / as well as' text?

thanks

Yes it can be done, but what will be the reference for the distance? is it the block insertion point? [refer to second code at post # 10]

@prodromosm

Item number 2: based on your example. "elevation" between contor 1 and contour 2 you have 110.8, automating the process can be quite tricky . if i to write a code i will determine half the distance between contour lines which makes a dead even 110.00. and so on. Now if you add an option to indicate a "distance from" or divide the space by # then we can proceed to do that. IF you are wanting to pick a point between each contour at every interval, that will give the distance per level, is that how you wanted it to work for you?

Edited by pBe
##### Share on other sites

yes block insertion point

P

##### Share on other sites

Good code, pBe.

This is my attempt for item number 2.

Does not always work.

Here it works.

Here it does not work.

```(defun c:test ( / p1 p2 d sel LEV LEV_F LEV_L TT)
(if
(and
(setq p1 (getpoint "\nSelect Level Lines, first fence point:"))
(setq p2 (getpoint p1 "\nSpecify endpoint of line:"))
(setq d (distance p1 p2))
(if (setq sel (ssget "_F" (list p1 p2) '((0 . "LWPOLYLINE"))))
(progn
(repeat (setq n (sslength sel))
(setq LEV (cons (ssname sel (setq n (1- n))) LEV))
)
(setq LEV (reverse LEV))
)
)
(setq LEV_F (car LEV))
(setq LEV_L (last LEV))
(if
(>
(cdr (assoc 38 (entget LEV_L)))
(cdr (assoc 38 (entget LEV_F)))
)
(setq segno -)
(setq segno +)
)
)
(progn
(setq TT
(vlax-ename->vla-object
(entmakex
(list
(cons 0 "TEXT")
(cons 7 (getvar "textstyle"))
(cons 10 p2)
(cons 11 p2)
(cons 40 2.5)
(cons 1 "")
(cons 73 2)
(cons 72 1)
(cons 50 0)
)
)
)
)
(princ "\nText position: ")
(while (= (car (setq pt (grread T 12 0))) 5)
(vla-put-TextAlignmentPoint TT (vlax-3d-point (cadr pt)))
(vla-put-TextString TT (location))
)
(if (= (vla-get-TextString TT) "OUT") (vla-delete TT))
)
)
(prompt "\n ")(prompt "\n ")
(princ)
)
;***************************************************************************
(defun location ( / pa ang pb pc e1 e2 elev_a elev_b diff p_1 p_2 elev+ elev)
(setq pa (cadr pt))
(setq ang
(angle
(vlax-curve-getClosestPointTo LEV_F pa)
(vlax-curve-getClosestPointTo LEV_L pa)
)
)
(setq pb (polar pa ang d))
(setq pc (polar pa (- ang pi) d))
(if
(and
(setq e1 (ssget "_F" (list pa pb) '((0 . "LWPOLYLINE"))))
(setq e1 (ssname e1 0))
(setq e2 (ssget "_F" (list pa pc) '((0 . "LWPOLYLINE"))))
(setq e2 (ssname e2  0))
)
(progn
(setq elev_a (cdr (assoc 38 (entget e1))))
(setq elev_b (cdr (assoc 38 (entget e2))))
(setq diff (abs (- elev_a elev_b)))
(setq p_1 (LEV_inters pa pb (pl_coord e1)))
(setq p_2 (LEV_inters pa pc (pl_coord e2)))
(if (and p_1 p_2)
(setq elev+ (/ (* (distance p_1 pa) diff) (distance p_1 p_2))
elev (rtos (segno elev_a elev+))
)
)
)
"OUT"
)
)
;***************************************************************************
(defun LEV_inters (:p1 :p2 vPL / p_int *p*)
(mapcar
'(lambda (a b)
(setq *p*
(inters
(list (car a) (cadr a))
(list (car b) (cadr b))
:p1
:p2
)
)
(if *p* (setq p_int *p*))
)
vPL  (cdr vPL)
)
p_int
)
;***************************************************************************
(defun pl_coord (# / p m)
(setq p (if (vlax-curve-IsClosed #)
(fix (vlax-curve-getEndParam #))
(1+ (fix (vlax-curve-getEndParam #)))
)
)
(while (/= 0 p)
(setq m (cons (vlax-curve-getPointAtParam # (setq p (1- p))) m))
)
)
```

## Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Reply to this topic...

×   Pasted as rich text.   Restore formatting

Only 75 emoji are allowed.