Visual LISP, AutoLISP and General Customization

Reply
Valued Contributor
Shinigami_black
Posts: 58
Registered: ‎06-21-2012
Message 11 of 17 (159 Views)

Re: LISP problem in function

07-28-2012 10:45 PM in reply to: Kent1Cooper

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.

Valued Contributor
Shinigami_black
Posts: 58
Registered: ‎06-21-2012
Message 12 of 17 (154 Views)

Re: LISP problem in function

07-29-2012 03:10 AM in reply to: 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.

Valued Contributor
Shinigami_black
Posts: 58
Registered: ‎06-21-2012
Message 13 of 17 (146 Views)

Re: LISP problem in function

07-29-2012 07:06 AM in reply to: 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)

 

Mentor
devitg
Posts: 1,692
Registered: ‎03-14-2004
Message 14 of 17 (141 Views)

Re: LISP problem in function

07-29-2012 07:13 AM in reply to: Shinigami_black

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)

 

Mentor
devitg
Posts: 1,692
Registered: ‎03-14-2004
Message 15 of 17 (138 Views)

Re: LISP problem in function

07-29-2012 08:28 AM in reply to: 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)

 

Valued Contributor
Shinigami_black
Posts: 58
Registered: ‎06-21-2012
Message 16 of 17 (135 Views)

Re: LISP problem in function

07-29-2012 09:20 AM in reply to: devitg

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.

Mentor
devitg
Posts: 1,692
Registered: ‎03-14-2004
Message 17 of 17 (133 Views)

Re: LISP problem in function

07-29-2012 11:30 AM in reply to: Shinigami_black

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)

 

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community