LISP routine to "repair" a fillet between two lines & routine to select a radius get dimension and delete it

[Warcrafter]

Hello together,

 

I am rather new in programming LISP routines and I have a question about two routines I would like to create:

I found this one on the Internet:

;Fillet Copy
;Copies the Radius of an Existing Fillet or Arc;
(defun C:filletcopy ()
(setvar "cmdecho" 0)
(setq c1 (entsel "\n Select Fillet to Copy:"))
(setq c1 (entget (car c1)))
(setq rad (cdr(assoc 40 c1)))
(setvar "filletrad" rad)
(princ "\nSelect Lines:")
(command "_fillet" pause pause)
)

...and it works fine to get the dimension of an existing radius and can fillet two lines.

So my idea was this:

;Fillet Copy
;Copies the Radius of an Existing Fillet or Arc;
(defun C:radplusdel ()
(setvar "cmdecho" 0)
;(setq c1 (entsel "\n Select Fillet to Copy:"))
(setq c1 (entsel (strcat "\n Select Fillet to Copy:")))
(setq c1 (entget (car c1)))
(setq rad  (+ 0.1 (cdr(assoc 40 c1))))
(setvar "filletrad" rad)
(princ "\nSelect Lines:")
;(command "_fillet" pause pause)

(progn ;; Offset object
	(while (command "_fillet" pause pause))
	;; Delete original (entdel won't **** the bed if the object is locked)
	(entdel (car c1))
				)

)

I would like to get the fillet dimension of an existing radius, make it 0.1 bigger and delete the old one. But it doesn't delete.

 

My second idea is kind of "repairing" the radius between two lines - but there I have no idea how to start programming.

It should go like this:

1. I select two lines and the radius (which may not fit exactly)

2. The routine gets the dimension of the radius and where it is

3. The routine "refreshes" the radius between the two lines and delete the old one.

 

4. If possible the routine should loop through the layers, provided that ther are only 1 radius and two lines on each layer are selected.

 

Just for explanation, I have many layers on the top of each other, only the scaling factor of the lines is different, so the radii are not fitting anymore.

Any suggestions to solve these two topics are welcome.

Thanks,

René

[BIGAL]

This is close if you ask Alan he may change it to accept a fixed value.

 

 

Dynamic fillet.lsp

[Warcrafter]

On 3/27/2021 at 4:55 AM, BIGAL said:

This is close if you ask Alan he may change it to accept a fixed value.

 

 

Dynamic fillet.lsp 3.04 kB · 5 downloads

Hello and thanks for your reply - but that's quite "too" dynamic.

In the meanwhile I solved my first problem by myself, by changing the variables for the fillet...

 

For my second "wish" I upload a screenshot of my idea, I hope this will make it a little bit clearer....

1. I would like to have the possibility to select 3 objects (two lines/two bows/one line&one bow... AND a radius which connects this objects) - if possible on different layer...

I need to scale my objects (lines, bows..) and the radius should not change (in my example, I scale the Layer K1 to Layer K2), but through scaling the Radius goes from 10 to 9.79.

And sometimes I can't scale the radius - so the 3 Objects aren't connected anymore...

In simple words: start Lisp -> maybe ask for a radius to set (or use the found radius) select max. three objects per layer -> check object types -> If radius is found between the objects get dimension and round off the objects again..

 

Looking forward to get some ideas...

[BIGAL]

Something like this

 

; simple rescale a line arc line but keep rad
; By AlanH march 2021


(defun c:chgarc ( / doline doarc ss ent l1 l2 mp rad)
(defun doline ( )
	(if (= l1 nil)
		(setq l1 ent)
		(setq l2 ent)
	)
	(princ)
)

(defun doarc ( )
	(setq rad (cdr (assoc 40 (entget ent))))
	(setq a1 ent)
	(princ)
)

(setq sc (getreal "\nEnter scale factor "))
(setq pt (getpoint "pick point for scaling"))
(setq ss (ssget '((0 . "ARC,LINE"))))

(repeat (setq x (sslength ss))
	(setq ent (ssname ss (setq x (- x 1))))
	(cond
		((= (cdr (assoc 0 (entget ent))) "LINE")(doline))
		((= (cdr (assoc 0 (entget ent))) "ARC")(doarc))
	)
)

(command "scale" ss "" pt sc)
(command "erase" a1 "")
(setvar 'filletrad rad)
(setq mp (mapcar '*(mapcar '+ (cdr (assoc 10 (entget l2))) (cdr (assoc 11 (entget l2)))) '(0.5 0.5)))
(command "fillet" l1 mp)

(princ)
)
(c:chgarc)