Topic: XClipping

[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