Topic: XClipping

[cmwade77]

Ok, I have tried searching, but have not found anything, does anyone have a routine that will find the XCLIP boundary for an XRef and apply it to another XRef?

[irneb]

Just a "stab in the dark" ... run the XClip command with its Generate Polyline feature, then run it again with Select Polyline, the Erase the polyline.

Obviously there might be cleaner code than doing everything through the command line, but hell, it's quick & simple!

[cmwade77]

Just a "stab in the dark" ... run the XClip command with its Generate Polyline feature, then run it again with Select Polyline, the Erase the polyline.

Obviously there might be cleaner code than doing everything through the command line, but hell, it's quick & simple!

Yeah, this is one option I have considered, but using this method I have to first determine if the Xref is clipped or not, there may be hundreds of xrefs to deal with and this is selecting all of them.

[Matt__W]

Just a "stab in the dark" ... run the XClip command with its Generate Polyline feature, then run it again with Select Polyline, the Erase the polyline.

Obviously there might be cleaner code than doing everything through the command line, but hell, it's quick & simple!

Yeah, this is one option I have considered, but using this method I have to first determine if the Xref is clipped or not, there may be hundreds of xrefs to deal with and this is selecting all of them.

Ummm... have you tried minimize the number of xrefs in a drawing??   


 

[irneb]

Well, just as a "quick" check ... save (entlast) to a variable, then call the XClip command to generate the polyline. Check the new entlast against the one saved in the variable. If they're the same, then the xref didn't have a clip.

Sorry, haven't got my ACad open just now. You can always try to drill down into the xref insert's DXF codes through VLIDE. Or use my DictEdit routine here ... there's a secondary command called RawDisplay. If you can't get at something like that (which I'd guess would be a dictionary attached to the Insert entity), then there's no way to programatically do it from Lisp.

[MP]

A start (sorry, no time) ... old (2000) code, so ugly / unproven of late ...

Code: [Select]

(defun _get_xclip_points ( ename / ename2 data )

    (while (setq ename2 (cdr (assoc 360 (entget ename)))) (setq ename ename2))
   
    (if (member '(0 . "SPATIAL_FILTER") (setq data (entget ename)))
        (cons
            (eq 1 (cdr (assoc 71 data)))
            (apply 'append
                (mapcar
                    (function (lambda ( x ) (if (eq 10 (car x)) (list (cdr x)))))
                    data
                )
            )
        )
    )
)
Returns '(flag point point point)

Clip on: (T (670466.0 678736.0) (671585.0 678520.0) ...)
Clip off: (nil (670466.0 678736.0) (671585.0 678520.0) ...)
No clip: nil

[cmwade77]

Just a "stab in the dark" ... run the XClip command with its Generate Polyline feature, then run it again with Select Polyline, the Erase the polyline.

Obviously there might be cleaner code than doing everything through the command line, but hell, it's quick & simple!

Yeah, this is one option I have considered, but using this method I have to first determine if the Xref is clipped or not, there may be hundreds of xrefs to deal with and this is selecting all of them.

Ummm... have you tried minimize the number of xrefs in a drawing??   


 

They are not my drawings, these are drawings we get from Architects and such, so unfortunately this is not a possible solution, although I wish it were. What I am doing is working on a routine that will change all Xrefs from Overlay->Attach or Attach->Overlay, I have a routine that does this, but it is slow and a bit buggy, so I am trying to remove as many of the bugs as I can.

Ok, that gets me a start, thank you, I will now need to figure out how I am going to apply that boundary, I guess the first step is to determine how many points, so I know if it is a polygonal clip or a rectangular clip.

[alanjt]

A start (sorry, no time) ... old (2000) code, so ugly / unproven of late ...

Code: [Select]

(defun _get_xclip_points ( ename / ename2 data )

    (while (setq ename2 (cdr (assoc 360 (entget ename)))) (setq ename ename2))
   
    (if (member '(0 . "SPATIAL_FILTER") (setq data (entget ename)))
        (cons
            (eq 1 (cdr (assoc 71 data)))
            (apply 'append
                (mapcar
                    (function (lambda ( x ) (if (eq 10 (car x)) (list (cdr x)))))
                    data
                )
            )
        )
    )
)
Returns '(flag point point point)

Clip on: (T (670466.0 678736.0) (671585.0 678520.0) ...)
Clip off: (nil (670466.0 678736.0) (671585.0 678520.0) ...)
No clip: nil

:kewl:

[alanjt]

It's a pretty good start.

[MP]

Hmm, doesn't seem to be working with Polygonal clips though.

Quick test: Just tried it on a block with a polygonal xclip (AutoCAD 2010) and it worked. *shrug*

[cmwade77]

Hmm, doesn't seem to be working with Polygonal clips though.

Quick test: Just tried it on a block with a polygonal xclip (AutoCAD 2010) and it worked. *shrug*

Yeah, that one was a problem with my drawing, sorry.

[MP]

No worries. PS: Thanks Alan.

Back to the land of dreams ...

[alanjt]

Hmm, doesn't seem to be working with Polygonal clips though.

Quick test: Just tried it on a block with a polygonal xclip (AutoCAD 2010) and it worked. *shrug*

Works in 2011.

No worries. PS: Thanks Alan.

No, thank you.

[cmwade77]

Thank you all, that did the trick, a few more tweaks and I will be good to go.

[Lee Mac]

A start (sorry, no time) ... old (2000) code, so ugly / unproven of late ...

A great start 

Since the XClip boundary is defined in WCS at 1:1 scale and zero rotation, here is a possible extension:

Code: [Select]

(defun _XClipBoundary ( ename / __XClipBoundary elist xlist _xang _xnor )

    (defun __XClipBoundary ( ename / xdict )
        (if
            (setq xdict (cdr (assoc 360 (entget ename))))
            (__XClipBoundary xdict)
            (if
                (and
                    (eq "SPATIAL_FILTER" (cdr (assoc 0 (setq ename (entget ename)))))
                    (eq 1 (cdr (assoc 71 ename)))
                )
                (
                    (lambda ( massoc ) (massoc 10 ename))
                    (lambda ( key elist / item )
                        (if (setq item (assoc key elist))
                            (cons (cdr item) (massoc key (cdr (member item elist))))
                        )
                    )
                )
            )
        )
    )

    (defun __dxf ( key lst ) (cdr (assoc key lst)))

    (setq elist (entget ename)
          _xang (__dxf  50 elist)
          _xnor (__dxf 210 elist)
    )
    (if (setq xlist (__XClipBoundary ename))
        (
            (lambda ( matrix )
                (
                    (lambda ( vector )
                        (mapcar
                            (function
                                (lambda ( point )
                                    (mapcar '+ (mxv matrix point) vector)
                                )
                            )
                            xlist
                        )
                    )
                    (mapcar '- (trans (__dxf 10 elist) _xnor 0)
                        (mxv matrix
                             (__dxf 10 (tblsearch "BLOCK" (__dxf 2 elist)))
                        )
                    )
                )
            )
            (mxm
                (mapcar
                    (function
                        (lambda ( v ) (trans v 0 _xnor t))
                    )
                   '(
                        (1.0 0.0 0.0)
                        (0.0 1.0 0.0)
                        (0.0 0.0 1.0)
                    )
                )
                (mxm
                    (list
                        (list (cos _xang) (sin (- _xang)) 0.0)
                        (list (sin _xang) (cos _xang)     0.0)
                        (list 0.0         0.0             1.0)
                    )
                    (list
                        (list (__dxf 41 elist) 0.0 0.0)
                        (list 0.0 (__dxf 42 elist) 0.0)
                        (list 0.0 0.0 (__dxf 43 elist))
                    )
                )
            )           
        )
    )
)


;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
    ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m ) (apply 'mapcar (cons 'list m)))


[cmwade77]

Lee, thank you, I wouldn't have even thought about it not working with scaled xrefs.

[MP]

Awesome baton carry Lee.

Kinda O/T but not ... it's funny how many people think xclips are restricted to xrefs. THEY ARE NOT. XClips work on all blocks, including xrefs.

/PSA

[Lee Mac]

Awesome baton carry Lee.

Cheers dude, although I'll be honest, most of the code is derived from methods demonstrated by both you and gile - it is true that we stand on the shoulders of giants 

[alanjt]

it is true that we stand on the shoulders of giants 

1+

[cmwade77]

Awesome baton carry Lee.

Kinda O/T but not ... it's funny how many people think xclips are restricted to xrefs. THEY ARE NOT. XClips work on all blocks, including xrefs.

/PSA

Oh, I know they are not, but in my use case I am only dealing with XREFs.

[cmwade77]

Ok, so I have done my first pass at the code for my routine, please see my other thread at http://www.theswamp.org/index.php?topic=39205.msg444265#msg444265

I figured starting another thread would be the best for those that might search for it in the future.

[irneb]

Nice one MP & Lee!

... it's funny how many people think xclips are restricted to xrefs. THEY ARE NOT. XClips work on all blocks, including xrefs.

Actually, it's "strange" how many people don't realize that a xref is nothing but a "special" type of block with some extra properties!

Strange how many I've found that don't seem to want to believe they can use the copy/mirror/array/etc. commands on xrefs! They keep doing another Attach and then complain because the manager still only shows the one XRef.

[Krushert]

Kinda O/T but not ... it's funny how many people think xclips are restricted to xrefs. THEY ARE NOT. XClips work on all blocks, including xrefs.

Cool learn something new everyday when I come to TheSwamp.  IT really does not surprise me because I know that xrefs are special blocks but I did not clue on using xclips on just plain ole blocks..   Don't know when I would use it or where, but it there if I need it.  Thanks.

[ElpanovEvgeniy]

Many years ago, based on acad 2004, I wrote a complete set of programs to work with xclip drawings.
1. move blocks
2. rotation of blocks within the circuit, without changing the circuit
3. displacement of blocks within the circuit, no change of the contour
All the action via entmod.
I need time to separate the code from the project this week, I will try to publish it.

ps. My only imperfection - I could not create a new drawing xclip if they have none. First I created through the command line: (

[ElpanovEvgeniy]

The program changes the contour XCLIP:

Code: [Select]

(defun c:cxc (/ E LW)
 ;|
*****************************************************************************************

by ElpanovEvgeniy
www.elpanov.com

Программа смены контура подрезки

Дата создания   20.09.2005
Последняя редакция 04.06.2006
*****************************************************************************************

The program changes the contour XCLIP


Date of creation   20.09.2005
Last edition       04.06.2006
*****************************************************************************************

(c:cxc)

*****************************************************************************************
|;
 (if (and (setq lw (car (entsel "\n Select a new LWPOLYLINE\t")))
          (= (cdr (assoc 0 (entget lw))) "LWPOLYLINE")
          (setq e (car (entsel "\n Select block to clipping\t")))
     )
  (cxc lw e)
 )
 (princ)
)
(defun cxc (lw e / A A1 EF H I L LST P R)
           ;|
*****************************************************************************************

by ElpanovEvgeniy
www.elpanov.com

Программа смены контура подрезки

Дата создания   20.09.2005
Последняя редакция 04.06.2006
*****************************************************************************************

The program changes the contour XCLIP


Date of creation   20.09.2005
Last edition       04.06.2006
*****************************************************************************************

(cxc (car (entsel "\n Select a new LWPOLYLINE\t"))
     (car (entsel "\n Select block to clipping\t"))
)

*****************************************************************************************
|;
 (if (and (cond ((not (setq ef (cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget e))))) nil)
                ((not (setq ef (cdr (assoc 360 (entget ef))))) nil)
                ((setq ef (cdr (assoc 360 (entget ef)))))
          )
          (progn (setq h 1)
                 (if (> (apply (function distance) (ACET-ENT-GEOMEXTENTS lw)) h)
                  (progn (setq p   0
                               lst (list (vlax-curve-getStartPoint lw))
                         )
                         (repeat (- (cdr (assoc 90 (entget lw))) (abs (1- (cdr (assoc 70 (entget lw))))))
                          (if (setq r (vlax-curve-getSecondDeriv lw p))
                           (if (equal r '(0 0 0) 1e-6)
                            (setq lst (cons (vlax-curve-getPointAtParam lw p) lst)
                                  p   (1+ p)
                            )
                            (progn (setq r  (distance '(0 0) (vlax-curve-getFirstDeriv lw p))
                                         p  (1+ p)
                                         i  (/ (- r h) r)
                                         l  (* r (atan (sqrt (abs (- 1. (* i i)))) i) 2)
                                         a1 (vlax-curve-getDistAtParam lw p)
                                         a  (vlax-curve-getDistAtParam lw (1- p))
                                         l  (/ (- a1 a) (1+ (fix (/ (- a1 a) l))))
                                   )
                                   (while (and (< a a1) (not (equal a a1 1e-6)))
                                    (setq lst (cons (vlax-curve-getPointAtDist lw a) lst)
                                          a   (+ a l)
                                    )
                                   )
                            )
                           )
                           (setq p (1+ p))
                          )
                         )
                  )
                 )
                 (setq lst (ACET-LIST-REMOVE-ADJACENT-DUPS lst))
          )
     )
  (progn (entmod
          (apply (function append)
                 (list (reverse (cons (cons 70 (length lst))
                                      (vl-member-if (function (lambda (x) (= (car x) 100))) (reverse (entget ef)))
                                )
                       )
                       (mapcar (function (lambda (x) (cons 10 x))) lst)
                       (vl-remove-if
                        (function (lambda (x) (= (car x) 40)))
                        (vl-member-if (function (lambda (x) (= (car x) 210))) (entget ef))
                       )
                       (mapcar (function (lambda (x) (cons 40 x)))
                               (apply (function append)
                                      ((lambda (a p)
                                        (list (list (cos a) (- (sin a)) 0. (- 0. (* (car p) (cos a)) (* (cadr p) (- (sin a)))))
                                              (list (sin a) (cos a) 0. (- 0. (* (car p) (sin a)) (* (cadr p) (cos a))))
                                              '(0. 0. 1. 0.)
                                              '(1. 0. 0. 0.)
                                              '(0. 1. 0. 0.)
                                              '(0. 0. 1. 0.)
                                        )
                                       )
                                       (- (cdr (assoc 50 (entget e))))
                                       (cdr (assoc 10 (entget e)))
                                      )
                               )
                       )
                 )
          )
         )
         (entupd e)
  )
 )
 (princ)
)

[ElpanovEvgeniy]

Program rotation block, inside the contour XCLIP

Code: [Select]

(defun c:axc (/ A E EF L LW P1)
             ;|
*****************************************************************************************

by ElpanovEvgeniy
www.elpanov.com

Программа поворота блоков, внутри контура подрезки

Дата создания   20.09.2005
Последняя редакция 04.06.2006
*****************************************************************************************

Program rotation block, inside the contour XCLIP

Date of creation   20.09.2005
Last edition       04.06.2006
*****************************************************************************************

(c:axc)

*****************************************************************************************
|;
 (if (and (setq e (car (entsel "\n Select block to rotation\t")))
          (setq lw (car (entsel "\n Enter an external lwpolyline clipping \t")))
          (progn (cxc lw e)
                 (cond ((not (setq ef (cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget e))))) nil)
                       ((not (setq ef (cdr (assoc 360 (entget ef))))) nil)
                       ((not (setq ef (cdr (assoc 360 (entget ef))))) nil)
                       ((setq l (reverse (vl-member-if (function (lambda (x) (= (car x) 73))) (reverse (entget ef))))))
                 )
          )
          (setq p1 (getpoint "\n Specify base point:\t"))
          ((lambda (x1 x2)
            (setq a (cond ((and x1 x2) (- x2 x1))
                          (x2)
                          (t nil)
                    )
            )
           )
           (getangle p1 "\nSpecify the reference angle:\t")
           (getangle p1 "\nSpecify the new angle\t")
          )
     )
  (progn (entmod (subst ((lambda (x)
                          (list 10
                                (+ (* (car x) (cos a)) (* (cadr x) (- (sin a))) (car p1))
                                (+ (* (car x) (sin a)) (* (cadr x) (cos a)) (cadr p1))
                                0.
                          )
                         )
                         (mapcar (function -) (cdr (assoc 10 (entget e))) p1)
                        )
                        (assoc 10 (entget e))
                        (subst (cons 50 (+ (cdr (assoc 50 (entget e))) a)) (assoc 50 (entget e)) (entget e))
                 )
         )
         (entupd e)
         (entmod
          (append l
                  (mapcar (function (lambda (x) (cons 40 x)))
                          (apply (function append)
                                 ((lambda (a p)
                                   (list (list (cos a) (- (sin a)) 0. (- 0. (* (car p) (cos a)) (* (cadr p) (- (sin a)))))
                                         (list (sin a) (cos a) 0. (- 0. (* (car p) (sin a)) (* (cadr p) (cos a))))
                                         '(0. 0. 1. 0.)
                                         '(1. 0. 0. 0.)
                                         '(0. 1. 0. 0.)
                                         '(0. 0. 1. 0.)
                                   )
                                  )
                                  (- (cdr (assoc 50 (entget e))))
                                  (cdr (assoc 10 (entget e)))
                                 )
                          )
                  )
          )
         )
         (entupd ef)
         (entupd e)
  )
 )
)

[ElpanovEvgeniy]

Program moving block, inside the contour clipping

Code: [Select]

(defun c:mxc (/ cons-4 E EF L LW P1 P2 PT)
             ;|
*****************************************************************************************

by ElpanovEvgeniy
www.elpanov.com

Программа перемещения блоков, внутри контура подрезки

Дата создания   20.09.2005
Последняя редакция 04.06.2006
*****************************************************************************************

Program moving block, inside the contour clipping

Date of creation   20.09.2005
Last edition       04.06.2006
*****************************************************************************************

(c:mxc)

*****************************************************************************************
|;
 (defun cons-4 (lst)
  ;; (cons-4 '(1 2 3 4 11 12 13 14 21 22 23 24)) =>> ((1 2 3 4) (11 12 13 14) (21 22 23 24))
  ;;(cons-4 lst)
  (if lst
   (cons (list (car lst) (cadr lst) (caddr lst) (cadddr lst)) (cons-4 (cddddr lst)))
  ) ;_ if
 )
 (if (and (setq e (car (entsel "\n Select block to move\t")))
          (setq lw (car (entsel "\n Enter an external lwpolyline clipping \t")))
          (setq pt (getpoint "\n Specify base point:\t"))
          (setq p2 (getpoint pt "\n Specify second point:\t"))
          (progn (cxc lw e)
                 (cond ((not (setq l (cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget e))))) nil)
                       ((not (setq l (cdr (assoc 360 (entget l))))) nil)
                       ((not (setq ef (cdr (assoc 360 (entget l))))) nil)
                       ((setq l (list (vl-remove-if (function (lambda (x) (= (car x) 40))) (entget ef))
                                      (cons-4
                                       (mapcar (function cdr) (vl-remove-if-not (function (lambda (x) (= (car x) 40))) (entget ef)))
                                      )
                                )
                        )
                       )
                 )
          )
     )
  (progn (setq p1 (mapcar (function -) (cdr (assoc 10 (entget e))) pt))
         (entmod (subst (cons 10 (mapcar (function +) p2 p1)) (assoc 10 (entget e)) (entget e)))
         (entupd e)
         (entmod
          (apply (function append)
                 (list (car l)
                       (mapcar (function (lambda (x) (cons 40 x)))
                               (apply (function append)
                                      ((lambda (a p)
                                        (list (list (cos a) (- (sin a)) 0. (- 0. (* (car p) (cos a)) (* (cadr p) (- (sin a)))))
                                              (list (sin a) (cos a) 0. (- 0. (* (car p) (sin a)) (* (cadr p) (cos a))))
                                              '(0. 0. 1. 0.)
                                              '(1. 0. 0. 0.)
                                              '(0. 1. 0. 0.)
                                              '(0. 0. 1. 0.)
                                        )
                                       )
                                       (- (cdr (assoc 50 (entget e))))
                                       (mapcar (function +) p1 p2)
                                      )
                               )
                       )
                 )
          )
         )
         (entupd e)
  )
 )
 (princ)
)

[ElpanovEvgeniy]

I think these three programs is sufficient for most purposes...
Draw your attention, it works only in 2d and the world coordinate system!

PS. sometimes interesting to see the old programs.

[JohnK]

Very cool Evgeniy.

[kruuger]

hello Evgeniy


any chance to post missing cxc function ?


thanks

[ribarm]

hello Evgeniy


any chance to post missing cxc function ?


thanks

Look into post #24...

I suppose that this is it... Haven't tested though...

[kruuger]

hello Evgeniy


any chance to post missing cxc function ?


thanks

Look into post #24...

I suppose that this is it... Haven't tested though...

ah, im dumbass. didn't noticed previuos page.

thanks marko