Lines between two polylines

[aloy]

Hi everybody ,

I want to find a lisp that would draw series of short perpendicular lines of a predefined length to show the slope from the edge of formation (or edge of road platform which is a polyline) towards another polyline giving the edge of filling or cutting (or vice versa). The points defining the two polylines are given in two separate lists. I want to be able to do it without selecting lines on screen. Can someone help?.

Thanking in advance.

Aloy.

[BIGAL]

If you use something like batter.lsp you could replace the pick plines with (entlast) after making the 2 new plines. Added "Tick" dwg, this is the shape drawn can be a simple line.

batterticks2.lsp

tick.dwg

Edited April 26, 2018 by BIGAL

[aloy]

Thank you Bigal. This is what I was looking for. Will get back after testing.

Aloy

[aloy]

Bigal,

No luck, See what I get in the attached picture. I have changed the color to green to make it more visible.

Edited April 25, 2018 by aloy

[aloy]

Sorry Bigal,

I did not read the code well. I realized that I need a block in the drawing for insertion. So now it comes ok. Thanks a lot.

[BIGAL]

Its my fault just use these programs and forget the little stuff that hangs to the side, glad it worked for you.

[aloy]

Bigal, I think this work out better than Civ3D, See how they implement it in the attached picture; they are not at same intervals and also span from top to bottom. Only thing the code has to be modified so as the ticks always perpendicular to the road edge.

[BIGAL]

This is a much simpler way it uses a linetype. d out.

 

Having problems my end uploading lin & shx file. On the road and internet drops in an out some much for we give free internet.

Custom.zip

Edited April 26, 2018 by BIGAL

[aloy]

Hi Bigal,

 

I used the following modification to pick the two polylines:

; SELECT TOP & BOTTOM OF BATTER POLYLINES

;################################################# ######

;(setq UpperObj (vlax-ename->vla-object (car (entsel "\nSELECT TOP OF BATTER >>"))))

(_pline a)

(setq UpperObj entlast)

(_pline b)

(setq BottomObj entlast)

How ever it throws an exception to say "Unable to get Object ID: #

I used an adaptation of an SPline given to me earlier in this forum as follows:

(defun _Pline ( lst )
  (entmakex
    (append
      (list 
        '(0 . "Pline")
        '(100 . "AcDbEntity")
        '(100 . "AvDbPline")
        '(70 . 40)
        '(71 . 3)
       (cons 74 (length lst)
        '(44 . 1.0e-005)
    )
      (mapcar '(lambda(x) (cons 11 x)) lst)
   )
 )
)

The plines are not drawn. What can be the problem?.

[Grrr]

How ever it throws an exception to say "Unable to get Object ID: #

 

Seems like you provide the actual entlast function as an argument (without running it), to an evaluation that tries to obtain the object ID -

so change there entlast to (entlast).

 

 

I used an adaptation of an SPline given to me earlier in this forum as follows:

The plines are not drawn. What can be the problem?.

 

You just removed the "S" from the 'spline' to become 'pline' and expected to work?!

For a LWPOLYLINE the vertices are defined by gc 10, and not 11, and for a 3D/heavy polyline you'll need completely different subfoo that would create the "VERTEX" entities.

Anyway google for "Lee Mac entmake functions", and you'll find the proper subfoo.

[aloy]

Grr, Yes (entlast) worked and the following code for the "pline" also worked, How ever there seems to be other issues regarding the scale of the ticks etc.:

 

(defun drawpoly ( l )
 (setq os(getvar "osmode")
  (setvar "osmode" 0)
  (command "pline")
  (apply 'command l)
  (command "")
  (setvar "osmode" os)
  (princ)
)

I was trying to recollect who gave the original code for Spline. Perhaps, it was you.

Thanks a lot for the help

[aloy]

Hi Bigal,

(setq UpperObj (entlast)) gave me the entity reference but not the Object reference that is used afterwards to get length etc. How can I get the reference returned by the following:

 

(setq UpperObj (vlax-ename->vla-object (car (entsel "\nSELECT TOP OF BATTER >>"))))

I know this is vlisp on which I haven't got a good handle though I got down a book from Amazon couple of years ago. A help on this will be greatly appreciated.

 

Regards,

 

Aloy

[dlanorh]

Hi Bigal,

(setq UpperObj (entlast)) gave me the entity reference but not the Object reference that is used afterwards to get length etc.

 

(setq UpperObj (vlax-ename->vla-object (entlast)))

 

 

(vlax-ename->vla-object ...) converts an entity with "entityname" into an object.

 

 

How can I get the reference returned by the following:

 

(setq UpperObj (vlax-ename->vla-object (car (entsel "\nSELECT TOP OF BATTER >>"))))

 

I know this is vlisp on which I haven't got a good handle though I got down a book from Amazon couple of years ago. A help on this will be greatly appreciated.

 

Regards,

 

Aloy

 

Looks good to me, you are returning an object.

[aloy]

dlanorh,

There seems to be a problem. The error message says "unable to get ID". I can see both picking and (entlast) returns the same value. However if you check what "entsel" returns there is the additional pick point that returned along with the entity name etc.

 

Thanks.

[dlanorh]

dlanorh,

There seems to be a problem. The error message says "unable to get ID". I can see both picking and (entlast) returns the same value. However if you check what "entsel" returns there is the additional pick point that returned along with the entity name etc.

 

Thanks.

 

I don't work with entlast very much. If it is returning a pick point then you need

 

(vlax-ename->vla-object (car entlast))

 

if that doesn't work attempt

 

(vlax-ename->vla-object (car (entlast)))

[ronjonp]

I don't work with entlast very much. If it is returning a pick point then you need

 

(vlax-ename->vla-object (car entlast))

 

if that doesn't work attempt

 

(vlax-ename->vla-object (car (entlast)))

 

HERE is some information on entlast.

[aloy]

dlanorh,

I think you are correct. When we get the (car (entsel " ..... ")) we only get the entity name and the coordinate part is left out. So the correct procedure may be what you gave in your earlier post. The error I get may be due to some other problem. What I am trying to do is to get the code posted by Bigal in post #2 working and draw batter ticks on my road plan view.

 

Regards,

Aloy

[dlanorh]

What is the error that you are getting? Is (entlast) nil? If you are trying to replace picking an entity with (entlast), then there has to be a last entity. Try typing (entlast) on the commandline.

[aloy]

The error was in my code, as I have given the same variable name for both upper and bottom objects. It works perfectly after I corrected the error. You can test it yourself by opening the drawing I am giving bellow, load the lisp file and responding appropriately.

tick.dwg

Testdraw.lsp

[aloy]

Hi Bigal,

There seems to be a bug in the batterticks.lsp code given. It returns an error message as it tries to initiate a point "tartPt2" outside the polyline right at the end This can be avoided by making steplLength2 for controlling the while loop. Then it can be used to draw ticks for many pairs of polylines in one go as can be seen in the picture shown. I give complete code together with a function to make a block for the tick automatically:

; draws batter ticks between two polylines
(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)
)
)

(defun C:PBTL ( / steplength2 endpt startpt divstep)
(setvar "cmdecho" 0)
(COMMAND "_UNDO" "_M")


(setq acadApp (vlax-get-acad-object))
(setq acadDoc (vla-get-ActiveDocument acadApp))
(setq acSp (vla-get-modelspace acadDoc))


(setq a '(0.0 0.0 0.0))
(command "-insert" "TICK" "_s" "1" a "90")
(command "_erase" "l" "")

(if(not(tblsearch "LAYER" "BATTER TICKS"))
(command "-layer" "new" "BATTER TICKS" "Color" 30 "BATTER TICKS" "LTYPE" "Continuous" "BATTER TICKS" "")
);end if
(setvar "clayer" "BATTER TICKS")
(setvar "celtype" "bylayer")
(setvar "cecolor" "bylayer")

(setq distbetween 2.0)
;(setq olddistbetween distbetween
;distbetween (getreal(strcat"\nSPECIFY DISTANCE BETWEEN BATTER TICKS <"(rtos distbetween)">:")))
;(if(not distbetween)(setq distbetween olddistbetween))
(setq divStep (* distbetween 2);
stepLength 0.0
stepLength2 (/ divstep 2)
)
;################################################# ######
; SELECT TOP & BOTTOM OF BATTER POLYLINES
;################################################# ######
;
 ;(setq UpperObj (vlax-ename->vla-object (car (entsel "\nSELECT TOP OF BATTER >>"))))

;(setq BottomObj (vlax-ename->vla-object (car (entsel "\nSELECT BOTTOM OF BATTER >>"))))
(setq xp(mapcar '(lambda(x) (list (car x) (cadr x))) xp))
(setq yp(mapcar '(lambda(x) (list (car x) (cadr x))) yp))


 
(drpoly xp)
 (setq UpperObj (vlax-ename->vla-object (entlast)))

(drpoly yp)
 (setq BottomObj (vlax-ename->vla-object (entlast)))
 
(setq objLength (vlax-curve-getDistAtParam UpperObj (vlax-curve-getEndParam UpperObj)))
(setq direction -)
;################################################# ######
; INSERT BATTER TICKS
;################################################# ######
 (setq startPt '(0.0 0.0) starPt2 '(0.0 0.0) endPt '(0.0 0.0) endPt2 '(0.0 0.0))

(while (< stepLength2 objLength)
 
  
(setq startPt (vlax-curve-getPointAtDist UpperObj stepLength))
 
(setq startPt2 (vlax-curve-getPointAtDist UpperObj stepLength2))
(if startPt
(setq endPt (vlax-curve-getClosestPointTo BottomObj startPt)))
(if startPt2
(setq endPt2 (vlax-curve-getClosestPointTo BottomObj startPt2)))

 (setq stepLength (+ stepLength divStep))
 (setq stepLength2 (+ stepLength2 divStep))
(setq a1 (list (car startpt)(cadr startpt)))
(setq b1 (list (car endpt)(cadr endpt)))
(setq rad1 (angle a1 b1))
(setq ang (alg-ang UpperObj startPt))
(setq ang2 (alg-ang UpperObj startPt2))

(setq dis (distance startPt endPt))
(setq dis2 (/ (distance startPt2 endPt2) 2) )
(setq endPt (polar startPt ang 1.))
(setq endPt2 (polar startPt2 ang2 1.))
 (if endPt
(setq Xline (vlax-invoke acSp 'AddXLine startPt endPt)))
 (if endPt2
(setq Xline2 (vlax-invoke acSp 'AddXLine startPt2 endPt2)))
;################################################# ######
; INSERT LARGE BATTER TICKS
;################################################# ######
(if
(setq endPt (vlax-invoke Xline 'IntersectWith BottomObj 0))
(progn
(setq a1 (list (car startpt)(cadr startpt)))
(setq b1 (list (car endpt)(cadr endpt)))
(setq rad2 (angle a1 b1))
(setq testdis1 (distance startPt (list (car endPt)(cadr endPt))))
;this section ensures that the intersection point and angle is the closest to the start point
(if (< (* 2.0 dis) testdis1)
(setq deg1 rad1)
(setq deg1 rad2)
);end if

(vlax-invoke acSp 'InsertBlock startPt "TICK" 0.4 0.4 0.4 deg1) ;(direction ang (/ pi 2)))
(vl-cmdf "_.scale" "l" "" startPt dis )
);END PROGN
);END IF

(vla-delete Xline)
;(setq stepLength (+ stepLength divStep))
;################################################# ######
; INSERT SMALL BATTER TICKS
;################################################# ######
(if
(setq endPt2 (vlax-invoke Xline2 'IntersectWith BottomObj 0))
(progn
(setq a2 (list (car startpt2)(cadr startpt2)))
(setq b2 (list (car endpt2)(cadr endpt2)))
(setq rad3 (angle a2 b2))
(setq testdis2 (distance startPt2 (list (car endPt2)(cadr endPt2))))
;this section ensures that the intersection 
;point and angle is the closest to the start point
(if (< (* 4.0 dis2) testdis2)
(setq deg2 rad1)
(setq deg2 rad3)
);end if

(vlax-invoke acSp 'InsertBlock startPt2 "TICK" 0.4 0.4 0.4 deg2) ;(direction ang (/ pi 2)))
(vl-cmdf "_.scale" "l" "" startPt2 dis2 )
);END PROGN
);END IF
(vla-delete Xline2)
;(setq stepLength2 (+ stepLength2 divStep))
  
);END WHILE
;################################################# ######
; RELEASE POLYLINES & FINISH
;################################################# ######
(vlax-release-object BottomObj)
(vlax-release-object UpperObj)
(princ)
(COMMAND "_UNDO" "_E")
(setvar "cmdecho" 1)
)
;(PRINC "\nTYPE PBTL TO RUN")


(defun C:QB ( / p1 p2 a )
 (setq p1(getpoint "\nGive base point for the block: "))
 (setq p2(list (+ (car p1) 2.0) (cadr p1) (caddr p1)))  
 (command "_Line" "_non"p1 "_non"p2 "")
 (setq a(ssget p1))
 (setq sc 1.0)
 (setq oldsc sc
             sc (getreal(strcat"\nSPECIFY SCALE FOR TICKS <"(rtos sc)">:")))
(if(not sc) (setq sc oldsc))
 (command "_BLOCK" "tick" p1 a "")
)

(defun drpoly( l / os )
 (setq os(getvar "osmode"))
 (setvar "osmode" 0)
 (command "pline")
 (apply 'command l)
 (command "")
 (setvar "osmode" os)
 (princ)
 )