Old Lisp routine that doesn't work anymore

[Anonymous]

Hi, I have a lisp routine  to trim all excess from arcs on interlocks at intersections. I use it to draw puzzle dies (see picture below).

;

(defun C:TRIMP-2 (/ cmde ssarc ssline ptlist arcno arcname cent radius
stang eang pt1 pt2 oldpick oldsnap)

(setq cmde (getvar "CMDECHO") ;save old variables
oldpick (getvar "PICKBOX")
oldsnap (getvar "OSMODE")

;WARNING: the routine only trims arcs on layer cle. To work on other layers
; remove the "(8 . "cle")" from the next line.

ssarc (ssget '((0 . "ARC") (8 . "cle"))) ;get set of arcs
arcno (sslength ssarc)
)
(setvar "CMDECHO" 0) ;turn off command prompts
(setvar "PICKBOX" 0) ;turn down pick box
(setvar "OSMODE" 0) ;turn off osnaps

; we need to find points on the free ends of the arcs to feed
; to the trim command.
(while (> arcno 0)
(setq arcno (1- arcno) ; decrement counter
arcname (ssname ssarc arcno) ; get name of arc
cent (cdr (assoc 10 (entget arcname))) ; get the center
radius (cdr (assoc 40 (entget arcname))) ; get the radius
stang (cdr (assoc 50 (entget arcname))) ; get the start angle
eang (cdr (assoc 51 (entget arcname))) ; get the end angle
pt1 (cal "cent+[radius<r2d(stang)]") ; get the start point
pt2 (cal "cent+[radius<r2d(eang)]") ; get the end point
ssline (ssget "C" (cal "cent-2*[radius,radius]")
(cal "cent+2*[radius,radius]") '((0 . "LINE"))) ;get set of lines
)
;if the block is not at the pt1 end
(if (= (sslength (ssget "C" (cal "pt1-[0.0001,0.0001]") (cal "pt1+[0.0001,0.0001]"))) 1)
(command "TRIM" ssline "" pt1 "") ;trim this end
(command "TRIM" ssline "" pt2 "") ;otherwise use the other end
) )
(setvar "CMDECHO" cmde) ;restore old vars
(setvar "PICKBOX" oldpick) ;turn down pick box
(setvar "OSMODE" oldsnap) ;turn off osnaps
(princ)
)

(defun C:AA (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause "" 0)(setvar "CLAYER" l))
(defun C:BB (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause "" 270)(setvar "CLAYER" l))
(defun C:CC (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause "" 180)(setvar "CLAYER" l))
(defun C:DD (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause "" 90)(setvar "CLAYER" l))

(defun C:A8 (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause 0.8 0)(setvar "CLAYER" l))
(defun C:B8 (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause 0.8 270)(setvar "CLAYER" l))
(defun C:C8 (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause 0.8 180)(setvar "CLAYER" l))
(defun C:D8 (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause 0.8 90)(setvar "CLAYER" l))

(defun C:A6 (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause 0.6 0)(setvar "CLAYER" l))
(defun C:B6 (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause 0.6 270)(setvar "CLAYER" l))
(defun C:C6 (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause 0.6 180)(setvar "CLAYER" l))
(defun C:D6 (/ l)
(setq l (getvar"CLAYER"))(setvar "CLAYER" "cle")
(command ".INSERT" "*A" pause 0.6 90)(setvar "CLAYER" l))

It sometimes works, but most of the time it doesn't. Here's the message I get:

Command: TRIMP-2
Select objects: Specify opposite corner: 20 found
Select objects:
Invalid window specification.
; error: Function cancelled
Select object to trim or shift-select to extend or
[Fence/Crossing/Project/Edge/eRase]: Specify opposite corner:
Does not intersect with the cutting edge.
Specify opposite corner:
Does not intersect with the cutting edge.
Specify opposite corner:
Does not intersect with the cutting edge.
Specify opposite corner: *Cancel*
Command: *Cancel*
Command: Specify opposite corner or [Fence/WPolygon/CPolygon]:

[leeminardi]

Please post a sample file where it works and one where it doesn't.

[Anonymous]

The thing is that it works randomly. In the file I have attached (puzzle keys), it works with the bigger keys but not with the two other sizes. In the second file (puzzle key not working), well the name says it all.

Sometimes it doesn't work at all in a drawing and when I copy the keys in a new drawing, it works on some of them, but never completely. In a drawing, I could attach two lines to a puzzle key, make ten copies of it and it could work on only three of them... Thanks

[leeminardi]

Giving the TRIMP-2 command yields  an error message that the function CAL is not defined.

; error: no function definition: CAL

In the future when posting code please use the code tags.

[ВeekeeCZ]

Well, the CAL issue is easy... but why it's not wokring...

https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2015/ENU/AutoCAD-AutoLISP/file...

Edit: found it. It's a view setting. Change it to ht 2d Wireframe and to Top view.

[leeminardi]

I think the problem is related to the program setting the pickbox value to 0.

Try changing changing the statement to:

(setvar "pickbox" 1)

and see if that helps. 

[ВeekeeCZ · Accepted solution]

Agreed. That will help. I guess it's one thing and/or another.

I don't work with views much so I can't assess how a change of view affects the precision and how much that could be covered by larger pickbox. 

If I wrote the routine I would probably use the BREAK instead of TRIM. 

[Anonymous]

I did both, set the view to 2d Wireframe with the Top view and changed the pickbox to 1 and it works perfectly everytime.

Thanks a lot guys, I really appreciate it.