lisp for Double fillet?

[smallƑish]

Is that possible with Lisp?

fillet both corners in one click?

[dlbsurveysuk]

 I quite often have a situation like the left of attached image. My mod of your code currently allows me to multi pick in the vicinity of the crosses as in the middle image to achieve "caps" as on the right. I'm currently working on another routine where picking the long vertical red line with ssget fence will auto trim alternately all the way up.

I'm trying to come up with a suite of routines that minimises the number of clicks to achieve left to right.

Sorry image is a bit blurry.

 

 

[komondormrex]

i see it now) 

[smallƑish]

Genius @komondormrex

Eagerly Awaiting for reply on this 

[dlbsurveysuk]

Found this Lisp - Break all or Some by CAB http://www.theswamp.org/index.php?topic=10370.msg132035 which has the option to break and remove every other segment.

Now I can use EXTRIM, BREAKREMOVE, and FD (your routine modified) to achieve the attached.

Thanks a lot for your original routine.

 

[Sea-Haven]

The 1st step trim white line can be one pick, pick an end of line this implies a direction, say up, offset line to right a small amount as you know which way is right, get start and end points, erase line, TRIM use white line already picked for cut then "F" for fence option use start and end, all done. 

The other steps more thought. 

[dlbsurveysuk]

Another problem.

My modification of your original routine includes a simple while loop so I can just keep picking and then escape.

Currently this doesn't allow me to undo one "cap". An undo after escape undoes all the "caps" and one previous command.

I've been trying to figure out how to use various configurations of undo / begin / end / mark / back but I can't get anything to work.

Any help appreciated. Thanks.

;**************************************************************************************************************************************************

;	Modified from original by komondormrex, aug 2023

;**************************************************************************************************************************************************

(defun check_angle (line_list / angle_line_list pattern_angle )
	(setq angle_line_list (list (cons 0 (car line_list)))
	      pattern_angle (vla-get-angle (car line_list))
	      line_list (cdr line_list)
	      angle_line_list (append angle_line_list (mapcar '(lambda (line) (cons (cond
									 		(
											 	(or (equal pattern_angle (vla-get-angle line) 1e-3)
												    (equal pattern_angle (+ pi (vla-get-angle line)) 1e-3)
												)
											 		0
											)
											(
											 	(or (equal (abs (- pattern_angle (vla-get-angle line))) (* 0.5 pi) 1e-3)
												    (equal (abs (- pattern_angle (vla-get-angle line))) (* 1.5 pi) 1e-3)
												)
											 		(* 0.5 pi)
											)
											(
											 	t
											 		(abs (- pattern_angle (vla-get-angle line)))
											)
										    )
										    line
									     )
								 )
							      	 line_list
						      )
			      )
	)
  	(cond
		(
			(= (* 0.5 pi) (apply '+ (mapcar 'car angle_line_list)))
		 		(cdr (assoc (* 0.5 pi) angle_line_list))
		)
		(
		 	(= pi (apply '+ (mapcar 'car angle_line_list)))
		 		(cdr (assoc 0 angle_line_list))
		)
		(
		 	t
		 		nil
	 	)
	)
)

;**************************************************************************************************************************************************

	    (defun mkOCTlist (MIDCAP SFACT)
		(mapcar '(lambda (_angle) (polar MIDCAP _angle SFACT))
			 (mapcar '*
			    (list 0 (/ pi 4) (/ pi 4) (/ pi 4) (/ pi 4) (/ pi 4) (/ pi 4) (/ pi 4))
			    '(0 1 2 3 4 5 6 7)
			 );mapcar
		);mapcar 
	    )

;**************************************************************************************************************************************************

(defun c:FD (/ MIDCAP SFACT COUNT tube_lines_sset line_list perpendicular_line intersection_point start_point)

(setvar 'cmdecho 0)

(while

              (setvar 'osmode 0)
              (setq MIDCAP (getpoint "Select point near cap line : ")
                    SFACT 0.2
	            COUNT 0
                           start_point nil)
	       
			(if MIDCAP			  
			    (progn			      
                                (while (/= COUNT 3)
                                   (setq SFACT (+ SFACT 0.01)
				         tube_lines_sset (ssget "_CP" (mkOCTlist MIDCAP SFACT) (list (cons 0 "line")))
				         COUNT (sslength tube_lines_sset))
                                );while
			     );progn
			 );if

  	(if (and tube_lines_sset
		 (setq line_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex tube_lines_sset)))))
		 (= 3 (length line_list))
		 (setq perpendicular_line (check_angle line_list))
	    )
		(progn
			(setq line_list (vl-remove perpendicular_line line_list))
		  	(foreach line line_list
				(if (< (distance (vlax-get line 'startpoint) 
					      	 (setq intersection_point (inters (vlax-get line 'startpoint)
									          (vlax-get line 'endpoint)
									          (vlax-get perpendicular_line 'startpoint)
									          (vlax-get perpendicular_line 'endpoint)
									          nil
								          )
					         )
					)
				        (distance (vlax-get line 'endpoint) 
					      	  intersection_point
				        )
			       	    )
				  	(vla-put-startpoint line (vlax-3d-point intersection_point))
				  	(vla-put-endpoint line (vlax-3d-point intersection_point))
			  	);if
			  	(if (not start_point)
				  	(setq start_point intersection_point)
				);if
			);foreach
		  	(vla-put-startpoint perpendicular_line (vlax-3d-point start_point))
			(vla-put-endpoint perpendicular_line (vlax-3d-point intersection_point))
		 );progn
	  	 (princ "\nNot three lines selected or they do not hold two parallel lines and one perpendicular line.")
  	);if
);while
(princ)
)

[komondormrex]

i think undoing one cap can't be done in a way you want it (mark undo, undo). needs sort of confirmation of current cap to be done with rough previewing or showing currently selected three lines to make a cap,  imho. 

[dlbsurveysuk]

OK I am fine with things as they are.

Am I correct in assuming that because there are no "command" lines in your code and it's all "vla/vlax", this is why if I then undo after exiting the routine it will undo the previous command before the lisp routine?

Adding (command "undo" "mark") before the while loop seems to have cured this. Also edited the while loop so that return/enter exits the routine, and a reset for osmode.

Thanks again.

[komondormrex]

nope, that is because there is no start, end undo marks in the code to avoid undoing prevoius command. and surely they are existing in vl*.

start mark, end mark

(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))

put them at the very start and very end of main code to resolve your problem.