Trouble with my LISP

Trouble with my LISP

Anonymous
Not applicable
716 Views
4 Replies
Message 1 of 5

Trouble with my LISP

Anonymous
Not applicable

I'm having problems with this LISP. It is meant to produce the table i have shown in Capture.PNG , but the table is resulting in an error and is producing the table as is shown in Capture2.PNG

 

Capture2.PNGCapture.PNG

0 Likes
717 Views
4 Replies
Replies (4)
Message 2 of 5

Anonymous
Not applicable

the ARC1 file the lisp is referring to is attached here

0 Likes
Message 3 of 5

ennujozlagam
Mentor
Mentor

i don't see any issues. you need to pick the text. thanks





Remember : without the difficult times in your LIFE, you wouldn't be who you are today. Be grateful for the good and the bad. ANGER doesn't solve anything. It builds nothing, but it can destroy everything...
Please mark this response as "Accept as Solution" if it answers your question. Kudos gladly accepted.
0 Likes
Message 4 of 5

CADaSchtroumpf
Advisor
Advisor

If can be interrest you?

You can select multiple arc or polyarc for write the setout box.

 

(vl-load-com)
(defun c:ARCC ( / js n AcDoc Space ename obj pr nb typ_obj oldim oldlay a_base a_dir
 pt_start pt_end pt_cen rad alpha pt_vtx dist_start dist_end seg_len seg_bulge)
	(defun grdraw-id_arc ( / )
		(grdraw (trans pt_start 0 1) (trans pt_vtx 0 1) 1)
		(grdraw (trans pt_vtx 0 1) (trans pt_end 0 1) 1)
		(grdraw (trans pt_start 0 1) (trans pt_cen 0 1) 3)
		(grdraw (trans pt_cen 0 1) (trans pt_end 0 1) 3)
	)
	(defun add_mt_arc ( / ins_txt h_t)
		(initget 9)
		(setq ins_txt (getpoint (trans pt_cen 0 1) "\nInsertion point of arc setout box?: "))
		(initget 6)
		(setq h_t (getdist ins_txt (strcat "\nHeigth of text <" (rtos (getvar "textsize")) ">: ")))
		(if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
		(vla-addMtext Space
			(vlax-3d-point (trans ins_txt 1 0))
			0.0
			(strcat
				"{\\fArial Narrow|b0|i0|c0|p34;"
				"\\LSET OUT DETAILS\\l"
				"\\PRAD. = " (rtos rad 2 3)
				"\\PINT = " (vl-string-subst "%%d" "d" (angtos (* 2 alpha) 1 4))
				"\\PTAN = " (rtos (distance pt_start pt_vtx) 2 3)
				"\\PCHD = " (rtos (distance pt_start pt_end) 2 3)
				"\\PARC = " (rtos seg_len 2 3)
				"\\PM1 = " (rtos (* rad (- 1 (cos alpha))) 2 3)
				"\\PM2 = " (rtos (* rad (- 1 (cos (/ alpha 2)))) 2 3)
				"}"
			)
		)
		(entmod
			(append
			(vl-remove-if
				(function
					(lambda (x)
						(or (member (car x) '(90 63 421 45))
							(< 419 (car x) 440)
						)
					)
				)
				(entget (entlast))
			)
			(list
				'(90 . 1)
				'(63 . 41)
				'(421 . 16770196)
				'(45 . 1.5)
			)
			)
		)
		(entupd (entlast))
	)
	(princ "\nSelect Arcs/PolyArcs .")
	(setq
		js
		(ssget
			'((-4 . "<OR")
				(-4 . "<AND")
					(0 . "POLYLINE")
					(-4 . "<NOT")
						(-4 . "&") (70 . 126)
					(-4 . "NOT>")
				(-4 . "AND>")
				(0 . "LWPOLYLINE,ARC")
				(-4 . "OR>"))
		)
		n -1
	)
	(cond
		(js
			(setq
				AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
				Space
					(if (= 1 (getvar "CVPORT"))
						(vla-get-PaperSpace AcDoc)
						(vla-get-ModelSpace AcDoc)
					)
				nb 0
			)
			(cond
				((null (tblsearch "LAYER" "LAYER25"))
					(vlax-put (vla-add (vla-get-layers AcDoc) "LAYER25") 'Color "5")
				)
			)
			(setq
				oldim (getvar "dimzin")
				oldlay (getvar "clayer")
				a_base (getvar "ANGBASE")
				a_dir (getvar "ANGDIR")
			)
			(setvar "dimzin" 0) (setvar "clayer" "LAYER25")
			(setvar "ANGBASE" 0) (setvar "ANGDIR" 0)
			(repeat (sslength js)
				(setq
					ename (ssname js (setq n (1+ n)))
					obj (vlax-ename->vla-object ename)
					pr -1
					nb 0
				)
				(setq typ_obj (vla-get-ObjectName obj))
				(if (eq typ_obj "AcDbArc")
					(progn
						(setq
							pt_start (vlax-get obj 'StartPoint)
							pt_end (vlax-get obj 'EndPoint)
							pt_cen (vlax-get obj 'Center)
							rad (vlax-get obj 'Radius)
							alpha (* (vlax-get obj 'TotalAngle) 0.5)
							seg_len (vlax-get obj 'ArcLength)
							pt_vtx (polar pt_cen (+ (vlax-get obj 'StartAngle) alpha) (+ rad (* rad (1- (/ 1 (cos alpha))))))
							nb (1+ nb)
						)
						(grdraw-id_arc)u 
						(add_mt_arc)
					)
					(repeat (fix (vlax-curve-getEndParam obj))
						(setq
							dist_start (vlax-curve-GetDistAtParam obj (setq pr (1+ pr)))
							dist_end (vlax-curve-GetDistAtParam obj (1+ pr))
							pt_start	 (vlax-curve-GetPointAtParam obj pr)
							pt_end (vlax-curve-GetPointAtParam obj (1+ pr))
							seg_len (- dist_end dist_start)
							seg_bulge (vla-GetBulge obj pr)
						)
						(if (not (zerop seg_bulge))
							(progn
								(setq
									rad (/ seg_len (* 4.0 (atan seg_bulge)))
									alpha (+ (angle pt_start pt_end) (- (* pi 0.5) (* 2.0 (atan seg_bulge))))
									pt_cen (polar pt_start alpha rad)
									pt_vtx (polar pt_start (- alpha (* pi 0.5)) (* rad (/ (sin (* 2.0 (atan seg_bulge))) (cos (* 2.0 (atan seg_bulge))))))
									alpha (if (< (* 2.0 (atan seg_bulge)) 0) (- pi (* 2.0 (atan seg_bulge))) (* 2.0 (atan seg_bulge)))
									nb (1+ nb)
								)
								(grdraw-id_arc)
								(add_mt_arc)
							)
						)
					)
				)
			)
			(setvar "dimzin" oldim) (setvar "clayer" oldlay)
			(setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir)
		)
	)
	(prin1)
)
0 Likes
Message 5 of 5

Kent1Cooper
Consultant
Consultant

My guess:  Your current Text Style is defined with a fixed height, but the routine is not written for that.  I'm guessing that because of the little "90" which is likely from the first Text command, in which if the current Style has a fixed height, the height question will not be asked, the height answer will be taken as the rotation, and the rotation answer will be taken as the text content.

 

Try making any Style without  a fixed height [defined height = 0] current, and running it again.  You can build the setting of the current Text Style into the routine, to avoid this issue.

 

[This might be what @ennujozlagam meant by "you need to pick the text."  Ordinarily I would assume that is talking about selecting a Text object, so it didn't make sense to me here, but it could be about setting the current Style.]

Kent Cooper, AIA
0 Likes