Fillet lot of waves with one selection

Fillet lot of waves with one selection

eakos1
Advocate Advocate
492 Views
8 Replies
Message 1 of 9

Fillet lot of waves with one selection

eakos1
Advocate
Advocate

I have to connect a lot of waves. I want to have a program which can do it automatically. 

I stacked a little bit, I don't know how to do it. 

I've started an the logic behind is, that I check the lower end of the lines, it an lower endpoint of an other line is inside of a certain rectangular than do the fillet. It works if the columns are more or less on the same level and the high difference it not too much - green area. 

 

eakos1_1-1708444952515.png

 

 

eakos1_0-1708444518497.png

 

By selection of the right side leads misfunction

eakos1_2-1708445310710.png

 

Has someone an better idea how to that?

 

(setq ss (ssget (list (cons 0 "LINE"))))

(setq n 0)
(setq n1 0)
(setq y_range 3)
(setq pitch 25)
(setq r 3)
(setvar 'filletrad r)

(repeat	(sslength ss)
  (setq e1 (ssname ss n))
  (setq e1_vla (vlax-ename->vla-object e1))
  (setq e1s (vlax-curve-getStartPoint e1_vla))
  (setq e1e (vlax-curve-getEndPoint e1_vla))
  (if (< (cadr e1s) (cadr e1e))
    (progn
      (setq e1low e1s)
      (setq e1hig e1e)
    ) ;_ progn
    (progn
      (setq e1low e1e)
      (setq e1hig e1s)
    ) ;_ progn
  ) ;_ if
;;;  (entmake (list (cons 0 "point") (cons 10 e1low) (cons 62 2))) ; yellow
  (repeat (sslength ss)
    (setq e2 (ssname ss n1))
    (setq e2_vla (vlax-ename->vla-object e2))
    (setq e2s (vlax-curve-getStartPoint e2_vla))
    (setq e2e (vlax-curve-getEndPoint e2_vla))
    (if	(< (cadr e2s) (cadr e2e))
      (setq e2low e2s)
      (setq e2low e2e)
    ) ;_ if
;;;    (entmake (list (cons 0 "point") (cons 10 e2low) (cons 62 1))) ; red

    (if	(and (< (cadr e2low) (+ (cadr e1low) y_range)) (> (cadr e2low) (- (cadr e1low) y_range)))
      (if (and (< (car e1low) (car e1hig)) (< (car e2low) (car e1low)) (< (distance e1low e2low) (/ pitch 2)))
	(command "_.fillet" e1 e2)
	)
    ) ;_ if 
   
    (setq n1 (+ n1 1))
  ) ;_ repeat

  (setq n1 0)
  (setq n (+ n 1))
) ;_ repeat

 

0 Likes
Accepted solutions (1)
493 Views
8 Replies
Replies (8)
Message 2 of 9

ВeekeeCZ
Consultant
Consultant

With little effort, you can rewrite the given code to this. (now it's fence sel to fence sel)

 

eekeeCZ_0-1708447715463.png

 

(defun c:filletem ()
  
  (and (or (command "_.select" "_f" (setq p1 (getpoint "\nSelect objects to fillet of FIRST side: ")) (setq p2 (getpoint "... next point:" ))) (command) T)
       p1 p2
       (setq s1 (ssget "_f" (list p1 p2) '((0 . "LINE"))))
       (setq l1 (vl-remove (cadr ls) (vl-remove (car ls) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s1))))))
       (or (command "_.select" "_f" (setq p3 (getpoint "\nSelect respective objects on OTHER side: ")) (setq p4 (getpoint "... next point:" ))) (command) T)
       p3 p4
       (setq s2 (ssget "_f" (list p3 p4) '((0 . "LINE"))))
       (setq l2 (vl-remove (cadr ls) (vl-remove (car ls) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2))))))
       (setq px (mapcar '/ (mapcar '+ p1 p4) '(2 2)))
       (mapcar '(lambda (e1 e2 / lst)
		  (command-s "_.FILLET"
		    (cons e1 (list (trans (vlax-curve-getClosestPointTo e1 px) 0 1)))
		    (cons e2 (list (trans (vlax-curve-getClosestPointTo e2 px) 0 1)))))
	       l1 l2)
       )
  )

 

0 Likes
Message 3 of 9

eakos1
Advocate
Advocate

How this works, I get always error. 

 

 

eakos1_0-1708450709993.png   

eakos1_1-1708450862395.png

 

 

0 Likes
Message 4 of 9

Sea-Haven
Mentor
Mentor

I am sure BeekeeCZ will sort error problem but have you thought about draw it correct 1st Go. You can draw a pline with line arc line segments, I take it your selecting the vertical lines  to start with ? may need a bit of thought.

 

 

0 Likes
Message 5 of 9

Sea-Haven
Mentor
Mentor

I tried the code did not work ? Not sure why not. Also added the draw line when dragging.

 

I tried with odd number of lines L-R and worked fine that is a real benefit.

 

(defun c:filletem ()
  (setq p1 (getpoint "\nSelect objects to fillet of FIRST side: ")) 
  (setq p2 (getpoint p1 "... next point:" ))
       (setq s1 (ssget "_f" (list p1 p2) '((0 . "LINE"))))
       (setq l1 (vl-remove (cadr ls) (vl-remove (car ls) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s1))))))
       (setq p3 (getpoint "\nSelect respective objects on OTHER side: ")) 
	   (setq p4 (getpoint p3 "... next point:" ))
       (setq s2 (ssget "_f" (list p3 p4) '((0 . "LINE"))))
       (setq l2 (vl-remove (cadr ls) (vl-remove (car ls) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2))))))
       (setq px (mapcar '/ (mapcar '+ p1 p4) '(2 2)))
       (mapcar '(lambda (e1 e2 / lst)
		  (command-s "_.FILLET"
		    (cons e1 (list (trans (vlax-curve-getClosestPointTo e1 px) 0 1)))
		    (cons e2 (list (trans (vlax-curve-getClosestPointTo e2 px) 0 1)))))
	       l1 l2)
)

 

 

0 Likes
Message 6 of 9

ВeekeeCZ
Consultant
Consultant

Here is the simplified version to better show the principle. 

Tested all versions posted here and all work for me in 2022. 

 

(defun c:filletem ()

  (command "_.select" "_f" (getpoint "\nSelect objects to fillet of FIRST side: ") (getpoint "... next point:" ) "" "")
  (setq s1 (ssget "_p"))

  (command "_.select" "_f" (getpoint "\nSelect respective objects on OTHER side: ") (getpoint "... next point:" ) "" "")
  (setq s2 (ssget "_p"))

  (repeat (setq i (min (sslength s1) (sslength s2)))
    (setq i (1- i))
    (command "_.FILLET" (ssname s1 i) (ssname s2 i)))

  )

 

0 Likes
Message 7 of 9

eakos1
Advocate
Advocate

Thank you, this works!  

If I will have time, I will check line-by line the first program why give it always failure to me - tested exactly on the same lines. 

 

eakos1_0-1708505478881.png

 

0 Likes
Message 8 of 9

ВeekeeCZ
Consultant
Consultant

That could be version-specific. If you have 2015 and lower, try just command instead of command-s.

0 Likes
Message 9 of 9

komondormrex
Mentor
Mentor
Accepted solution

check the following

 

 

(defun c:fillet_angled (/ lines_sset lines_list_1 lines_list_2)
	(if (setq lines_sset (ssget '((0 . "line"))))
			(setq lines_list_2 (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex lines_sset)))))
	)
	(setq lines_list_1 (vl-remove-if-not '(lambda (line) (or (equal (vla-get-angle line) (angtof "325" 0) (angtof "25" 0))
															 (equal (vla-get-angle line) (angtof "145" 0) (angtof "25" 0))
														 )
										  )
										  lines_list_2
					   )
	      lines_list_2 (vl-remove-if-not '(lambda (line) (or (equal (vla-get-angle line) (angtof "215" 0) (angtof "25" 0))
											 				 (equal (vla-get-angle line) (angtof "35" 0)  (angtof "25" 0))
										 				 )
					   					  )
						  lines_list_2
					   )
	)
	(setvar 'filletrad 3)
	(if (= (length lines_list_1) (length lines_list_2))
		(foreach line_1 lines_list_1
			(setq mid_point_1 (mapcar '* '(0.5 0.5) (mapcar '+ (vlax-get line_1 'startpoint)
															   (vlax-get line_1 'endpoint)
													)
							  )
			)
			(command "_fillet"
					(vlax-vla-object->ename line_1)
					(vlax-vla-object->ename
						(setq line_2 (car (vl-sort lines_list_2 '(lambda (line_2_1 line_2_2) (< (distance mid_point_1 (mapcar '* '(0.5 0.5) (mapcar '+ (vlax-get line_2_1 'startpoint)
																   																	      			   (vlax-get line_2_1 'endpoint)
																															   				)
																									     			  )
																				   				)
																				   				(distance mid_point_1 (mapcar '* '(0.5 0.5) (mapcar '+ (vlax-get line_2_2 'startpoint)
																   																	      			   (vlax-get line_2_2 'endpoint)
																															   				)
																									     			  )
																				   				)
																							 )
													 			  )
							 			   )
									 )
						)
					)
			)
			(setq lines_list_2 (vl-remove line_2 lines_list_2))
		)
		(alert "Different numbers of lines to fillet")
	)
	(princ)
)

 

 

komondormrex_0-1708525367776.png

komondormrex_1-1708525502855.png

 

 

 

0 Likes