Jump to content

Interpolation Lisp Needed


johnshar123xx

Recommended Posts

AutoCAD 2007

Basically I am looking for some help in finding an interpolation lisp that will work in the order below. Not sure if anyone has something like this already that they could share. I have provided a couple interpolation lisps I have found, maybe they could help someone.

 

I am looking for an interpolation lisp that has steps in this order...

-click on first point

-enter elevation of the first point

-click on second point

-enter elevation of the second point

-have the lisp place a "x" node point or a letter "x" in the current text style assigned (with a middle center insertion point at its center) at all the whole numbers between the two points

 

For example if the first point = elevation 120.50 and the second point = elevation 123.00. The lisp will interpolate and place an "X" between the two points clicked, at elevation 121.00 and at 122.00

 

Thank You

interpol1.lsp

interpol2.lsp

interpol3.lsp

Link to comment
Share on other sites

see if this works for you

(defun c:test (/ pt1 el1 pnt1 pt1 el2 pnt2 len el1a slp d1)
 (vl-load-com)
 (setvar "osmode" 0)
 (setvar "pdmode" 3)
 (setq pt1 (getpoint "\nPick point 1: ")
   el1 (getreal "\nEnter elevation 1: ")
   pnt1 (list (car pt1) (cadr pt1) el1)
   pt2 (getpoint pt1 "\nPick point 2: ")
   el2 (getreal "\nEnter elevation 2: ")
   pnt2 (list (car pt2) (cadr pt2) el2)
   len (distance pnt1 pnt2)
       el1a (1+(fix el1))
       slp (/  (- el2 el1)(distance pnt1 pnt2))
   d1 (/ (- el1a el1) slp)
   )
 (setq obj (vlax-ename->vla-object
    (entmakex
      (list
        (cons 0 "LINE")
        (cons 10 pnt1)
        (cons 11 pnt2)
        )
      )
   )
   )
 (while (< d1 len)
        (entmakex
      (list
        (cons 0 "POINT")
        (cons 10 (vlax-curve-getPointAtDist Obj d1))
        )
      )
   (setq d1 (+ d1 (/ 1 slp)))
   )
 (princ)
 )

Link to comment
Share on other sites

WOW!, the lisp above is amazing. You even wrote the lisp to add the "z" elevation of the node points. I really can't believe how good this works, I didn't really think this one could be done so well.

 

Not sure how easily it can be done, but I was wondering, now that I see this lisp can be created, if anyone would be able to tweak it a little.

 

1. it wipes out the osnap settings when the lisp is activated, can it be edited to keep the existing osnap settings?

 

2. would it be possible to instead of entering the beginning two known spot shot elevations manually, can it detect the "z" elevations that are assigned to the node points, automatically?

 

Thank you so much for your help, you went above and beyond my expectations. I really can't believe how you were able to get this to work so well. Even without the above fixes, I am extremely satisfied with the results. I really appreciate it.

Link to comment
Share on other sites

If the 2 points have equal elevations, you'll get a 'divide by zero' error... I don't have the time now to include error control

(defun c:test (/ pt1 el1 pnt1 pt1 el2 pnt2 len el1a slp d1)
 (vl-load-com)
 (setq oldsnap (getvar "osmode"));[color=Red]tweak[/color]
 (setvar "osmode" 0)
 (setvar "pdmode" 3)
 (setq pt1 (getpoint "\nPick point 1: ")
   el1  (caddr pt1);(getreal "\nEnter elevation 1: ")[color=Red]tweak[/color]
   pnt1 (list (car pt1) (cadr pt1) el1)
   pt2 (getpoint pt1 "\nPick point 2: ")
   el2 (caddr pt2);(getreal "\nEnter elevation 2: ")[color=Red]tweak[/color]
   pnt2 (list (car pt2) (cadr pt2) el2)
   len (distance pnt1 pnt2)
       el1a (1+(fix el1))
       slp (/  (- el2 el1)(distance pnt1 pnt2))
   d1 (/ (- el1a el1) slp)
   )
 (setq obj (vlax-ename->vla-object
    (entmakex
      (list
        (cons 0 "LINE")
        (cons 10 pnt1)
        (cons 11 pnt2)
        )
      )
   )
   )
 (while (< d1 len)
        (entmakex
      (list
        (cons 0 "POINT")
        (cons 10 (vlax-curve-getPointAtDist Obj d1))
        )
      )
   (setq d1 (+ d1 (/ 1 slp)))
   )
 (setvar "osmode" oldsnap);[color=Red]tweak[/color]
 (princ)
 )

I hope you're 'dissecting' the code so you can learn from it... it really isn't that complicated

Link to comment
Share on other sites

How about this:

 

(defun c:test (/ p1 p2 i e n inc)
 (setvar "PDMODE" 3)

 (cond ((and (setq p1 (getpoint "\nPick Point 1: "))
             (setq p2 (getpoint "\nPick Point 2: " p1)))

        (setq i 0 e (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
              
              inc (/ (setq n (fix (abs (- (caddr p2) (caddr p1)))))
                     (distance p1 p2)))

        (while (< (setq i (1+ i)) n)
          (entmake (list (cons 0 "POINT")
                         (cons 10 (vlax-curve-getPointatDist e (/ i inc))))))))
 (princ))

Link to comment
Share on other sites

lpseifert

 

The lisp you supplied works great, it takes the "z" elevation assigned to the point. This also helps me learn, now that I can see what it takes to do this manually in the first lisp you wrote, and automatically in this one.

The new lisp you wrote did have a little problem with the osnap settings but I was able to fix it, by deleting the "setvar osmode 0" line.

Now the lisp works perfect.

 

Thank you so much for all your help, the lisp works great, I really appreciate it. In response to your comment, I am trying to learn about what it takes to create lisps. All the lisps I have been asking have a dual purpose, one is to obviously get more efficient drafting tools, but also to learn all the different codes based on the different scenarios I ask for.

 

Lee Mac

 

The lisp you supplied, works like lpseifert lisp above, but it places the "x" points with weird z elevations. Not a problem, everything works now. Thank you as well for your response.

 

 

One more thing, on another forum I was not aware that you could rate the help given. Is there anything I can rate users? I have been trying to help others but by time I read questions, they are already answered by others.

Link to comment
Share on other sites

Lee Mac

 

The lisp you supplied, works like lpseifert lisp above, but it places the "x" points with weird z elevations.

 

It seems to work OK for me, placing points at every integer elevation between selected points. I really just wanted to make lpseifert's Lisp more concise :)

Link to comment
Share on other sites

  • 3 months later...

is there any lisp program that interpolates the two points then with that result point and a slope, calculates the level of third point perpendicular to the line joining the first two points? It is for road kerb line level calculation. given the road center line FRLs. can anyone help me?

Link to comment
Share on other sites

  • 3 weeks later...

This lisp is amazing, but can anyone help me. I need to interpolate with 0.25 height difference. For example 21.25 21.50 21.75 22.00 .

 

I have been looking at this code for an hour now and I don't get it.

 

I could really use your help because I need to create a topographic map and I have to interpolate over 300 points.

Link to comment
Share on other sites

Are you referring to my code Ogre?

 

Sry for not specifying, I was up late. I am doing the interpolation in a 2D environment so I could really use the first code.

 

But if you could help me, then I would really appreciate it.

 

I think I got the code right:

 

(defun c:test (/ pt1 el1 pnt1 pt1 el2 pnt2 len el1a slp d1)
 (vl-load-com)
 (setvar "osmode" 0)
 (setvar "pdmode" 3)
 (setq pt1 (getpoint "\nPick point 1: ")
   el1 (getreal "\nEnter elevation 1: ")
   pnt1 (list (car pt1) (cadr pt1) el1)
   pt2 (getpoint pt1 "\nPick point 2: ")
   el2 (getreal "\nEnter elevation 2: ")
   pnt2 (list (car pt2) (cadr pt2) el2)
   len (distance pnt1 pnt2)
       el1a (+ 0.25 (fix el1))
       slp (/  (- el2 el1)(distance pnt1 pnt2))
   d1 (/ (- el1a el1) slp)
   )
 (setq obj (vlax-ename->vla-object
    (entmakex
      (list
        (cons 0 "LINE")
        (cons 10 pnt1)
        (cons 11 pnt2)
        )
      )
   )
   )
 (while (< d1 len)
        (entmakex
      (list
        (cons 0 "POINT")
        (cons 10 (vlax-curve-getPointAtDist Obj d1))
        )
      )
   (setq d1 (+ d1 (/ 0.25 slp)))
   )
 (princ)
 )

 

But it gives me an error sometimes:

Pick point 1:

Enter elevation 1: 123.45

Pick point 2:

Enter elevation 2: 124.56

; error: bad DXF group: (10)

 

Why does it give me an error?

Edited by SLW210
multiposting is bad
Link to comment
Share on other sites

This lisp is amazing, but can anyone help me. I need to interpolate with 0.25 height difference. For example 21.25 21.50 21.75 22.00 .

 

I have been looking at this code for an hour now and I don't get it.

 

I could really use your help because I need to create a topographic map and I have to interpolate over 300 points.

 

many months ago Ihave written 2 programs by request of one of my correspondents back,

but she has not sent me the feedback and I do not know till now how these programs work

with practical drawings

Anyway you can try them just change text height to suit

;;edited 6/20/10
(vl-load-com);load ActiveX library
(setq *default* 0.25);global Z step
;;local defuns
;;==============================================================;;
(defun get_default ( msg / usinput)
 (initget 6)
         (if *default*
            (setq usinput (getreal (strcat "\n" msg " <"(rtos *default*)">: 
     ")))
            (setq usinput (getreal (strcat "\n" msg " : ")))
         )
       (if usinput (setq *default* usinput) )
 *default*
 )
;;==============================================================;;
;;; Doug Broad
;;; additional credits Joe Burke, Peter Toby
(defun round (value to)
(setq to (abs to))
(* to (fix (/ ((if (minusp value) - +) value (* to 0.5)) to))))
;;==============================================================;;
(defun adjancetext (acsp textpt textstr textheight rot align)
(setq textobj (vlax-invoke
  acsp
  'AddText
  textstr
  textpt
  textheight
   )
      )
 (if (not (zerop align))
   (progn
(vlax-put textobj 'Alignment align) 
(vlax-put textobj 'TextAlignmentPoint textpt)
(vlax-put textobj 'Rotation rot)
     )
   )
 textobj
 )
;;==============================================================;;
(defun adjancepoint (acsp point)
 (vlax-invoke  acsp 'AddPoint point)
 )
;;======================= main program =========================;;
(defun C:ELR (/ acapp acsp aline ang cnt delta exact hyp inspt lastitem lengt
        num pt1 pt2 sina textheight textobj textpt zdelta zstep)


 (setq acsp (vla-get-block
       (vla-get-activelayout
  (vla-get-activedocument
    (setq acapp (vlax-get-acad-object))))
       )
)

(setvar "pdmode" 34)
(setvar "pdsize" 3) 
(setvar "osmode" 9)
(setvar "dimzin" 2)

(setq zstep (get_default "\nEnter Z step: "))

(setq textheight 2.)
(setq pt1 (getpoint "\nSpecify first point: ")
     pt2 (getpoint pt1 "\nSpecify second point: ")
      ang (angle pt1 pt2)
      )

 (vlax-invoke acapp 'ZoomWindow  pt1 pt2)

 (vlax-invoke acapp 'ZoomScaled  0.9 1)

 (if (and (>= ang (/ pi 2))
   (<= ang (* pi 1.5))
   )
 (setq ang (- ang pi))
 )
 (if (equal (caddr pt1) (caddr pt2) 0.00001)
   (progn
     (princ "\n >> Both points have identical Z-values. <<")
     (adjancepoint acsp pt1)

     (adjancepoint acsp pt2)

     (adjancetext acsp (mapcar '+ pt1 (list 0 textheight 0))
(rtos (caddr pt1) 2 2)
textheight
ang
13
)

     (adjancetext acsp (mapcar '+ pt2 (list 0 textheight 0))
(rtos (caddr pt2) 2 2)
textheight
ang
13
)
     )

   (progn

     (setq aline (vlax-invoke acsp 'AddLine pt1 pt2))
     (setq delta  (vlax-get aline 'Delta)
    lengt  (vlax-get aline 'Length)
    zdelta (caddr delta)
    sina   (/ zdelta lengt)
    hyp    (abs (/ zstep sina))
    num    (abs (fix (setq exact (/ zdelta zstep))))
    cnt    0
    zstart (caddr pt1)
    zend (caddr pt2)     
    )

        (adjancepoint acsp pt1)

  (adjancetext acsp (mapcar '+ pt1 (list 0 textheight 0))
(rtos (caddr pt1) 2 2)
textheight
ang
13
)

     (if (not (equal (round zstart zstep) zstart 0.00001))
(progn
  (setq remd (- (round zstart zstep) zstart))
  (setq fhyp (/ remd sina))
  (setq inspt (vlax-curve-getclosestpointto
  aline
  (vlax-curve-getPointatDist aline fhyp)))
  (adjancepoint acsp inspt )
  (adjancetext acsp (mapcar '+ inspt (list 0 textheight 0))
(rtos (caddr inspt) 2 2)
textheight
ang
13
)
(setq start T)
)
(setq start nil)
     )

     (while (< (setq cnt (1+ cnt)) num)
(adjancepoint acsp (setq inspt (vlax-curve-getclosestpointto
  aline
  (vlax-curve-getPointatDist aline
    (if start
      (+ (* cnt hyp) fhyp)
      (* cnt hyp)))))
  )


(adjancetext acsp (mapcar '+ inspt (list 0 textheight 0))
(rtos (caddr inspt) 2 2)
textheight
ang
13
)
)
(adjancepoint acsp pt2)

     (adjancetext acsp (mapcar '+ pt2 (list 0 textheight 0))
(rtos (caddr pt2) 2 2)
textheight
ang
13
)
)
 )
 (princ)
 )
(prompt "\n >> Start command with ELR <<")
(prin1)

 

;;edited 6/20/10
(vl-load-com);load ActiveX library
(setq *default* 0.25);global Z step
;;local defun
(defun get_default ( msg / usinput)
 (initget 6)
         (if *default*
            (setq usinput (getreal (strcat "\n" msg " <"(rtos *default*)">: 
     ")))
            (setq usinput (getreal (strcat "\n" msg " : ")))
         )
       (if usinput (setq *default* usinput) )
 *default*
 )
;;================================== main program ====================================;;
(defun C:ELE (/ acapp acsp aline ang cnt delta exact hyp inspt lastitem lengt
        num pt1 pt2 sina textheight textobj textpt zdelta zstep)


 (setq acsp (vla-get-block
       (vla-get-activelayout
  (vla-get-activedocument
    (setq acapp (vlax-get-acad-object))))
       )
)

(setvar "pdmode" 34)
(setvar "pdsize" 3) 
(setvar "osmode" 9)
(setvar "dimzin" 2)

(setq zstep (get_default "\nEnter Z step: "))

(setq textheight 2.)
(setq pt1 (getpoint "\nSpecify first point: ")
     pt2 (getpoint pt1 "\nSpecify second point: ")
      ang (angle pt1 pt2)
      )

 (vlax-invoke acapp 'ZoomWindow  pt1 pt2)

 (vlax-invoke acapp 'ZoomScaled  0.9 1)

 (if (and (>= ang (/ pi 2))
   (<= ang (* pi 1.5))
   )
 (setq ang (- ang pi))
 )
 (if (equal (caddr pt1) (caddr pt2) 0.00001)
   (progn
     (princ "\n >> Both points have identical Z-values. <<")
     (setq textobj (vlax-invoke
       acsp
       'AddText
       (rtos (caddr pt1) 2 2)
       (setq textpt (mapcar '+ pt1 (list 0 textheight 0)))
       textheight)
    )
     (vlax-put textobj 'Alignment 13)
     (vlax-put textobj 'TextAlignmentPoint textpt)
     (vlax-put textobj 'Rotation ang)
     (setq textobj (vlax-invoke
       acsp
       'AddText
       (rtos (caddr pt2) 2 2)
       (setq textpt (mapcar '+ pt2 (list 0 textheight 0)))
       textheight)
    )
     (vlax-put textobj 'Alignment 13)
     (vlax-put textobj 'TextAlignmentPoint textpt)
     (vlax-put textobj 'Rotation ang)
     )
   (progn
     (setq aline (vlax-invoke acsp 'AddLine pt1 pt2))
     (setq delta  (vlax-get aline 'Delta)
    lengt  (vlax-get aline 'Length)
    zdelta (caddr delta)
    sina   (/ zdelta lengt)
    hyp    (abs (/ zstep sina))
    num    (abs (fix (setq exact (/ zdelta zstep))))
    cnt    -1
    )
     (if (equal num exact 0.00001)
(setq lastitem T)
(setq lastitem nil)
)
     (while (< (setq cnt (1+ cnt)) num)
(vlax-invoke
  acsp
  'AddPoint
  (setq inspt (vlax-curve-getclosestpointto
  aline
  (vlax-curve-getPointatDist aline (* cnt hyp))))
  )
(setq textobj (vlax-invoke
  acsp
  'AddText
  (rtos (caddr inspt) 2 2)
  (setq textpt (mapcar '+ inspt (list 0 textheight 0)))
  textheight)
      )
(vlax-put textobj 'Alignment 13)
(vlax-put textobj 'TextAlignmentPoint textpt)
(vlax-put textobj 'Rotation ang)
)

     (vlax-invoke
acsp
'AddPoint
(setq inspt (vlax-curve-getclosestpointto aline pt2))
)
     (setq textobj (vlax-invoke
       acsp
       'AddText
       (rtos (caddr pt2) 2 2)
       (setq textpt (mapcar '+ pt2 (list 0 textheight 0)))
       textheight)
    )
     (vlax-put textobj 'Alignment 13)
     (vlax-put textobj 'TextAlignmentPoint textpt)
     (vlax-put textobj 'Rotation ang)
     )
   )

 (princ)
 )
(prompt "\n >> Start command with ELE <<")
(prin1)

 

~'J'~

Link to comment
Share on other sites

Thanks for the code, but I am interpolating in an 2D environment, Z is always 0.

 

The code 3 lines down would be perfect, but this one has a height step of 1, I would need 0.25. I made some changes, but I only got errors.

I would really appreciate some help, it would save me a lot of time.

(defun c:test (/ pt1 el1 pnt1 pt1 el2 pnt2 len el1a slp d1)
 (vl-load-com)
 (setvar "osmode" 0)
 (setvar "pdmode" 3)
 (setq pt1 (getpoint "\nPick point 1: ")
   el1 (getreal "\nEnter elevation 1: ")
   pnt1 (list (car pt1) (cadr pt1) el1)
   pt2 (getpoint pt1 "\nPick point 2: ")
   el2 (getreal "\nEnter elevation 2: ")
   pnt2 (list (car pt2) (cadr pt2) el2)
   len (distance pnt1 pnt2)
       el1a (1+(fix el1))
       slp (/  (- el2 el1)(distance pnt1 pnt2))
   d1 (/ (- el1a el1) slp)
   )
 (setq obj (vlax-ename->vla-object
    (entmakex
      (list
        (cons 0 "LINE")
        (cons 10 pnt1)
        (cons 11 pnt2)
        )
      )
   )
   )
 (while (< d1 len)
        (entmakex
      (list
        (cons 0 "POINT")
        (cons 10 (vlax-curve-getPointAtDist Obj d1))
        )
      )
   (setq d1 (+ d1 (/ 1 slp)))
   )
 (princ)
 )

Link to comment
Share on other sites

I don't get it. I changed code, but it doesn't work.

The original code:

(defun c:test (/ pt1 el1 pnt1 pt1 el2 pnt2 len el1a slp d1)
 (vl-load-com)
 (setvar "osmode" 0)
 (setvar "pdmode" 3)
 (setq pt1 (getpoint "\nPick point 1: ")
   el1 (getreal "\nEnter elevation 1: ")
   pnt1 (list (car pt1) (cadr pt1) el1)
   pt2 (getpoint pt1 "\nPick point 2: ")
   el2 (getreal "\nEnter elevation 2: ")
   pnt2 (list (car pt2) (cadr pt2) el2)
   len (distance pnt1 pnt2)
       el1a (1+(fix el1))
       slp (/  (- el2 el1)(distance pnt1 pnt2))
   d1 (/ (- el1a el1) slp)
   )
 (setq obj (vlax-ename->vla-object
    (entmakex
      (list
        (cons 0 "LINE")
        (cons 10 pnt1)
        (cons 11 pnt2)
        )
      )
   )
   )
 (while (< d1 len)
        (entmakex
      (list
        (cons 0 "POINT")
        (cons 10 (vlax-curve-getPointAtDist Obj d1))
        )
      )
   (setq d1 (+ d1 (/ 1 slp)))
   )
 (princ)
 )

Changed:

 

(defun c:test (/ pt1 el1 pnt1 pt1 el2 pnt2 len el1a slp d1)
 (vl-load-com)
 (setvar "osmode" 0)
 (setvar "pdmode" 3)
 (setq pt1 (getpoint "\nPick point 1: ")
   el1 (getreal "\nEnter elevation 1: ")
   pnt1 (list (car pt1) (cadr pt1) el1)
   pt2 (getpoint pt1 "\nPick point 2: ")
   el2 (getreal "\nEnter elevation 2: ")
   pnt2 (list (car pt2) (cadr pt2) el2)
   len (distance pnt1 pnt2)
       el1a (+ 0.25 (fix el1))
       slp (/  (- el2 el1)(distance pnt1 pnt2))
   d1 (/ (- el1a el1) slp)
   )
 (setq obj (vlax-ename->vla-object
    (entmakex
      (list
        (cons 0 "LINE")
        (cons 10 pnt1)
        (cons 11 pnt2)
        )
      )
   )
   )
 (while (< d1 len)
        (entmakex
      (list
        (cons 0 "POINT")
        (cons 10 (vlax-curve-getPointAtDist Obj d1))
        )
      )
   (setq d1 (+ d1 (/ 0.25 slp)))
   )
 (princ)
 )

And it doesn't Work!!!

 

Gives me error:

Pick point 1:

Enter elevation 1: 123.765

Pick point 2:

Enter elevation 2: 128.138

; error: bad DXF group: (10)

I think that it might be easily solved, I just don't know anything about lisp!
Link to comment
Share on other sites

Thanks for the code, but I am interpolating in an 2D environment, Z is always 0.

 

The code 3 lines down would be perfect, but this one has a height step of 1, I would need 0.25. I made some changes, but I only got errors.

I would really appreciate some help, it would save me a lot of time.

 

I thought, nobody can help you, until you do not attach here your drawing with a situation 'before and after'

 

~'J'~

Link to comment
Share on other sites

I tried the edited code using your z values and I get the same error.

In a nutshell, your code is trying to place a point at elevation 21.25 (not an elevation between the 2 given elevations)

this line

d1 (/ (- el1a el1) slp)

is returning a negative number. This causes the vlax-curve-getPointatDist to return nil- hence the error.

Link to comment
Share on other sites

I tried the edited code using your z values and I get the same error.

In a nutshell, your code is trying to place a point at elevation 21.25 (not an elevation between the 2 given elevations)

this line

d1 (/ (- el1a el1) slp)

is returning a negative number. This causes the vlax-curve-getPointatDist to return nil- hence the error.

 

Thanks, I now understand the problem. Is there a way to fix it?

 

Maybe an if clause of some sort? For example, if the point was 21.324.

Then check if 21.250

 

I only know VBA, lisp is a dark area for me.

Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
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...