Jump to content

Recommended Posts

Posted
(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

20220331.gif

marc202203.dwg

Posted

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

 

  • Thanks 1
Posted (edited)

@mhupp

FWIW

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

 

Edited by ronjonp
  • Like 1
Posted (edited)

That doesnt seem to work in BricsCAD.

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

Edited by mhupp
  • Thanks 1
Posted
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))

  • Thanks 1
Posted (edited)
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

 

 

 

 

20220401.thumb.gif.6a09ec9898849aeb3c8004b78c5f1a67.gif

 

Edited by ekko
Posted (edited)

 

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.

2022-04-01 15;35;09.PNG

Edited by exceed
Posted
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.

2022-04-01 15;35;09.PNG

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.

Posted (edited)
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 by ekko
Posted

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.

Posted (edited)
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 by ekko
Posted

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.

 

Posted (edited)
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

 

20220405b.thumb.gif.11c7a53eed0ae97a587baa42cf59d739.gif

Edited by ekko
Posted (edited)

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 by BIGAL
  • Like 1
Posted (edited)

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

 

Edited by ekko
Posted (edited)
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 by ekko
Posted

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.

Posted (edited)
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 by ekko
Posted (edited)
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.

202204056.thumb.gif.2d9036f2ebb29f7b39cada6001f44b9b.gif

 

 

 

 

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 by ekko

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...