LISP problem in function

[Shinigami_black]

Hi, I'm new to lisp programing, I had programed in C++ and now need to make lisp program for AutoCAD Civil 3D 2010 to automate my work. But have some problems. My program gets all vertexes of polyline and calculate points on polyline in given distance. But when I run program and select polyline it gets me wrong points and if I try second time it gives me slightly different points on same polyline. So I do not get why it do it. I had attached lsp file.

[Shinigami_black]

Attachment

[Shinigami_black]

I found problem in point calculation. I need to add one line in function da_SetPointsOnPolyline

this line

(setq piece_length (- piece_length segment))

after line

(setq points_coordinates (list (list xy (car new_list))))

And I have a guess about puting circles in defferent places in second try of runing function. But I am not guaranteed.

I guess it was an Object Snap work. :S

As it puts circles in wrong places if it is turned on. Need to find how to turn it off in program run time.

[devitg]

Please upload your sample dwg

[Shinigami_black]

It is standard dwg after Civil install and drawn LWPOLYLINE.

Now it works, after adding one line, previously mentioned, and turning off Osnap with (setvar "osmode" 0).

Unknown behavior of software makes your programing nightmare :S

And to add to what I am making.

It will drow slope between to polylines. In 3 different paterns. And without intersecting of patern.

P.S. I get this message after I copy - past from google translate to "Reply to Message" window

Your post has been changed because invalid HTML was found in the message body. The invalid HTML has been removed. Please review the message and submit the message when you are satisfied.

[devitg]

Do a browse to VLxxx functions , specially vlax-curve-getPointAtDist and all family off VLAX-CURVE

[devitg]

Any time you use NATIVE command , you shall set osmode and orthomode to 0 , except if you really want to SNAP to a certain place .

(command "LINE" "mid" pause pause "") It will start a LINE at a MID off a Enty .

And better use RICH text , but leave more than 2 lines "betveen"  lines

And DO NOT USE EMOTICONS , it is a place for noemoticon people .

[Shinigami_black]

Thanks devitg

vlax-curve-getPointAtDist is just what I needed, but I already made a function to do it. Now I need to make a function to find point in second polyline where perpendicular line from first polyline intersects with second polyline. I have a way to do it using geometry formulas, need to creat lisp functions.

I had saw vlxx functions several times, but did not know which language it is autolisp or other.

Any time you use NATIVE command , you shall set osmode and orthomode to 0 , except if you really want to SNAP to a certain place .

Found it hard way :S

(command "LINE" "mid" pause pause "")  what pause do?

[Kent1Cooper]

---

@Shinigami_black wrote:

.... I need to make a function to find point in second polyline where perpendicular line from first polyline intersects with second polyline. I have a way to do it using geometry formulas, need to creat lisp functions.
....

---

Look into the (vlax-curve-getClosestPointTo) function.  Or, if the "perpendicular line" is an actual Line entity, search this Discussion Group for examples of (vla-intersectwith).

[devitg]

Pause: allow or do a "pause" to user input .

Maybe, if you put in clear WHAT do you need to do , or the FINAL TASK or Purpose , instead of show us HOW you are doing it , you could get better and wide help.

Also you use a reserved word or a Function name as a variable "DISTANCE"

Lisp and VLisp are similar , they share all the LISP functions +  adapted from VBA .

Your first DEFUN

could be just 

(defun da_GetLengthBetweenTwoPoints (point1 point2 )
(distance point1 point2)
)

Seem to be you do not  use the VLIDE , the Vlisp editor , it came inside the ACAD .

[Shinigami_black]

Kent1Cooper wrote:

" Look into the (vlax-curve-getClosestPointTo) function.  Or, if the "perpendicular line" is an actual Line entity, search this Discussion Group for examples of (vla-intersectwith). "

Thanks, I found this page http://exchange.autodesk.com/autocad/enu/online-help/browse#WS1a9193826455f5ff1a32d8d10ebc6b7ccc-684... after devitg second post.

And have added my calculations of what I need in png and dwg files.

I am thinking about rewrite program with vlxx functions. It will be much shorte.

devitg I will draw a slopes I need to make and add here.

Update:

Here are slop paterns I need to make.

[Shinigami_black]

Hi,

I rewrote my program by using vlxx and it got much shorter and have advanced more, but not the end.

here are my code.

(vl-load-com)

(defun da_DrawCircle (coordinates d / )
	(foreach xy coordinates
		(command "circle" (strcat (rtos (car xy)) "," (rtos (cadr xy))) "D" (rtos d))
	)
)

(defun da_DrawLine (slope_top slope_bottom / )
	(foreach xy slope_top
		(command "line" xy (car slope_bottom) "")
		(setq slope_bottom (cdr slope_bottom))
	)
)

(defun da_GetPointsOnSlopeBottom (ent_name coordinates / return_data temp)
	(setq return_data (list))
	(foreach xy coordinates
		(setq temp (vlax-curve-getClosestPointTo ent_name xy))
		(if (= temp nil)
			(princ)
			(setq return_data (append return_data (list temp)))
		)
	)
	(setq return_data return_data)
)

(defun da_GetPointsOnSlopeTop (ent_name / segment return_data count)
	(setq count 1)
	(setq segment 0)
	(setq return_data (list))
	(while (/= count nil)
		(setq segment (+ segment GDISTANCE))
		(setq count (vlax-curve-getPointAtDist ent_name segment))
		(if (/= count nil)
			(setq return_data (append return_data (list count)))
			(princ)
		)
	)
	(setq return_data return_data)
)

(defun da_GetPolylineData (/ polyline_name)
	(setq polyline_name (car (entsel)))
	(if (= (cdr (assoc 0 (entget polyline_name))) "LWPOLYLINE")
		(setq polyline_name polyline_name)
		(setq polyline_name "0")
	)
)

(defun da_GetPolyline (msg error_msg / polyline)
	(setq polyline "0")
	(while (= polyline "0")
		(princ msg)
		(setq polyline (da_GetPolylineData))
		(if (= polyline "0")
			(princ error_msg)
			(vlax-ename->vla-object polyline)
		)
	)
)

(defun da_Entry (/ top_of_slope bottom_of_slope)
	(setq GDISTANCE (cond ((getint (strcat "\n Enter distance <" (rtos GDISTANCE 2 0) ">: "))) (GDISTANCE)))
	(setq top_of_slope (da_GetPolyline "\n Select slope top.\n" "\n ERROR: not polyline.\n"))
	(setq bottom_of_slope (da_GetPolyline "\n Select slope bottom.\n" "\n ERROR: not polyline.\n"))
	(list top_of_slope bottom_of_slope)
)

(defun C:da_slope (/ slope_top slope_bottom list_data osnap_var poly_data)
	(setq poly_data (da_Entry))
	(setq osnap_var (getvar "osmode"))
	(setvar "osmode" 0)
	(setq slope_top (da_GetPointsOnSlopeTop (car poly_data)))
	(setq slope_bottom (da_GetPointsOnSlopeBottom (cadr poly_data) slope_top))
	(da_DrawCircle slope_top (/ GDISTANCE 3))
	(da_DrawCircle slope_bottom (/ GDISTANCE 3))
	(da_DrawLine slope_top slope_bottom)
	(setvar "osmode" osnap_var)
	(princ)
)

(prompt "\n Enter \"da_slope\" to start program.\n")

now I need to make a function to check slope bottom coordinates from overlap and fix such places. And 3 functions for different slope paterns.

[Shinigami_black]

New code

(vl-load-com)

(setq GDISTANCE 200)

(defun da_FindCoordinates (point1 point2 ac / ab x3 y3)
	(setq ab (distance point1 point2))
	(setq x3 (/ (* (- (car point2) (car point1)) ac) ab))
	(setq y3 (/ (* (- (cadr point2) (cadr point1)) ac) ab))
	(list (+ (car point1) x3) (+ (cadr point1) y3))
)

(defun da_GetPointsOnSlopeBottom (ent_name coordinates / return_data temp)
	(setq return_data (list))
	(foreach xy coordinates
		(setq temp (vlax-curve-getClosestPointTo ent_name xy))
		(if (= temp nil)
			(princ)
			(setq return_data (append return_data (list temp)))
		)
	)
	(setq return_data return_data)
)

(defun da_GetPointsOnSlopeTop (ent_name / segment return_data count)
	(setq count 1)
	(setq segment 0)
	(setq return_data (list))
	(while (/= count nil)
		(setq segment (+ segment GDISTANCE))
		(setq count (vlax-curve-getPointAtDist ent_name segment))
		(if (/= count nil)
			(setq return_data (append return_data (list count)))
			(princ)
		)
	)
	(setq return_data return_data)
)

(defun da_GetPolylineData (/ polyline_name)
	(setq polyline_name (car (entsel)))
	(if (= (cdr (assoc 0 (entget polyline_name))) "LWPOLYLINE")
		(setq polyline_name polyline_name)
		(setq polyline_name "0")
	)
)

(defun da_GetPolyline (msg error_msg / polyline)
	(setq polyline "0")
	(while (= polyline "0")
		(princ msg)
		(setq polyline (da_GetPolylineData))
		(if (= polyline "0")
			(princ error_msg)
			(vlax-ename->vla-object polyline)
		)
	)
)

(defun da_Entry (/ top_of_slope bottom_of_slope)
	(setq GDISTANCE (cond ((getint (strcat "\n Enter distance <" (rtos GDISTANCE 2 0) ">: "))) (GDISTANCE)))
	(setq top_of_slope (da_GetPolyline "\n Select slope top.\n" "\n ERROR: not polyline.\n"))
	(setq bottom_of_slope (da_GetPolyline "\n Select slope bottom.\n" "\n ERROR: not polyline.\n"))
	(list top_of_slope bottom_of_slope)
)

(defun da_SlopeCoat (slope_top slope_bottom / long short phase xy_top xy_bottom )
	(setq long 0.9)
	(setq short 0.5)
	(setq phase "L")
	(foreach xy_top slope_top
		(if (= phase "L")
			(progn
				(setq xy_bottom (da_FindCoordinates xy_top (car slope_bottom) (* (distance xy_top (car slope_bottom)) long)))
				(setq phase "S")
			)
			(progn
				(setq xy_bottom (da_FindCoordinates xy_top (car slope_bottom) (* (distance xy_top (car slope_bottom)) short)))
				(setq phase "L")
			)
		)
		(command "line" xy_top xy_bottom "")
		(setq slope_bottom (cdr slope_bottom))
	)
)

(defun da_SlopeOfNotWork (slope_top slope_bottom / top_points bottom_points slope_list_length)
	(setq slope_list_length (/ (length slope_top) 2))
	(while (> slope_list_length 0)
		(setq top_points (list (car slope_top) (caddr slope_top)))
		(setq bottom_points (list (car slope_bottom) (cadr slope_bottom)))
		(setq slope_top (cddr slope_top))
		(setq slope_bottom (cddr slope_bottom))
		(setq slope_list_length (- slope_list_length 1))
		(command "line" (car top_points) (car bottom_points) "")
		(command "line" (car top_points) (cadr bottom_points) "")
		(command "line" (cadr top_points) (cadr bottom_points) "")
	)
)

(defun da_SlopeOfWork (slope_top slope_bottom / )
	(list)
)

(defun da_slope ( function_name / slope_top slope_bottom list_data osnap_var poly_data)
	(setq poly_data (da_Entry))
	(setq osnap_var (getvar "osmode"))
	(setvar "osmode" 0)
	(setq slope_top (da_GetPointsOnSlopeTop (car poly_data)))
	(setq slope_bottom (da_GetPointsOnSlopeBottom (cadr poly_data) slope_top))
	(if (= function_name "D")
		(da_SlopeCoat slope_top slope_bottom)
		(if (= function_name "GN")
			(da_SlopeOfNotWork slope_top slope_bottom)
			(if (= function_name "GD")
				(da_SlopeOfWork slope_top slope_bottom)
				(princ)
			)
		)
	)
	(setvar "osmode" osnap_var)
)

(defun C:SlopeCoat ( / )
	(da_slope "D")
)

(defun C:SlopeOfNotWork ( / )
	(da_slope "GN")
)

(defun C:SlopeOfWork ( / )
	(da_slope "GD")
)

(prompt "\n Enter \"SlopeCoat\" or \"SlopeOfNotWork\" or \"SlopeOfWork\" to start program.\n")
(princ)

[devitg]

Do not forget it , put t the main defun 

 (setq osmode (getvar 'osmode))
  (setvar 'osmode 0)
  (setq orthomode (getvar 'orthomode))
  (setvar 'orthomode 0)
	(foreach list_data ldata
		(da_DrawCircle (cdr list_data) 10)
           	)
(setvar 'osmode osmode)
(setvar 'orthomode   orthomode)

[devitg]

Refer to geometrija1.png

To get the angle perpendicular to the B1 C1 ,at E1 , please check the 

vlax-curve-getFirstDeriv 
 
 
Returns the first derivative (in WCS) of a curve at the specified location

(vlax-curve-getFirstDeriv curve-obj param)
Arguments

curve-obj
The VLA-object to be measured.

param
A number specifying a parameter on the curve.

Return Values

A 3D vector list, if successful; otherwise nil.

Examples

For the following example, assume that splineObj points to the spline shown in the example of the vlax-curve-getDistAtParam function.

Obtain the start parameter of the curve:

_$ (setq startSpline (vlax-curve-getStartParam
splineObj))
0.0
Obtain the end parameter of the curve:

_$ (setq endSpline (vlax-curve-getEndParam
splineObj))
17.1546
Determine the first derivative at the parameter midway along the curve:

_$ (vlax-curve-getFirstDeriv
splineObj 
   ( / (- endspline startspline)
2))
(0.422631 -1.0951 0.0)

[Shinigami_black]

Thanks devitg, your help was great mostly vlax functions. It helped so much I don't need my calculations in dwg any more. But it is not meaningless experience. I may need this calculations in future.

Now I almost finished. All I need is to make a function to correct slope bottom points I find with vlax-curve-getClosestPointTo function. As some points will have same coordinates. So I need to move them one from other.

Here are my latest code.

(vl-load-com)

(setq GDISTANCE 200)
(setq GOSNAP_VAR 0)
(setq GLAYER 0)
(setq GORTHOMODE 0)

(defun da_ChangePropertes ( / )
	(setq GOSNAP_VAR (getvar "osmode"))
	(setq GLAYER (getvar "clayer"))
	(setq GORTHOMODE (getvar "orthomode"))
	(setvar "osmode" 0)
	(command "_layer" "m" "Slaitas" "")
	(setvar "orthomode" 0)
)

(defun da_ReturnPropertes ( / )
	(setvar "osmode" GOSNAP_VAR)
	(setvar "clayer" GLAYER)
	(setvar "orthomode" GORTHOMODE)
)

(defun da_FindCoordinates (point1 point2 ac / ab x3 y3)
	(setq ab (distance point1 point2))
	(setq x3 (/ (* (- (car point2) (car point1)) ac) ab))
	(setq y3 (/ (* (- (cadr point2) (cadr point1)) ac) ab))
	(list (+ (car point1) x3) (+ (cadr point1) y3))
)

(defun da_GetPointsOnSlopeBottom (ent_name coordinates / return_data temp)
	(setq return_data (list))
	(foreach xy coordinates
		(setq temp (vlax-curve-getClosestPointTo ent_name xy))
		(if (= temp nil)
			(princ)
			(setq return_data (append return_data (list temp)))
		)
	)
	(setq return_data return_data)
)

(defun da_GetPointsOnSlopeTop (ent_name / segment return_data count)
	(setq count 1)
	(setq segment 0)
	(setq return_data (list))
	(while (/= count nil)
		(setq segment (+ segment GDISTANCE))
		(setq count (vlax-curve-getPointAtDist ent_name segment))
		(if (/= count nil)
			(setq return_data (append return_data (list count)))
			(princ)
		)
	)
	(setq return_data return_data)
)

(defun da_GetPolylineData (/ polyline_name)
	(setq polyline_name (car (entsel)))
	(if (= (cdr (assoc 0 (entget polyline_name))) "LWPOLYLINE")
		(setq polyline_name polyline_name)
		(setq polyline_name "0")
	)
)

(defun da_GetPolyline (msg error_msg / polyline)
	(setq polyline "0")
	(while (= polyline "0")
		(princ msg)
		(setq polyline (da_GetPolylineData))
		(if (= polyline "0")
			(princ error_msg)
			(vlax-ename->vla-object polyline)
		)
	)
)

(defun da_Entry (/ top_of_slope bottom_of_slope)
	(setq GDISTANCE (cond ((getint (strcat "\n Enter distance <" (rtos GDISTANCE 2 0) ">: "))) (GDISTANCE)))
	(setq top_of_slope (da_GetPolyline "\n Select slope top.\n" "\n ERROR: not polyline.\n"))
	(setq bottom_of_slope (da_GetPolyline "\n Select slope bottom.\n" "\n ERROR: not polyline.\n"))
	(list top_of_slope bottom_of_slope)
)

(defun da_CoveringsSlope (slope_top slope_bottom / long short phase xy_top xy_bottom )
	(setq long 0.9)
	(setq short 0.5)
	(setq phase "L")
	(foreach xy_top slope_top
		(if (= phase "L")
			(progn
				(setq xy_bottom (da_FindCoordinates xy_top (car slope_bottom) (* (distance xy_top (car slope_bottom)) long)))
				(setq phase "S")
			)
			(progn
				(setq xy_bottom (da_FindCoordinates xy_top (car slope_bottom) (* (distance xy_top (car slope_bottom)) short)))
				(setq phase "L")
			)
		)
		(command "line" xy_top xy_bottom "")
		(setq slope_bottom (cdr slope_bottom))
	)
)

(defun da_MiningSlope (slope_top slope_bottom work_not_work / )
	(setq xy (car slope_top))
	(setq slope_list_length (/ (length slope_top) 2))
	(while (> slope_list_length 0)
		(setq top_points (list (car slope_top) (caddr slope_top)))
		(setq bottom_points (list (car slope_bottom) (cadr slope_bottom)))
		(setq slope_top (cddr slope_top))
		(setq slope_bottom (cddr slope_bottom))
		(setq slope_list_length (- slope_list_length 1))
		(command "line" (car top_points) (car bottom_points) "")
		(if (= (cadr top_points) nil)
			(command "_pline" (car top_points) (cadr bottom_points) xy "c")
			(command "_pline" (car top_points) (cadr bottom_points) (cadr top_points) "c")
		)
		(if (= work_not_work "T")
			(command "bhatch" "p" "ANGLE" 1 0 "s" (entlast) "" "")
			(princ)
		)
	)
)

(defun da_slope ( function_name / slope_top slope_bottom list_data osnap_var poly_data)
	(setq poly_data (da_Entry))
	(setq slope_top (da_GetPointsOnSlopeTop (car poly_data)))
	(setq slope_bottom (da_GetPointsOnSlopeBottom (cadr poly_data) slope_top))
	(da_ChangePropertes)
	(if (= function_name "D")
		(da_CoveringsSlope slope_top slope_bottom)
		(if (= function_name "GN")
			(da_MiningSlope slope_top slope_bottom "F")
			(if (= function_name "GD")
				(da_MiningSlope slope_top slope_bottom "T")
				(princ)
			)
		)
	)
	(da_ReturnPropertes)
)

(defun C:CoveringsSlope ( / )
	(da_slope "D")
)

(defun C:MiningSlopeNotWork ( / )
	(da_slope "GN")
)

(defun C:MiningSlopeWork ( / )
	(da_slope "GD")
)

(prompt "\n Enter \"CoveringsSlope\" or \"MiningSlopeNotWork\" or \"MiningSlopeWork\" to start program.\n")
(princ)

 If you could look in the code and comment  what could be made better,  would be a great help.

Thanks again.

[devitg]

As neither both us , speak english as it´s mothers language , I can only  see some things to change 

(defun da_slope ( function_name / slope_top slope_bottom list_data osnap_var poly_data)
	(setq poly_data (da_Entry))
	(setq slope_top (da_GetPointsOnSlopeTop (car poly_data)))
	(setq slope_bottom (da_GetPointsOnSlopeBottom (cadr poly_data) slope_top))
	(da_ChangePropertes)
;;;	(if (= function_name "D")
;;;		(da_CoveringsSlope slope_top slope_bottom)
;;;		(if (= function_name "GN")
;;;			(da_MiningSlope slope_top slope_bottom "F")
;;;			(if (= function_name "GD")
;;;				(da_MiningSlope slope_top slope_bottom "T")
;;;				(princ)
;;;			)
;;;		)
;;;	)

(cond
((= function_name "Coverings-slope") (da_CoveringsSlope slope_top slope_bottom))
((= function_name "mining-slope-Not-work" )((da_MiningSlope slope_top slope_bottom "F"))
((= function_name "mining-slope-Work" ) (da_MiningSlope slope_top slope_bottom "T"))

  
	(da_ReturnPropertes)
)




;;;(defun C:CoveringsSlope ( / )
;;;	(da_slope "D")
;;;)
;;;
;;;(defun C:MiningSlopeNotWork ( / )
;;;	(da_slope "GN")
;;;)
;;;
;;;(defun C:MiningSlopeWork ( / )
;;;	(da_slope "GD")
;;;)

(defun c:slope (/ )

(initget "Coverings-slope,  mining-slope-Not-work,  mining-slope-Work ")
(setq function_name (getkword "\nEnter an option (Coveringsslope/miningslopeNotwork/miningslopeWork): "))


 
)




;(prompt "\n Enter \"CoveringsSlope\" or \"MiningSlopeNotWork\" or \"MiningSlopeWork\" to start program.\n")
(princ)