Jump to content

Spot level creation using known gradient


Recommended Posts

jeppo71

I have seen various lisps for creating levels etc but can't find one for creating a proposed spot level, based on a known starting level, an inputed gradient and the distance between the points measured on the screen. If the proposed spot level can be placed with a point at the specific second point that has been measured to, then even better that would be perfect. Anybody got any ideas. Thanks

Link to post
Share on other sites
BIGAL

2 points its a ratio of the Z diff *  newdist / total dist for Z same for distnace away form point.

 

If a point has  a gradient say angle then its a cos sin thing for Z same again ratio of dist/total for distance away. Use  the angle pt-pt2

 

So come up with the formulas and then a lisp is easy. Post a dwg or images at least of what you want.

Edited by BIGAL
Link to post
Share on other sites
jeppo71

Thanks for the response, so starting with the first level of 125.80 which is inputed by the user, then the user specifies the gradient, 1 in 20 in this instance. The user then measures the distance to where the second spot level is needed, then the second spot level is placed at the specified point. 

 

image.thumb.png.5638e2839a4ae3bac24163b0f23e973b.png

Link to post
Share on other sites
Kajanthan

Try This

 

1040175932_Screenshot(13).thumb.png.c8f3885fbe05a8a11aa2cb659a1401c3.png

 

code

(defun Layer (Nme Col Ltyp LWgt Plt)
	(if (not (tblsearch "LAYER" Nme))
		(entmake	(list (cons 0 "LAYER")
					(cons 100 "AcDbSymbolTableRecord")
					(cons 100 "AcDbLayerTableRecord")
					(cons 2  Nme)
					(cons 70 0) 
					(cons 62 Col)
					(cons 6 Ltyp)
					(cons 290 Plt)
					(cons 370 LWgt))
		)
		(prompt (strcat "\n" Nme " - Layer Already created"))
	)
	(princ)
)

(setq k_layer '(("Start Level"  6 1)
			  ("End Level"  5 1)
			  ("Gradient"  3 1)
			  ("Arow"  2 1)
	      )
)






(defun c:gt ( / p q g m)

(foreach klayer k_layer (Layer (car klayer) (cadr klayer) "Continuous" 0 (caddr klayer)))

(setq svnames '(osmode cmdecho blipmode plinewid vtenable) svvals (mapcar 'getvar svnames))


(setq p (getpoint "\nPick Start Point :  "))
(mtxt (rtos (car p) 2 2) "Start Level" p 1 0)
(setq q (getpoint "\nPick End Point :  "))
(mtxt (rtos (car q) 2 2) "End Level" q 1 0)
(mapcar 'setvar svnames '(0 0 0 0 0))
(setq g (/ 	(- (car q) (car p)) 	(- (cadr q) (cadr p)) ))
(setq m (polar p (angle p q) (/ (distance p q) 2.) ))
(setq m (polar m (- (angle p q) (* pi 0.5)) -1.0))
(princ m)
(mtxt (strcat "1:" (rtos g 2 0)) "Gradient" m 1 (angle p q))
						(entmakex
							(list
								(cons 0 "LWPOLYLINE")
								(cons 100 "AcDbEntity")
								(cons 100 "AcDbPolyline")
								(cons 8 "Arow")
								(cons 90 3)
								(cons 70 1)
								(cons 40 0.1)
								(cons 41 0.1)
								(cons 10 (polar p (angle p q) (- (/ (distance p q) 2.) 1.5) ))
								(cons 40 0.1)
								(cons 41 0.1)
								(cons 10 (polar p (angle p q) (+ (/ (distance p q) 2.) 0.5) ))
								(cons 40 0.5)
								(cons 41 0.0)
								(cons 10 (polar p (angle p q) (+ (/ (distance p q) 2.) 1.5) ))
								(cons 40 0.0)
								(cons 41 0.0)

							)
						)



(mapcar 'setvar svnames svvals)
)









(defun mtxt (nVal nLayer nIns cTh nAng)
(entmake (list
			'(0 . "MTEXT")
			 '(100 . "AcDbEntity")
			 '(67 . 0)
			 '(410 . "Model")
			 (cons 8 nLayer)
			 '(100 . "AcDbMText")
			 (cons 10 nIns)
			 (cons 40  cTh)
			 '(41 . 1.0)
			 '(71 . 5)
			 '(72 . 5)
			 (cons 1 nVal)
			 '(7 . "STANDARD")
			 '(210 0.0 0.0 1.0)
			 '(11 1.0 0.0 0.0)
			 '(42 . 0.1)
			 '(43 . 0.1)
			 (cons 50 nAng)
			 '(73 . 1)
			 '(44 . 1.0))
)
)

(prompt "\n Type 'GT' to start")

file here

Gradient.lsp

Link to post
Share on other sites
dan20047

Not what you asked, but FYI I use a spreadsheet for my grading, entering either heights or slopes to get new elevations. Has the benefit you can cross reference the heights and distances to allow revisions to all the heights and/or solve from different directions. 

Here is a link: Grading

Blue = data to enter

Red / Magenta = formulas

 

grading.png

Link to post
Share on other sites
jeppo71

Thanks Kajanthan and Dan20047 for the replies. I do use a similar kind of spreadsheet as yours for easy reference. Kajanthan the lisp routine is great but it is picking up the gradient of the x value (eastings) instead of the gradient of the level which is the z value. Thank you for your help anyway. 😉

Link to post
Share on other sites
BIGAL

Need a dwg as it is unknown where you get the Z from is it in the "+" marker or do you need to pick marker and then the text, the angle would be pick the 2nd "+".

 

This would mean the code posted could be changed to get the correct point values and no need for manually entering levels.

Edited by BIGAL
Link to post
Share on other sites
jeppo71

As we manually input the proposed levels on the external levels drawing, it would be best if the level could be read from the text value, then the measurement can be made from the points. All I need the lisp routine to do is give me the end level at the inputted gradient. Thanks for your help. 

spot level.dwg

Link to post
Share on other sites
BIGAL

Just added a simpler starting sequence just window the text and point as a selection or pick. Thanks Kajanthan for the arrow.

 

; draw a point by grade
; By AlanH April 2021

(defun xyz ( /  obj1 obj2 objname )
(if (= (sslength ss) 2)
  (progn
    (setq obj1 (vlax-ename->vla-object (ssname ss 0)))
    (setq objname (vla-get-objectname obj1))
 
      (if(= objname "AcDbMText")(setq z (atof (vla-get-textstring obj1))))
	  (if (= objname "AcDbText") (setq z (atof (vla-get-textstring obj1))))
      (if (= objname "AcDbPoint")(setq pt1 (vlax-get obj1 'coordinates)))

    (setq obj2 (vlax-ename->vla-object (ssname ss 1)))
    (setq objname (vla-get-objectname obj2))
      (if (= objname "AcDbMText")(setq z (atof (vla-get-textstring obj2))))
	  (if (= objname "AcDbTEXT") (setq z (atof (vla-get-textstring obj2))))
      (if (= objname "AcDbPoint")(setq pt1 (vlax-get obj2 'coordinates)))
  )
  (alert "to many objects picked ")
)
(setq x (car pt1) Y (cadr pt1))
;(princ (strcat "\nyou now have X Y & Z " (rtos x 2 2)" " (rtos y 2 2) " " (rtos z 2 2)))
(princ)
)

;;;; Starts here

(defun c:grads ( / pt1 pt2 z xy mp dist ang ss)
(setq ss (ssget '((0 . "*TEXT,POINT"))))

(setq oldaunits (getvar 'aunits))
(setvar 'aunits 3)

(xyz)
(command "-layer" "M" "Arrow" "")

(setq pt2 (getpoint pt1 "Pick 2nd point for ang and distance "))
(setq ang (angle pt1 pt2))
(setq dist (distance pt1 pt2))

(setq grad (getreal "\nEnter gradient X ie 1:X "))
(setq Z (+ Z (/ dist grad)))

(command "point" pt2)
(command "text" pt2 0.5 0.0 (rtos z 2 3))

(setq mp (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5)))

(entmakex
		(list
		(cons 0 "LWPOLYLINE")
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbPolyline")
		(cons 8 "Arrow")
		(cons 90 3)
		(cons 70 1)
		(cons 40 0.1)
		(cons 41 0.1)
		(cons 10 (polar mp ang (-  1.5) ))
		(cons 40 0.1)
		(cons 41 0.1)
		(cons 10 (polar mp ang  0.5 ))
		(cons 40 0.5)
		(cons 41 0.0)
		(cons 10 (polar mp ang 1.5 ))
		(cons 40 0.0)
		(cons 41 0.0)
		)
)

(setq pt2 (polar mp (+ ang (/ pi 2.0)) 0.5))
(command "text" pt2 0.5 ang (strcat "1:" (rtos grad 2 1)))

(setvar 'aunits oldaunits)
(princ)
)

 

Edited by BIGAL
  • Funny 1
Link to post
Share on other sites
jeppo71

Thanks Bigal only issue though is there is an extra right paren on input which I'm unable to see which it is.

Link to post
Share on other sites
BIGAL

Sorry left some test stuff in it removed working now only thing to add is a "text readable".

 

POST UPDATED.

  • Thanks 1
Link to post
Share on other sites
jeppo71

Many thanks for this its very good. The only tweak I would make would be to change the arrow direction if possible. On a positive gradient entry if the arrow can be rotated 180 degrees, and for a negative gradient the arrow just remain as you've showed it. We always show the arrow pointing to the low point. Don't worry if it's an issue I can work with what I have an just rotate the arrow manually. But in any case thank you for your help.😀

Link to post
Share on other sites
BIGAL

Sounds like a good time to learn lisp, if you  look at the (10 . in the pline entmake which is the arrow, you can just change the ang variable to (setq ang (- ang)) but you will need a test is grad -ve dont change, have a go. If get stuck post.

  • Thanks 1
Link to post
Share on other sites

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...