Select Modify Arc

[ekko]

(vl-load-com)
(defun c:marc (/ ods p1 p2 ss c rd int1 elst int scir sc)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
  (setq	p1 (getpoint "\nSelect the first point:")
	p2 (getcorner p1 "\nSelect the second point:")
  )
  (setq ss (ssget "w" p1 p2 (list '(0 . "arc,lwpolyline,line"))))
  (etolst ss)
  (if (/= c nil)
    (progn
      (sortclst c)			;ARC primitive table sorted by radius size
      (cirint c elst)			;get the object that intersects the arc
      (setq scir (cdr (assoc 40 (entget (car c)))))
      (setq sc (- scir 200))
      (setq int1 (reverse int1))
      ;;Chamfer objects that intersect with arcs
      (foreach x int1
	(setq rd (- (car x) sc))
	(command "fillet"
		 "R"
		 rd
		 "fillet"
		 (car (cadr x))
		 (cadr (cadr x))
	)
      )
      (mapcar '(lambda (x) (entdel x)) c) ;delete old arc
    )
    (progn (princ "\nNo arc found, please try again!"))
  )					;if
  (setvar "cmdecho" 1)
  (setvar "osmode" ods)
  (princ)
)
;;Distinguish arcs from other primitives

(defun etolst (s)
  (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
    (if	(= (cdr (assoc 0 (entget x))) "ARC")
      (progn (setq c (cons x c)))
      (progn (setq elst (cons x elst)))
    )
  )
)



;;Find objects that intersect an arc
(defun cirint (q w / int)
  (foreach ce q
    (mapcar '(lambda (x / v)
	       (if (setq v (LM:intersections
			     (vlax-ename->vla-object x)
			     (vlax-ename->vla-object ce)
			     acextendnone
			   )
		   )
		 (setq int (cons x int))
	       )			;if
	     )
	    w
    )
    (setq rd (cdr (assoc 40 (entget ce))))
    (setq int1 (cons (list rd int) int1))
    (setq int nil)
    (princ)
  )					;foreach

)

;; Intersections  -  Lee Mac
(defun LM:intersections	(ob1 ob2 mod / lst rtn)
  (if (and (vlax-method-applicable-p ob1 'intersectwith)
	   (vlax-method-applicable-p ob2 'intersectwith)
	   (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      )
    (repeat (/ (length lst) 3)
      (setq rtn	(cons (list (car lst) (cadr lst) (caddr lst)) rtn)
	    lst	(cdddr lst)
      )
    )
  )
  (reverse rtn)
)
;;ARC primitive table sorted by radius size
(defun sortclst	(cl)
  (setq	c (vl-sort cl
		   '(lambda (e1 e2)
		      (< (cdr (assoc 40 (entget e1)))
			 (cdr (assoc 40 (entget e2)))
		      )
		    )
	  )
  )
)

Hello everyone, when I choose to modify the radius of the bilateral arc to a fixed value of 200mm, I seem to have done it, but my requirement is that the yellow lines on both sides can also move to the starting point of the new arc, or delete the original yellow line , you can also create two new lines, (note that the color of the line here is not a fixed yellow) What should this be done? Or is there a cleaner way to achieve this than mine? Or is there a vulnerability in my code? Please advise

marc202203.dwg

[mhupp]

Spitballing here.

 

make first arc get its endpoints
S1P1 (vlax-safearray->list (variant-value (vla-get-startpoint (entlast))))
S2P1 (vlax-safearray->list (variant-value (vla-get-endpoint (entlast))))

make second arc get its endpoints
S1P2 (vlax-safearray->list (variant-value (vla-get-startpoint (entlast))))
S2P2 (vlax-safearray->list (variant-value (vla-get-endpoint (entlast))))

Either update lines with new endpoints or erase them and draw new ones.

line1 s1p1 s1p2
line2 s2p1 s2p2

 

[ronjonp]

@mhupp

FWIW

;; This
(vlax-safearray->list (variant-value (vla-get-startpoint (entlast))))
;; is the same as this
(vlax-curve-getStartPoint (entlast))

 

Edited April 1, 2022 by ronjonp

[mhupp]

That doesnt seem to work in BricsCAD.

(vlax-get (vlax-ename->vla-object (entlast)) 'startpoint)

Edited April 1, 2022 by mhupp

[ronjonp]

56 minutes ago, mhupp said:

That doesnt seem to work in BricsCAD.

(vlax-get (vlax-ename->vla-object (entlast)) 'startpoint)

That was my bad .. I meant: (vlax-curve-getStartPoint (entlast))

[ekko]

3 hours ago, mhupp said:

That doesnt seem to work in BricsCAD.

(vlax-get (vlax-ename->vla-object (entlast)) 'startpoint)

(vl-load-com)
(defun c:tt (/	   ods	 p1    p2    ss	   c	 rd    int1  elst
	     int   scir	 sc    plst  seplst	 sp1   sp2   ep1
	     ep2   plst
	    )
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
  (setq	p1 (getpoint "\nSelect the first point:")
	p2 (getcorner p1 "\nSelect the second point:")
  )
  (setq ss (ssget "w" p1 p2 (list '(0 . "arc,lwpolyline,line"))))
  (etolst ss)
  (if (/= c nil)
    (progn
      (sortclst c)			;ARC primitive table sorted by radius size
      (cirint c elst)			;get the object that intersects the arc
      (setq scir (cdr (assoc 40 (entget (car c)))))
      (setq sc (- scir 200))
      (setq int1 (reverse int1))
      ;;Chamfer objects that intersect with arcs
      (foreach x int1
	(setq rd (- (car x) sc))
	(command "fillet"
		 "R"
		 rd
		 "fillet"
		 (car (cadr x))
		 (cadr (cadr x))
	)
	(setq plst
	       (list
		 (vlax-curve-getStartPoint
		   (vlax-ename->vla-object (entlast))
		 )
		 (vlax-curve-getEndPoint (vlax-ename->vla-object (entlast)))
	       )
	)				;Get new arc start and end points
	(setq seplst (cons plst seplst))
	(setq plst nil)
      )					;foreach
      (mapcar '(lambda (x) (entdel x)) c) ;delete old arc
      (setq sp1 (car (car seplst)))
      (setq ep1 (cadr (car seplst)))
      (setq sp2 (car (car (reverse seplst))))
      (setq ep2 (cadr (car (reverse seplst))))
      (addline sp1 sp2)
      (addline ep1 ep2)

    )
    (progn (princ "\nNo arc found, please try again!"))
  )					;if
  (setvar "cmdecho" 1)
  (setvar "osmode" ods)
  (princ)
)
;;Distinguish arcs from other primitives

(defun etolst (s)
  (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
    (if	(= (cdr (assoc 0 (entget x))) "ARC")
      (progn (setq c (cons x c)))
      (progn (setq elst (cons x elst)))
    )
  )
)



;;Find objects that intersect an arc
(defun cirint (q w / int)
  (foreach ce q
    (mapcar '(lambda (x / v)
	       (if (setq v (LM:intersections
			     (vlax-ename->vla-object x)
			     (vlax-ename->vla-object ce)
			     acextendnone
			   )
		   )
		 (setq int (cons x int))
	       )			;if
	     )
	    w
    )
    (setq rd (cdr (assoc 40 (entget ce))))
    (setq int1 (cons (list rd int) int1))
    (setq int nil)
    (princ)
  )					;foreach

)

;; Intersections  -  Lee Mac
(defun LM:intersections	(ob1 ob2 mod / lst rtn)
  (if (and (vlax-method-applicable-p ob1 'intersectwith)
	   (vlax-method-applicable-p ob2 'intersectwith)
	   (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      )
    (repeat (/ (length lst) 3)
      (setq rtn	(cons (list (car lst) (cadr lst) (caddr lst)) rtn)
	    lst	(cdddr lst)
      )
    )
  )
  (reverse rtn)
)
;;ARC primitive table sorted by radius size
(defun sortclst	(cl)
  (setq	c (vl-sort cl
		   '(lambda (e1 e2)
		      (< (cdr (assoc 40 (entget e1)))
			 (cdr (assoc 40 (entget e2)))
		      )
		    )
	  )
  )
)

;;add line
(defun addline (p1 p2)
  (entmake (list '(0 . "LINE")
		 (cons 10 p1)
		 (cons 11 p2)
		 '(8 . "new line")
	   )
  )
)

 

I tried it and it worked, thanks for your help, now the question is how to find out the original line, and delete it. My idea is to use int1 and elst to compare, find and keep the same object, delete the different, unfortunately, I don't know how to compare the two object tables. Can you provide ideas

 

 

 

 

 

Edited April 1, 2022 by ekko

[exceed]

 

There are a little things to consider before moving on to the next step.

1. There are 3 yellow lines.

2. The middle yellow line is 60mm longer than the other two lines.

3. The spacing between fittings is 0.2mm.

4. The straight offset value of the elbow fitting is 50mm. = The arc starts 50mm behind.

 

Drawing the line at the arc's endpoints successful

but have to think about which direction to look for the 50mm offset line.

 

 

As a simple method, this Lisp uses the (ssget "w") option,

so it may be a way to delete the line in the area,

connect the broken light blue line, and then create 3 new yellow lines.

Edited April 1, 2022 by exceed

[ekko]

35 minutes ago, exceed said:

 

There are a little things to consider before moving on to the next step.

1. There are 3 yellow lines.

2. The middle yellow line is 60mm longer than the other two lines.

3. The spacing between fittings is 0.2mm.

4. The straight offset value of the elbow fitting is 50mm. = The arc starts 50mm behind.

 

Drawing the line at the arc's endpoints successful

but have to think about which direction to look for the 50mm offset line.

 

 

As a simple method, this Lisp uses the (ssget "w") option,

so it may be a way to completely delete the line in the area,

connect the broken light blue line, and then create 3 new yellow lines.

Thank you for your suggestion. I am amazed that your observation is very detailed. I didn't find it. Okay, let me rearrange the logic of thinking first.

[ekko]

2 minutes ago, ekko said:

Thank you for your suggestion. I am amazed that your observation is very detailed. I didn't find it. Okay, let me rearrange the logic of thinking first.

ss

Edited April 1, 2022 by ekko

[BIGAL]

If your drawing the elbow from scratch, why can't you find the "Yellow" lines and delete them, when you drew new end lines you drew "White" lines why were they not "Yellow". So would work again. Color is valid as a line property same as if its on a different layer.

[ekko]

6 hours ago, BIGAL said:

If your drawing the elbow from scratch, why can't you find the "Yellow" lines and delete them, when you drew new end lines you drew "White" lines why were they not "Yellow". So would work again. Color is valid as a line property same as if its on a different layer.

As described by @exceed, there is a 50mm straight line segment before the arc, and there is a gap between them, that is to say, the arc does not intersect the yellow line. It takes a lot of judgment to find the yellow line at a time. The problem is, this The color of the yellow line is not a fixed yellow, it may be red, green, blue... I think that the lisp made by distinguishing by color is only used for test drawings, and there may be bugs when using it on another drawing, it should be Seek some other way to make it generic

Edited April 2, 2022 by ekko

[BIGAL]

Run ssget twice 1st with WP then 2nd with F fence option the fence will find the lines to fillet, the wp will find the p/lines to delete.Ie the 2 what ever color lines. Your using points as part of selection so not a problem.

 

[ekko]

On 4/3/2022 at 9:16 AM, BIGAL said:

Run ssget twice 1st with WP then 2nd with F fence option the fence will find the lines to fillet, the wp will find the p/lines to delete.Ie the 2 what ever color lines. Your using points as part of selection so not a problem.

 

 

;;Here is the code I am using,Apparently it only works for line objects

(command "fillet"
		       "R"
		       rd
		       "fillet"
		       e1
		       e2
)

;;This is what I found online and it seems to work for lwpolyline, I want it to work like above, no need to manually select objects

(command "Fillet" (osnap (cadr (entsel)) "Near")(osnap (cadr (entsel)) "Near")) 

Hello everyone, according to the ideas and help you provided, it seems that it is about to succeed. Unfortunately, only when the object is line, when the object is Lwpolyline, it doesn't seem to work. I spent a lot of time to check the information, but never came up with a solution, The problem is that my graphic elements are stored in the list, and I don't need to select them at all. What should I do? How to do it?

 

@BIGAL  @exceed   @ronjonp   @mhupp

 

Edited April 5, 2022 by ekko

[BIGAL]

if you have pline with a radius and run Fillet with new radius that will work. If you go back to the ssget F as a box it will return entities in a order, for 2 plines will be same ent twice so can work on that maybe changing bulge. `

 

Thinking again use ssget "F" but drag over existing radii. Maybe use intersect with again though need 2 solutions line v's pline. The 2 points of the fence line erase the tangent lines via a box. You really need to look at line / pline scenario maybe even 2 plines explode 1 now have line-arc-line and other pline. Not even thinking about c/l for moment.

 

If you must, isolate layer pedit multiple then only working with plines or maybe explode all only have lines and arc and then last line of code is pedit and remake all. layiso and layuniso can be very helpfull. 

 

All sorts of mini defun come to mind find line on end point of a arc and check for end/start.

Edited April 6, 2022 by BIGAL

[ekko]

I'm sorry, I made a mistake and made a meaningless reply, I don't know how to delete it

 

Edited April 6, 2022 by ekko

[ekko]

6 hours ago, BIGAL said:

if you have pline with a radius and run Fillet with new radius that will work. If you go back to the ssget F as a box it will return entities in a order, for 2 plines will be same ent twice so can work on that maybe changing bulge. `

 

Thinking again use ssget "F" but drag over existing radii. Maybe use intersect with again though need 2 solutions line v's pline. The 2 points of the fence line erase the tangent lines via a box. You really need to look at line / pline scenario maybe even 2 plines explode 1 now have line-arc-line and other pline. Not even thinking about c/l for moment.

 

If you must, isolate layer pedit multiple then only working with plines or maybe explode all only have lines and arc and then last line of code is pedit and remake all. layiso and layuniso can be very helpfull. 

 

All sorts of mini defun come to mind find line on end point of a arc and check for end/start.

Edited April 6, 2022 by ekko

[BIGAL]

Pretty sure the fillet command seems to like an entity then a point, rather than 2 points or 2 entities.

 

I think exploding and just working on lines and arcs would be easier then join back together removes all the pline headaches.

[ekko]

6 hours ago, BIGAL said:

Pretty sure the fillet command seems to like an entity then a point, rather than 2 points or 2 entities.

 

I think exploding and just working on lines and arcs would be easier then join back together removes all the pline headaches.

 

Edited April 6, 2022 by ekko

[ekko]

6 hours ago, BIGAL said:

if you have pline with a radius and run Fillet with new radius that will work. If you go back to the ssget F as a box it will return entities in a order, for 2 plines will be same ent twice so can work on that maybe changing bulge. `

 

Thinking again use ssget "F" but drag over existing radii. Maybe use intersect with again though need 2 solutions line v's pline. The 2 points of the fence line erase the tangent lines via a box. You really need to look at line / pline scenario maybe even 2 plines explode 1 now have line-arc-line and other pline. Not even thinking about c/l for moment.

 

If you must, isolate layer pedit multiple then only working with plines or maybe explode all only have lines and arc and then last line of code is pedit and remake all. layiso and layuniso can be very helpfull. 

 

All sorts of mini defun come to mind find line on end point of a arc and check for end/start.

 

 

 

According to your prompt, I succeeded, this is a very clever solution, thank you very much, the only disadvantage now is that when using the EXPLODE command, the command bar will have feedback information, which is not what I want, can it be hidden?

 

 

 

I have found a way, use the vla function

 

 

 

Edited April 6, 2022 by ekko

[BIGAL]

Try cmdecho