Draw polyline half the distance of vlax-curve-GetClosestPointTo

[Strydaris]

Hey everyone,

 

Was wondering if anyone has tried this before or have an idea on how to go about this.

I am creating a lisp routine that uses vlax-curve-GetPointAtDist & vlax-curve-GetClosetPointTo to draw a bunch of lines between 2 polylines at a set distance.

What I am curious about is if there is a way to draw those lines at half the length?

 

My basic code looks like this right now.

(defun C:Bermfill (/ );pline1 pline2 startPt1 closestPt2 length1 i)
  (setq pline1 (car (entsel "\nSelect the 1st polyline: ")))
  (setq pline2 (car (entsel "\nSelect the 2nd polyline: ")))

  (if (and pline1 pline2)
    (progn
      (setq startPt1 (vlax-curve-getStartPoint (vlax-ename->vla-object pline1)))
      (setq dis (vlax-curve-getDistAtPoint (vlax-ename->vla-object pline1) (vlax-curve-getEndPoint (vlax-ename->vla-object pline1))))
      (setq closestPt2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object pline2) startPt1))
      (setq i 0.6)
	 (setq plst nil)

      (while (< i dis)
        (setq pline (entmakex (append (list
					 '(0 . "LWPOLYLINE")
					 '(100 . "AcDbEntity")
					 '(100 . "AcDbPolyline")
					 '(67 . 0)
					 (cons 410 (getvar 'ctab))
					 '(8 . "0")
					 '(70 . 0)
					 (cons 90 2)
					 (cons 10 startPt1)
					 (cons 10 closestPt2)
					 )
				      )
			      )
	      )
	 
        (entupd pline) ; Update the polyline
	(setq i (+ i 0.6))
	(setq startPt1 (vlax-curve-getPointAtDist (vlax-ename->vla-object pline1) i))
        (setq closestPt2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object pline2) startPt1))
      )
    )
  )
  (princ)
)

 

I know its nothing fancy, but I am just learning to figure out what Visual Lisp can do. There is a bug in the code right now at the (setq closestPt2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object pline2) startPt1)) line, but cant figure out why right now. Whenever I Reset the break on Error, it finishes the Lisp and fills in my lines.

 

I havent tried to write the code for the shorter lines yet. I was thinking about getting the distance and angle between the vlax-curve-getPointAtDist and the GetClosestPointTo then using polar to find the midway point, but I have no doubt that there is probably an easier method.

 

The intended outcome would be something similar to this.

 

 

Thanks in advance.

[Lee Mac]

I might suggest something like this -

(defun c:test ( / cnt dis en1 en2 inc len pt1 pt2 )
    (setq inc 0.6 ;; Increment
          dis 0.0
          cnt 0
    )
    (if (and (setq en1 (getcurve "\nSelect 1st object: "))
             (setq en2 (getcurve "\nSelect 2nd object: "))
        )
        (if (< (setq len (vlax-curve-getdistatparam en1 (vlax-curve-getendparam en1))) inc)
            (princ "\nLength of first object is less than increment.")
            (repeat (1+ (fix (+ (/ len inc) 1e-8)))
                (setq pt1 (vlax-curve-getpointatdist en1 dis)
                      pt2 (vlax-curve-getclosestpointto en2 pt1)
                      dis (+ dis inc)
                      cnt (1+ cnt)
                )
                (if (zerop (rem cnt 2))
                    (setq pt2 (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2.0)))
                )
                (entmake (list '(000 . "LINE") (cons 10 pt1) (cons 11 pt2)))
            )
        )
    )
    (princ)
)

(defun getcurve ( msg / ent rtn )
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel msg)))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent)
                    nil
                )
                (   (or (vl-catch-all-error-p (setq rtn (vl-catch-all-apply 'vlax-curve-getendparam (list ent))))
                        (null rtn)
                    )
                    (princ "\nInvalid object selected.")
                )
            )
        )
    )
    ent
)

(vl-load-com) (princ)

 

[Strydaris]

@Lee Mac

Why yes Lee you may suggest something like that. Thank you so kindly.

Did you write that in the 15 minutes of me posting this? lol

Works exactly how I want only thing I need to add is a closing line for the end of the 2 polylines and maybe force a layer to use on the user, but that I know how to do.

I guess I could use  (entmake (list '(000 . "LINE") (cons 10 (vlax-curve-getEndParam en1)) (cons 11 (vlax-curve-getEndParam en12)) outside of the repeat & if to add the closing line.

 

If you have a moment, whats the difference between using vlax-curve-getdistatparam and vlax-curve-getPointAtDist?

 

Thanks again Lee.

 

[Lee Mac]

30 minutes ago, Strydaris said:

I guess I could use  (entmake (list '(000 . "LINE") (cons 10 (vlax-curve-getEndParam en1)) (cons 11 (vlax-curve-getEndParam en12)) outside of the repeat & if to add the closing line.

 

Yes, though you might want to first check whether such a line already exists (as would be the case if the length is exactly divisible by the increment).

 

32 minutes ago, Strydaris said:

whats the difference between using vlax-curve-getdistatparam and vlax-curve-getPointAtDist?

 

The former gets the distance along the curve at a given parameter value, and the latter obtains a point on the curve at a given distance along it. I obtain the length using parameters rather than points as, for closed objects, the end point will be equal to the start point, hence you'll either obtain the length or 0.0.

[Strydaris]

11 minutes ago, Lee Mac said:

The former gets the distance along the curve at a given parameter value, and the latter obtains a point on the curve at a given distance along it. I obtain the length using parameters rather than points as, for closed objects, the end point will be equal to the start point, hence you'll either obtain the length or 0.0.

Ahhh ok I think I get it.

GetPointAtDist would probably be better for single points or insertion, whereas the param is better for iterations.

 

Thanks again Lee. I am going to try and dissect this code and figure out how things work.

Cheers!

[Tsuky]

I don't want you to stop improving your code.
But the one I am proposing to you is the fruit of several years of reflection to achieve, it seems to me, the same desired result.
Don't let that stop you from doing even better; more concise and faster...
This code draws more than you want: it can comb in 2D or 3D depending on the selected source entities.
The challenge is open!

slope3D.lsp

[Strydaris]

@Tsuky Yes, it looks roughly like the same results, but some things would have to change due to the way how my office does things.

There is a lot of code to go through there and I thank you for your contribution towards my learning. One thing I still have difficulty with is fully reading the code as I dont know all of the VL functions yet, so determining what they actually do is a lot of time going back and forth referencing things, especially on longer sections of code like this one.

 

@Lee Mac & @Tsuky

 

I do have a question or 2 in regards to this code that Lee posted.

Also Thanks again Lee for this....

So what I am looking to do is to make the Lines that this code adds perpendicular to the first Entity selected.

To my understanding and reading, the best way to do this is to use vlax-curve-GetFirstDeriv along with vlax-curve-GetParamAtPoint

I have added a dir variable to the code and that seams to work for the half length lines, although there is some issues with the direction of the half length lines when the polyline start point is different.

What I cant figure out is how to apply this direction to the full length lines.

Can I still use vlax-curve-ClosestPointTo for pt2 if I am forcing a direction from pt1?

(defun c:brm ( / cnt dis en1 en2 inc len pt1 pt2 dir)
	(vla-endundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  	(vla-startundomark adoc)
   (setq inc (getreal "\nSpacing between line segments: ") ;; Increment
          dis 0.0
          cnt 0
	      brmlay "SP-BERM"
    )
    (if (and (setq en1 (getcurve "\nSelect top of berm line: "))
             (setq en2 (getcurve "\nSelect bottom of berm line: "))
        )
        (if (< (setq len (vlax-curve-getdistatparam en1 (vlax-curve-getendparam en1))) inc)
            (princ "\nLength of first object is less than increment.")
            (repeat (1+ (fix (+ (/ len inc) 1e-8)))
                (setq pt1 (vlax-curve-getpointatdist en1 dis)
                      pt2 (vlax-curve-getclosestpointto en2 pt1)
                      dis (+ dis inc)
                      cnt (1+ cnt)
		      dir (+ (angle '(0 0 0) (vlax-curve-GetFirstDeriv en1 (vlax-curve-GetParamAtPoint en1 pt1))) (* pi -0.5))
                )
                (if (zerop (rem cnt 2))
                    (setq pt2 (polar pt1 dir (/ (distance pt1 pt2) 2.0)));CHange dir to pt2 for original point
                )
                (entmake (list '(000 . "LINE") (cons 8 brmlay) (cons 10 pt1) (cons 11 pt2)))
            )
        )
    )
    (princ)
   (vla-endundomark adoc) 
)

(defun getcurve ( msg / ent rtn )
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel msg)))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent)
                    nil
                )
                (   (or (vl-catch-all-error-p (setq rtn (vl-catch-all-apply 'vlax-curve-getendparam (list ent))))
                        (null rtn)
                    )
                    (princ "\nInvalid object selected.")
                )
            )
        )
    )
    ent
)

(vl-load-com) (princ)

 

[BIGAL]

Another an oldy

; draws batter ticks between two polylines
; By AlanH plus help by others

(vl-load-com)
;local defun
(defun alg-ang (obj pnt)
(- (angle '(0. 0. 0.)(vlax-curve-getfirstderiv
       obj
       (vlax-curve-getparamatpoint
  obj
  pnt
       )
     )
  )
   (/ pi 2)
)
)
  
  
;; get closed polygon's area

(defun ss-pts2area  (l)
(/ (apply (function +)
            (mapcar (function (lambda (x y)
                                (- (* (car x) (cadr y)) (* (car y) (cadr x)))))
                    (cons (last l) l)
                    l)) 
2.)
)

 ;_force pointset CCW
(defun cw-ccw (plent / co-ord plent )
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))
(if (< (ss-pts2area co-ord) 0)
(princ)
(command "pedit" plent "R" "")
)
)

; main part
(defun C:BAT1 (/ stepLength endPt startPt divStep)

(if (not (tblsearch "Block" "Tick"))
(progn 
(setq oldinsunits (getvar 'insunits))
(setq  pt  '(0.0 0.0 0.0))
(setvar 'insunits 0)
(command "-insert" "TICK" pt 1 1 0)
(command "_erase" "l" "")
(setvar 'insunits oldinsunits)
)
)

  (setq acadApp (vlax-get-acad-object))
  (setq acadDoc (vla-get-ActiveDocument acadApp))
  (setq acSp (vla-get-modelspace acadDoc))
 
(if(not DISTSTEP)(setq DISTSTEP 5))
(setq oldDISTSTEP DISTSTEP
DISTSTEP (getreal(strcat "\nSPECIFY DISTANCE BETWEEN BATTER TICKS <"(rtos DISTSTEP)">:")))
(if(not DISTSTEP)(setq DISTSTEP oldDISTSTEP))

(setq stepLength 0.0)
(setq bobj (entsel "\nSelect the batter top>>"))
(cw-ccw  bobj)
(setq BottomObj(vlax-ename->vla-object (car bobj)))
(setq bobj (entsel "\nSelect the opposite side >>"))
(cw-ccw  bobj)
(setq upperobj (vlax-ename->vla-object (car bobj)))

(setq objLength (vlax-curve-getDistAtParam BottomObj (vlax-curve-getEndParam BottomObj)))
(while (< stepLength objLength)
  (setq startPt
  (vlax-curve-getPointAtDist BottomObj stepLength))
    
 (setq ang (alg-ang BottomObj startPt))
 (setq endPt (polar startPt ang 0.1))
 (setq Xline (vlax-invoke acSp 'AddLine startPt endPt))
 (if
 (setq endPt (vlax-invoke  Xline 'IntersectWith upperObj acExtendThisEntity))
 (progn
 (setq dis (distance  startPt endPt))
 (SETQ ANG (ANGLE startpt ENDPT))
(vlax-invoke acSp 'InsertBlock startPt "Tick" 1 1 1 (+ ang (/ pi 2)));<-- change the block name here
 (vl-cmdf "_.scale" "l" "" startPt dis )
   ;(vlax-invoke acsp 'AddLine startPt EndPt)))
))   
 (vla-delete XLine)
  (setq stepLength (+ stepLength dISTStep))
  )
(vlax-release-object BottomObj)
(vlax-release-object UpperObj)

(princ)
)
(princ "\nType BAT1 to run again")
(C:BAT1)

 

tick.dwg

[Tsuky]

Is it better with these small modifications?

(defun c:brm ( / cnt dis en1 en2 inc len pt1 pt2 dir)
	(vla-endundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  	(vla-startundomark adoc)
   (setq inc (getreal "\nSpacing between line segments: ") ;; Increment
         dis 0.0
         cnt 0
         brmlay "SP-BERM"
    )
    (if (and (setq en1 (getcurve "\nSelect top of berm line: "))
             (setq en2 (getcurve "\nSelect bottom of berm line: "))
        )
        (if (< (setq len (vlax-curve-getdistatparam en1 (vlax-curve-getendparam en1))) inc)
            (princ "\nLength of first object is less than increment.")
            (repeat (1+ (fix (+ (/ len inc) 1e-8)))
                (setq
                  pt1 (vlax-curve-getpointatdist en1 dis)
                  pt2 (vlax-curve-getclosestpointto en2 pt1)
                  dis (+ dis inc)
                  cnt (1+ cnt)
                  dir (+ (angle '(0 0 0) (vlax-curve-GetFirstDeriv en1 (vlax-curve-GetParamAtPoint en1 pt1))) (* pi -0.5))
                  pt2 (polar pt1 dir (/ (distance pt1 pt2) 2.0));CHange dir to pt2 for original point
                  pt2 (vlax-curve-getclosestpointto en2 pt2)
                )
                (if (zerop (rem cnt 2))
                    (setq pt2 (polar pt1 dir (* (distance pt1 pt2) 0.5)))
                    (setq pt2 (polar pt1 dir (distance pt1 pt2)))
                )
                (entmake (list '(000 . "LINE") (cons 8 brmlay) (cons 10 pt1) (cons 11 pt2)))
            )
        )
    )
    (princ)
   (vla-endundomark adoc) 
)
(defun getcurve ( msg / ent rtn )
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel msg)))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent)
                    nil
                )
                (   (or (vl-catch-all-error-p (setq rtn (vl-catch-all-apply 'vlax-curve-getendparam (list ent))))
                        (null rtn)
                    )
                    (princ "\nInvalid object selected.")
                )
            )
        )
    )
    ent
)

(vl-load-com) (princ)

 

[Strydaris]

@Tsuky 

Thanks for this.

While this does what I asked I noticed that the filler lines don't touch the 2nd selected pline.

I am also still struggling with the filler line direction. They draw fine if the 1 vertex of the 1st polyline is on the left, but if the vertex is on the right the lines draw away from the 2nd polyline.

I think I am going to have to speak to a few more people in our siting & grading department to get more information on what they expect for their preferred outcome from this LISP before I add more to it and make more changes.

Another option I was thinking of, is to get the length of the second LWPOLYLINE and get PT2 points based on how many points the 1st polyline has, although this could cause its own issues if the 2nd polyline is a lot longer than the 1st.

 

Did I ever mention how frustrating LISP coding can be due to the numbers of different situations you have to think of for a seemingly simple function? lol

[BIGAL]

Look at what I posted.

 

"if the 2nd polyline is a lot longer than the 1st." when you do a Intersectwith a option is "Extendthis entity". So it will find a point even outside the scope of the pline and still work. Because you have a spacing for the ticks it may mean the 2 plines are about equal for the calcs.

 

"siting & grading department" if you use CIV3D or for me "Civil site design" the batters are auto created.

 

Lastly use a linetype it will do what you want without code, the only thing you have to do is set a linetype scale, we had a couple of batters at different spacing. 

 

Edited October 1, 2023 by BIGAL

[Strydaris]

@BIGAL

Hey, I took a quick look at what you posted. When I did I wasnt sure if its what we needed at the office. I will take a more in depth look later this week when I have some time.

 

We currently use AutoCAD LT 2016 with some stations finally being upgraded  to AutoCAD 2024 LT. We also do have a couple stations with Full AutoCAD as well. I work at a residential design firm. We mostly do house plans for builders in our area, but part of that work also includes site plan design on a lot per lot basis. We basically take what the Civil Eng, Surveyor and other consultants give us and create our own little site plan in a 2D format, then add the house to the Lot and apply grading information to it that complies with the local municipalities bylaws. My goal is, before we are all updated to Acad 2024 LT is to improve upon the way how we do things so that we can complete this work a lot faster with less time checking for mathematical mistakes. Our Siting & Grading department is really just 2 or 3 people, with some doing their own work for their own projects. Not ideal, but its how this company has always worked.

Drawing berms (or batters as you call them) is one of the more time consuming tasks currently if there is complex grading slopes going on. I am just trying to improve the work flow so that projects can get out quicker.