Jump to content

Recommended Posts

Posted

iam need lsp for trim or erase many lines inside many circle or block circle on one at one time

Drawing3.dwg

  • Replies 25
  • Created
  • Last Reply

Top Posters In This Topic

  • ReMark

    5

  • irneb

    4

  • issammesk

    4

  • marko_ribar

    2

Top Posters In This Topic

Posted Images

Posted

Your so called drawing contains the path to an untitled bitmap file that was not included as part of the file therefore we are unable to view anything. Try posting just the bitmap itself.

Posted

Maybe you did not understand me. Your drawing file is blank. All one sees is the "path" to the untitled bitmap that was NOT included with the DWG file.

 

Post the actual BMP file not a DWG. Clear?

Posted

ExTrim.jpg

Let's say you start with what is shown in circle #1. What do you want the results of this custom lisp routine to look like after it is run? Circle #2 or #3?

Posted

thank you sir

i want lsp that when i select all circle in drawing automiticly trim or erase inside this circle as no.2 in your example

Posted

OK. By the way, that was done using the EXTRIM command. I only tried it on a single circle so I can't tell you, at this time, whether or not it would work on multiple circles.

Posted
OK. By the way, that was done using the EXTRIM command. I only tried it on a single circle so I can't tell you, at this time, whether or not it would work on multiple circles.
Nope, that Express Tool is a lisp command, so you can't even call it from another lisp in multiple instances. Although the actual working function in that file is a normal defun requiring the ename and the point. So this might work:
(load "extrim.lsp")
(defun c:MExTrim (/ ss n en ed)
 (prompt "\nSelect Circles: ")
 (if (setq ss (ssget '((0 . "CIRCLE"))))
   (progn
     (setq n (sslength ss))
     (while (>= (setq n (1- n)) 0)
       (setq en (ssname ss n) ed (entget en))
       (etrim en (cdr (assoc 10 ed))))))
 (princ))

This only works for circles, it's possible to extend for polylines as well - but more difficult.

Posted

Here is complete MEXTRIM.lsp... Thanks to Irneb, and my previous post for algorithm for randomize picking points inside closed entity I've managed to create complete MEXTRIM command...

 

(defun rnd (/ modulus multiplier increment rand)
 (if (not seed)
   (setq seed (getvar "DATE"))
 )
 (setq modulus    65536
       multiplier 25173
       increment  13849
       seed  (rem (+ (* multiplier seed) increment) modulus)
       rand     (/ seed modulus)
 )
)

(defun GroupByNum ( lst n / r)
 (if lst
   (cons
     (reverse (repeat n (setq r (cons (car lst) r) lst (cdr lst)) r))
     (GroupByNum lst n)
   )
 )
)

(defun ptonline ( pt pt1 pt2 / vec12 vec1p d result )
 (setq vec12 (mapcar '- pt2 pt1))
 (setq vec12 (reverse (cdr (reverse vec12))))
 (setq vec1p (mapcar '- pt pt1))
 (setq vec1p (reverse (cdr (reverse vec1p))))
 (setq vec2p (mapcar '- pt2 pt))
 (setq vec2p (reverse (cdr (reverse vec2p))))
 (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p))
 (if (equal d (+ d1 d2) 1e- (setq result T) (setq result nil))
 result
)

(defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result )
 (vl-load-com)
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
 (setq ptt (vlax-curve-getclosestpointto ent pt))
 (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt)))
 (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3))
 (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b)))))
 (setq k 0)
 (while (< (setq k (1+ k)) (length int))
   (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst)))
 )
 (setq tst (reverse tst))
 (setq k 0)
 (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst)
 (vla-delete xlin)
 (if kk
   (if (eq (rem kk 2) 1) (setq result T) (setq result nil))
   (setq result nil)
 )
 result
)

(load "extrim.lsp")
(defun c:MExTrim ( / ss n en ed enA minpt maxpt dx dy pt dxx dyy ) (vl-load-com)
 (prompt "\nSelect closed entities: ")
 (if (setq ss (ssget (append (list '(-4 . "<or") '(0 . "CIRCLE") '(-4 . "<and") '(0 . "*POLYLINE") '(70 . 1) '(-4 . "and>") '(-4 . "<and") '(0 . "SPLINE") '(70 . 11) '(-4 . "and>") '(-4 . "<and") '(0 . "ELLIPSE") '(41 . 0.0)) (list (cons 42 (* 2 pi))) (list '(-4 . "and>") '(-4 . "or>")))))
   (progn
     (setq n (sslength ss))
     (while (>= (setq n (1- n)) 0)
       (setq en (ssname ss n) ed (entget en) enA (vlax-ename->vla-object en))
         (vla-getboundingbox enA 'minpoint 'maxpoint)
       (setq
        minpt (vlax-safearray->list minpoint)
        maxpt (vlax-safearray->list maxpoint)
       )
       (setq dx (- (car maxpt) (car minpt)))
       (setq dy (- (cadr maxpt) (cadr minpt)))
       (setq pt '(0.0 0.0 0.0))
       (while (not (ptinsideent pt en))
         (setq dxx (* dx (rnd)))
         (setq dyy (* dy (rnd)))
         (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0))
       )
       (etrim en pt)
     )
   )
 )
 (princ)
)

 

M.R.8)8)8)

Posted

irneb , that would disable the visibility of the selection set for all open drawings .:o

 

e.g , try to move any entity in any opened drawing and you will find out that the high lighting objects would be disabled when you try to select any object.

 

Regards.

Posted

Yes, it's one of the painful aspects of only using portions of the Express tools. You could always allow for such things by saving the value of Highlight and the restoring it at the end of the function.

 

I.e. something like this:

(defun c:MExTrim  (/ [color=red]highlight *error*[/color] ss n en ed enA minpt maxpt dx dy pt dxx dyy)
 (vl-load-com)
 [color=red](setq highlight (getvar "HighLight"))
 (defun *error* (msg)
   (if highlight (setvar "HighLight" highlight))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))
   (princ))[/color]
 (prompt "\nSelect closed entities: ")
 (if (setq ss (ssget (append (list '(-4 . "<or")        '(0 . "CIRCLE")      '(-4 . "<and")       '(0 . "*POLYLINE")
                                   '(70 . 1)            '(-4 . "and>")       '(-4 . "<and")       '(0 . "SPLINE")
                                   '(70 . 11)           '(-4 . "and>")       '(-4 . "<and")       '(0 . "ELLIPSE")
                                   '(41 . 0.0))
                             (list (cons 42 (* 2 pi)))
                             (list '(-4 . "and>") '(-4 . "or>")))))
   (progn (setq n (sslength ss))
          (while (>= (setq n (1- n)) 0)
            (setq en  (ssname ss n)
                  ed  (entget en)
                  enA (vlax-ename->vla-object en))
            (vla-getboundingbox enA 'minpoint 'maxpoint)
            (setq minpt (vlax-safearray->list minpoint)
                  maxpt (vlax-safearray->list maxpoint))
            (setq dx (- (car maxpt) (car minpt)))
            (setq dy (- (cadr maxpt) (cadr minpt)))
            (setq pt '(0.0 0.0 0.0))
            (while (not (ptinsideent pt en))
              (setq dxx (* dx (rnd)))
              (setq dyy (* dy (rnd)))
              (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0)))
            (etrim en pt))))
 [color=red](*error* nil)[/color])

 

Edit: Oh and BTW, thanks marko - that works great even on polylines!

Posted

Looks interesting indeed .:)

 

sub-function ptinsideent is missing

Posted
Looks interesting indeed .:)

 

sub-function ptinsideent is missing

Yes, that function is part of marko's code. I've taken marko's code and only shown the defun where I've modified it to include for the highlight reset.
  • 2 weeks later...
Posted

This routine is resulting in everything outside of my circles being trimmed, leaving the portion of line inside as per #3 in ReMark's sketch above. Is there a setting that I could change for it to result in #2 in ReMark's sketch?

  • 3 weeks later...
Posted

Hi,

 

Really its very useful ...........

 

thank you,

  • 3 months later...
Posted

Hi Irneb,

I'm not well versed in lisp where to put. Please give the full lisp.thanks

Posted

Copy marko_ribar's code from post #10, then replace the last portion starting with

(defun c:MExTrim ... 

with my code from post #12. Save all into a LSP file (normal text file just with a LSP extension instead of TXT). Then load that file into ACad - several ways. Then after that any defun in that file with a name starting with C: becomes a new command with the rest of the name (in this case MExTrim).

  • 4 months later...
Posted (edited)

I've modified my code according to BIGAL's discovery that on older Acad versions (etrim ent pt) won't work correctly without (acet-error-init) function and at the end followed by (acet-error-restore)... Look here for details...

 

So here is complete code :

(defun c:MExTrim ( / rnd GroupByNum ptonline ptinsideent highlight 
                    ss n en ed enA minpt maxpt dx dy pt dxx dyy ) 
                    
 (vl-load-com)

 (load "extrim.lsp")

 (defun rnd (/ modulus multiplier increment rand)
   (if (not seed)
     (setq seed (getvar "DATE"))
   )
   (setq modulus    65536
         multiplier 25173
         increment  13849
         seed  (rem (+ (* multiplier seed) increment) modulus)
         rand     (/ seed modulus)
   )
 )

 (defun GroupByNum ( l n / f )
   (defun f ( a b )
     (if (and a (< 0 b))
       (cons (car a) (f (setq l (cdr a)) (1- b)))
     )
   )
   (if l (cons (f l n) (GroupByNum l n)))
 )

 (defun ptonline ( pt pt1 pt2 / vec12 vec1p d result )
   (setq vec12 (mapcar '- pt2 pt1))
   (setq vec12 (reverse (cdr (reverse vec12))))
   (setq vec1p (mapcar '- pt pt1))
   (setq vec1p (reverse (cdr (reverse vec1p))))
   (setq vec2p (mapcar '- pt2 pt))
   (setq vec2p (reverse (cdr (reverse vec2p))))
   (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p))
   (if (equal d (+ d1 d2) 1e- (setq result T) (setq result nil))
   result
 )

 (defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result )
   (vl-load-com)
   (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
   (setq ptt (vlax-curve-getclosestpointto ent pt))
   (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt)))
   (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3))
   (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b)))))
   (setq k 0)
   (while (< (setq k (1+ k)) (length int))
     (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst)))
   )
   (setq tst (reverse tst))
   (setq k 0)
   (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst)
   (vla-delete xlin)
   (if kk
     (if (eq (rem kk 2) 1) (setq result T) (setq result nil))
     (setq result nil)
   )
   result
 )

 (setq highlight (getvar "HighLight"))
 (acet-error-init (list
                    (list   "cmdecho" 0
                          "highlight" highlight
                          "regenmode" 1
                             "osmode" 0
                            "ucsicon" 0
                         "offsetdist" 0
                             "attreq" 0
                           "plinewid" 0
                          "plinetype" 1
                           "gridmode" 0
                            "celtype" "CONTINUOUS"
                          "ucsfollow" 0
                           "limcheck" 0
                    )
                    T     ;flag. True means use undo for error clean up.
                    '(if redraw_it (redraw na 4))
                   );list
 );acet-error-init

 (prompt "\nSelect closed entities: ")
 (if (setq ss (ssget (append (list '(-4 . "<or") '(0 . "CIRCLE") '(-4 . "<and") '(0 . "*POLYLINE") '(-4 . "<not") '(-4 . "&=") '(70 .  '(-4 . "not>") '(-4 . "&=") '(70 . 1) '(-4 . "and>") '(-4 . "<and") '(0 . "SPLINE") '(-4 . "&=") '(70 . 1) '(-4 . "and>") '(-4 . "<and") '(0 . "ELLIPSE") '(41 . 0.0)) (list (cons 42 (* 2 pi))) (list '(-4 . "and>") '(-4 . "or>")))))
   (progn
     (setq n (sslength ss))
     (while (>= (setq n (1- n)) 0)
       (setq en (ssname ss n) ed (entget en) enA (vlax-ename->vla-object en))
         (vla-getboundingbox enA 'minpoint 'maxpoint)
       (setq
        minpt (vlax-safearray->list minpoint)
        maxpt (vlax-safearray->list maxpoint)
       )
       (setq dx (- (car maxpt) (car minpt)))
       (setq dy (- (cadr maxpt) (cadr minpt)))
       (setq pt '(0.0 0.0 0.0))
       (while (not (ptinsideent pt en))
         (setq dxx (* dx (rnd)))
         (setq dyy (* dy (rnd)))
         (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0))
       )
       (etrim en pt)
     )
   )
 )
 (acet-error-restore)
 (princ)
)

Regards, M.R.

Edited by marko_ribar
  • 7 months later...
Posted

how to look like after it is run? Circle #3 (outside) ?

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