Level lines -calculate height

[Guest]

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 October 18, 2013 by prodromosm

[Guest]

Can any one Help !

[ReMark]

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?

[Guest]

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?

[ReMark]

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

[pBe]

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?

[Guest]

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)

[pBe]

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 October 20, 2013 by pBe

[Guest]

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

 

Here is a sample drawing

contous.dwg

[pBe]

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)
 (vl-load-com)
 (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)
 (vl-load-com)
 (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
				    (vlax-get-acad-object)
				  )
				  (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 October 21, 2013 by pBe
Insertion/alignment issue'/Attribute or TEXT

[Guest]

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

[pBe]

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 October 20, 2013 by pBe

[Guest]

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 October 20, 2013 by prodromosm

[pBe]

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

[Guest]

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

[pBe]

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.

[Least]

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)
 (vl-load-com)
 (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?

[pBe]

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 October 21, 2013 by pBe

[Least]

yes block insertion point

 

P

[GP_]

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))
   )
)