Jump to content

Recommended Posts

Posted

Hello,

 

Is there anyway or LISP to use EXTrim between two Lines as shown in the following Screenshot.

 

Thank you,

 

 

Regards,

 

 

Sidhu

 

MULTI EXTRIM.jpg

  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • marko_ribar

    7

  • sidhu412

    6

  • ReMark

    5

  • OMEGA-ThundeR

    3

Top Posters In This Topic

Posted Images

Posted

EXTRIM is not set up for picking two cutting edges so you'll have to find and use a custom lisp routine to accomplish the task.

Posted

You can fence trim. Do 'Trim' select outer and inner circle, confirm, when asked to select objects to trim enter 'Fence' and you can draw a line over the objects you want to trim (between outer and inner circle). Perhaps the only way...

Posted
You can fence trim. Do 'Trim' select outer and inner circle, confirm, when asked to select objects to trim enter 'fence' and you can draw a line on the objects you want to trim. Perhaps the only way...

 

Thnx for reply. I know the Fence function but I have hundreds of Objects need to be trimmed and fence is time taking option. I believe if someone can provide me with Custom Lisp Program as ReMark said above, it could be done more quickly and easily.

 

Regards,

 

 

Sidhu

Posted

You need to draw polygon with more sides as much as better... Than you should make list of its vertices and pass that list to command trim with fence option... Of course in trim command you have to select inner and outer circles...

 

HTH

Posted

As far as an 'lisp' i can make to skip some typing to speed up manual progress;

 

;;; FenceTRim

(Defun C:ftr ()
(command "_trim" pause pause "" "f")
(princ)
)

Posted

I think I found what you are looking for. Curiously it was written by marko_ribar and it is called MExtrim.

Posted
I think I found what you are looking for. Curiously it was written by marko_ribar and it is called MExtrim.

 

Can you please send me a link of it???

Posted

I can't because I don't have a link to it. Anyway, it did work the first time I used it in a test drawing but on two subsequent attempts in the same drawing it failed to work (it did trim but the results were not what was seen first time round). I don't know why that is. I'm still in "test" mode.

 

Second test failed. I guess it's back to searching for an answer.

 

Sorry about that.

Posted

Slightly different than I proposed with polygon - now obtaining points directly from middle distance of 2 radius...

 

(defun c:trim_between_2_concentic_circles ( / inner_circle outer_circle c1 c2 c r1 r2 r k p pl )

 (setq inner_circle (car (entsel "\nPick inner circle")))
 (setq outer_circle (car (entsel "\nPick outer circle")))
 (setq c1 (cdr (assoc 10 (entget inner_circle))))
 (setq c2 (cdr (assoc 10 (entget outer_circle))))
 (setq c (mapcar '* (mapcar '+ c1 c2) '(0.5 0.5 0.5)))
 (setq r1 (cdr (assoc 40 (entget inner_circle))))
 (setq r2 (cdr (assoc 40 (entget outer_circle))))
 (setq r (/ (+ r1 r2) 2.0))
 (setq k -1.0)
 (repeat 360
   (setq p (polar c (cvunit (setq k (1+ k)) "degrees" "radians") r))
   (setq pl (cons p pl))
 )
 (setq pl (cons (polar c 0.0 r) pl))
 (command "_.trim" inner_circle outer_circle "" "_F")
 (foreach p pl
   (command p)
 )
 (while (> (getvar 'cmdactive) 0) (command ""))
 (princ)
)

(defun c:tb2cc nil (c:trim_between_2_concentic_circles))

HTH, M.R.

Posted
I can't because I don't have a link to it. Anyway, it did work the first time I used it in a test drawing but on two subsequent attempts in the same drawing it failed to work (it did trim but the results were not what was seen first time round). I don't know why that is. I'm still in "test" mode.

 

Second test failed. I guess it's back to searching for an answer.

 

Sorry about that.

 

It's ok no problem.

 

I found the LISP Code on the link given by OMEGA-ThundeR and tried it. But it can only trim the lines intersecting the Closed Objects. FYI, I drew the Circle just to let people understand my query otherwise I have sets of Open Polylines including Arcs & Straight Lines (irregular) So The MEXTRIM or the Polygon method (Described by Mr. Marko-Ribar) will not work.

will be grateful if there's something else you guys can do.

 

Thank you,

 

Regards,

 

 

Sidhu

Posted

sidhu: Did you not see the new lisp program marko included in his last post? It does what you asked for. Check it out.

Posted (edited)
Slightly different than I proposed with polygon - now obtaining points directly from middle distance of 2 radius...

 

(defun c:trim_between_2_concentic_circles ( / inner_circle outer_circle c1 c2 c r1 r2 r k p pl )

 (setq inner_circle (car (entsel "\nPick inner circle")))
 (setq outer_circle (car (entsel "\nPick outer circle")))
 (setq c1 (cdr (assoc 10 (entget inner_circle))))
 (setq c2 (cdr (assoc 10 (entget outer_circle))))
 (setq c (mapcar '* (mapcar '+ c1 c2) '(0.5 0.5 0.5)))
 (setq r1 (cdr (assoc 40 (entget inner_circle))))
 (setq r2 (cdr (assoc 40 (entget outer_circle))))
 (setq r (/ (+ r1 r2) 2.0))
 (setq k -1.0)
 (repeat 360
   (setq p (polar c (cvunit (setq k (1+ k)) "degrees" "radians") r))
   (setq pl (cons p pl))
 )
 (setq pl (cons (polar c 0.0 r) pl))
 (command "_.trim" inner_circle outer_circle "" "_F")
 (foreach p pl
   (command p)
 )
 (while (> (getvar 'cmdactive) 0) (command ""))
 (princ)
)

(defun c:tb2cc nil (c:trim_between_2_concentic_circles))

HTH, M.R.

 

Sir,

 

It works fine but still I need to specify the Fence Path. This is 90% of what I need. If you can only edit it little bit and remove the Fence Function, So it will trim every Line in between the Circel / Polyline 1 & Circle / Polyline 2.

 

 

Regards,

 

 

Sidhu

Edited by sidhu412
Posted (edited)

sidhu412, If your concentric circles lie in some UCS different than WCS, I suggest that you use this revision (also added OSMODE checking - you can add this 2 first lines and in previous code and one last before (princ))

 

(defun c:trim_between_2_concentic_circles ( / osm inner_circle outer_circle c1 c1w c2 c2w cw c r1 r2 r k p pl )

 (setq osm (getvar 'osmode))
 (setvar 'osmode 0)
 (setq inner_circle (car (entsel "\nPick inner circle")))
 (while (/= (cdr (assoc 0 (entget inner_circle))) "CIRCLE")
   (prompt "\nPicked entity isn't circle entity, try again...")
   (setq inner_circle (car (entsel "\nPick inner circle")))
 )
 (setq outer_circle (car (entsel "\nPick outer circle")))
 (while (/= (cdr (assoc 0 (entget outer_circle))) "CIRCLE")
   (prompt "\nPicked entity isn't circle entity, try again...")
   (setq outer_circle (car (entsel "\nPick outer circle")))
 )
 (setq c1 (cdr (assoc 10 (entget inner_circle))))
 (setq c1w (trans c1 inner_circle 0))
 (setq c2 (cdr (assoc 10 (entget outer_circle))))
 (setq c2w (trans c2 outer_circle 0))
 (setq cw (mapcar '* (mapcar '+ c1w c2w) '(0.5 0.5 0.5)))
 (setq c (trans cw 0 1))
 (setq r1 (cdr (assoc 40 (entget inner_circle))))
 (setq r2 (cdr (assoc 40 (entget outer_circle))))
 (setq r (/ (+ r1 r2) 2.0))
 (setq k -1.0)
 (repeat 360
   (setq p (polar c (cvunit (setq k (1+ k)) "degrees" "radians") r))
   (setq pl (cons p pl))
 )
 (setq pl (cons (polar c 0.0 r) pl))
 (command "_.trim" inner_circle outer_circle "" "_F")
 (foreach p pl
   (command p)
 )
 (while (> (getvar 'cmdactive) 0) (command ""))
 (setvar 'osmode osm)
 (princ)
)

(defun c:tb2cc nil (c:trim_between_2_concentic_circles))

BTW. This code by OMEGA-ThundeR is more general and I strongly suggest that you use it in many various situations, where EXTRIM can't provide desired results...

 

;;; FenceTRim

(Defun C:ftr ()
 (command "_trim" pause pause "" "f")
 (princ)
)

Regards, M.R.

Edited by marko_ribar
Posted

Here is another approach... Try it and see if you get desired results...

 

Load posted code :

 

(defun colect_entdata ( / ss i ent entdata )
 (setq ss (ssget "_X"))
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq entdata (cons (entget ent) entdata))
 )
 entdata
)

(defun c:store_entdata nil
 (setq entdata (colect_entdata))
 (princ)
)

;;; Modify entities ;;;

(defun colect_modified_entdata ( / ss i ent entdatachk entdatamod )
 (setq ss (ssget "_X"))
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq entdatachk (cons (entget ent) entdatachk))
 )
 (foreach data entdatachk
   (if (not (vl-some '(lambda ( x ) (equal x data 1e-6)) entdata))
     (setq entdatamod (cons data entdatamod))
   )
 )
 entdatamod
)

(defun c:sel_mod_ents ( / ss )
 (setq ss (ssadd))
 (foreach data (colect_modified_entdata)
   (ssadd (cdr (assoc -1 data)) ss)
 )
 (sssetfirst nil ss)
 (princ)
)

(alert "\nFirstly type : store_entdata \nThen modify entities \nFinally type : sel_mod_ents \nAt the end type : (setq entdata nil)")
(princ)

1. Firstly type : store_entdata

2. Use "EXTRIM" command - pick first curve and pick point inside area you want to be extrimmed...

3. Type : sel_mod_ents

4. Press ctrl+shift+c (copybase) and enter point : 0,0,0

5. Type : (setq entdata nil)

6. Type : U (undo) - drawing should be exactly like starting - before 2. process

7. Use "EXTRIM" command - pick second curve and pick point inside area you want to be extrimmed...

8. Press ctrl+v (paste) and enter point : 0,0,0

 

That's it... Try it and tell me how it works...

HTH, M.R.

Posted (edited)

I thought, why wouldn't I automate this steps into single lisp, and I did it... So try this version...

 

(defun colect_entdata ( / ss i ent entdata )
 (setq ss (ssget "_X"))
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq entdata (cons (entget ent) entdata))
 )
 entdata
)

(defun store_entdata nil
 (setq entdata (colect_entdata))
 (princ)
)

;;; Modify entities ;;;

(defun colect_modified_entdata ( / ss i ent entdatachk entdatamod )
 (setq ss (ssget "_X"))
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq entdatachk (cons (entget ent) entdatachk))
 )
 (foreach data entdatachk
   (if (not (vl-some '(lambda ( x ) (equal x data 1e-6)) entdata))
     (setq entdatamod (cons data entdatamod))
   )
 )
 entdatamod
)

(defun sel_mod_ents nil
 (setq ss (ssadd))
 (foreach data (colect_modified_entdata)
   (ssadd (cdr (assoc -1 data)) ss)
 )
 (princ)
)

;;; Main command function ;;;

(defun c:extrim_between_2_curves ( / hig osm c1 c2 p ss entdata )

 (vl-load-com)

 (setq hig (getvar 'highlight))
 (setq osm (getvar 'osmode))
 (setvar 'osmode 0)
 (if (not (or etrim (not (vl-catch-all-error-p (vl-catch-all-apply 'load (list (findfile "extrim.lsp")))))))
   (progn
     (alert "\nExpress Tool EXTRIM not available - quitting...")
     (exit)
   )
 )
 (setq c1 (car (entsel "\nPick first curve")))
 (while (not (numberp (vlax-curve-getstartparam c1)))
   (prompt "\nPicked entity isn't curve entity. Try again...")
   (setq c1 (car (entsel "\nPick first curve")))
 )
 (setq c2 (car (entsel "\nPick second curve")))
 (while (not (numberp (vlax-curve-getstartparam c2)))
   (prompt "\nPicked entity isn't curve entity. Try again...")
   (setq c2 (car (entsel "\nPick second curve")))
 )
 (initget 1)
 (setq p (getpoint "\nPick or specify point between 2 prviously picked curves where do you want extrim to be processed : "))
 (store_entdata)
 (etrim c1 p)
 (sel_mod_ents)
 (command "_.copybase" '(0.0 0.0 0.0) ss "")
 (command "_.undo" "3")
 (etrim c2 p)
 (command "_.pasteclip" '(0.0 0.0 0.0))
 (setvar 'osmode osm)
 (setvar 'highlight hig)
 (princ)
)

(defun c:exb2c nil (c:extrim_between_2_curves))

HTH, M.R.

Regards...

Edited by marko_ribar
Posted (edited)

oops forgot to read page two

 

A facet.lsp anyway for something like this problem a few extra lines and done trim between two circles. Like above new rad is just (rad1+rad2)/2, pick two circles then trim using Fence avoids using vlax-curve old fashioned lisp.

 

(setq num (getreal "\nEnter number of facets"))
(setq rad (getreal "\nEnter radius"))
(setq cenpt (getpoint "\nPick centre pt"))
(setq ang 0.0)
(setq angdiff (/ (* pi 2.0) num))
(repeat (fix num)
(setq pt1 (polar cenpt ang rad)) 
(setq facets (cons pt1 facets))
(setq ang (+ angdiff ang))
)
(princ facets)

Edited by BIGAL
read page 2
Posted
I thought, why wouldn't I automate this steps into single lisp, and I did it... So try this version...

 

(defun colect_entdata ( / ss i ent entdata )
 (setq ss (ssget "_X"))
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq entdata (cons (entget ent) entdata))
 )
 entdata
)

(defun store_entdata nil
 (setq entdata (colect_entdata))
 (princ)
)

;;; Modify entities ;;;

(defun colect_modified_entdata ( / ss i ent entdatachk entdatamod )
 (setq ss (ssget "_X"))
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq entdatachk (cons (entget ent) entdatachk))
 )
 (foreach data entdatachk
   (if (not (vl-some '(lambda ( x ) (equal x data 1e-6)) entdata))
     (setq entdatamod (cons data entdatamod))
   )
 )
 entdatamod
)

(defun sel_mod_ents nil
 (setq ss (ssadd))
 (foreach data (colect_modified_entdata)
   (ssadd (cdr (assoc -1 data)) ss)
 )
 (princ)
)

;;; Main command function ;;;

(defun c:extrim_between_2_curves ( / hig osm c1 c2 p ss entdata )

 (vl-load-com)

 (setq hig (getvar 'highlight))
 (setq osm (getvar 'osmode))
 (setvar 'osmode 0)
 (if (not (or etrim (not (vl-catch-all-error-p (vl-catch-all-apply 'load (list (findfile "extrim.lsp")))))))
   (progn
     (alert "\nExpress Tool EXTRIM not available - quitting...")
     (exit)
   )
 )
 (setq c1 (car (entsel "\nPick first curve")))
 (while (not (numberp (vlax-curve-getstartparam c1)))
   (prompt "\nPicked entity isn't curve entity. Try again...")
   (setq c1 (car (entsel "\nPick first curve")))
 )
 (setq c2 (car (entsel "\nPick second curve")))
 (while (not (numberp (vlax-curve-getstartparam c2)))
   (prompt "\nPicked entity isn't curve entity. Try again...")
   (setq c2 (car (entsel "\nPick second curve")))
 )
 (initget 1)
 (setq p (getpoint "\nPick or specify point between 2 prviously picked curves where do you want extrim to be processed : "))
 (store_entdata)
 (etrim c1 p)
 (sel_mod_ents)
 (command "_.copybase" '(0.0 0.0 0.0) ss "")
 (command "_.undo" "3")
 (etrim c2 p)
 (command "_.pasteclip" '(0.0 0.0 0.0))
 (setvar 'osmode osm)
 (setvar 'highlight hig)
 (princ)
)

(defun c:exb2c nil (c:extrim_between_2_curves))

HTH, M.R.

Regards...

 

Bingooooooooooo

 

Great.........!

That's 100% What I needed You are Genius Mr. Marko_Ribar.

 

Thanxxxxxx a lot

 

Regards,

 

 

Sidhu

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...