Topic: Make this routine clip xrefs, blocks & nested blocks?

[coffee]

Guys,
I have a routine that allows the user to define an area with a polyline, it then erase eveything outside of that line.
The routine however won't clip through "Xrefs" "Blocks" or "Nested Blocks". Would somebody be interested in looking at this routine and seeing if they could take it further. Would be awesome if it could literally cut through eveything it crosses. Though without exploding everything eveywhere ?

Stephen

[Guest]

I'm not sure if this is strictly a Vertical App command, but you can look into the AEC Modify Tools; specifically, AECLINEWORKCROP.

The AECLINEWORKCROP command will create a new, annonymous block of the cropped block.  I don't believe it will work on xrefs though.  I'll admit I haven't tried your LSP, but from what you wrote it sounds like the AEC crop will do the trick (if you have it).


Oh, and let me be the first to welcome you to The Swamp!

[coffee]

Matt,
Whilst it was so long ago now that I can't rember for sure how it was done. I am only using AutoCAD 2008 and don't have those commands. I atually started writing the routine in lisp and using the trim function, got a little stuck and posted a thread on the AUGI. I had a reply and can't remeber who wrote this one for me though think it went down the same path of the trim function.

Yes and thank you for the welcome, how did they know I am a mosquito ?

[VVA]

Why to you not to use clipit from Express Tools

Command: CLIPIT
Pick a POLYLINE, CIRCLE, ARC, ELLIPSE, or TEXT object for clipping edge...
Select objects: Use an object selection method
Pick an IMAGE, a WIPEOUT, or an XREF/BLOCK to clip: Select the object to clip
Enter max error distance for resolution of arcs <0.0200>: Specify a resolution value or press ENTER

[coffee]

VVA,
Thank you for your suggestion. Whilst i have learn't something new "CLIPIT" it is just xclipping the xref.
I am actually wanting to use this in situations of preparing Architecturals etc for xref. I am actually trying to strip all the extra fat off of the file. It would be nice to simply draw a boarder around what is required and then be done with the rest.

Any other suggestions ?


Stephen

[VVA]

Try it
If there will be very difficult xref/block can not work. This restriction of Autocad boundary command

Code: [Select]

;;;The command builds an external contour of the chosen objects
;;; Original posted by Vladimir Azarko (VVA)
;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=32457pO&page=1
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
  (setq pt (trans pt 0 1))
  (setq VCTR  (getvar "VIEWCTR")
        Y_Len (getvar "VIEWSIZE")
        SSZ   (getvar "SCREENSIZE")
        X_Pix (car SSZ)
        Y_Pix (cadr SSZ)
        X_Len (* (/ X_Pix Y_Pix) Y_Len)
        Lc    (polar VCTR (dtr 180.0) (* 0.5 X_Len))
        Uc    (polar Lc 0.0 X_Len)
        Lc    (polar Lc (dtr 270.0) (* 0.5 Y_Len))
        Uc    (polar Uc (dtr 90.0) (* 0.5 Y_Len))
  )
  (if (and (> (car pt) (car Lc))
           (< (car pt) (car Uc))
           (> (cadr pt) (cadr Lc))
           (< (cadr pt) (cadr Uc))
      )
    t
    nil
  )
)
(defun DTR (a) (* pi (/ a 180.0)))
(defun RTD (a) (/ (* a 180.0) pi))
(defun lib:Zoom2Lst (vlist / bl tr Lst OS)
  (setq Lst (lib:pt_extents vlist)
        bl  (car Lst)
        tr  (cadr Lst)
  )
  (if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
    (progn (setq OS (getvar "OSMODE"))
           (setvar "OSMODE" 0)
           (command "_.Zoom"
                    "_Window"
                    (trans bl 0 1)
                    (trans tr 0 1)
                    "_.Zoom"
                    "0.95x"
           )
           (setvar "OSMODE" OS)
           t
    )
    NIL
  )
)
(defun lib:pt_extents (vlist / tmp)
  (setq
    tmp (mapcar
          '(lambda (x) (vl-remove-if 'null x))
          (mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist))
                  '(0 1 2)
          )
        )
  ) ;_setq
  (list (mapcar '(lambda (x) (apply 'min x)) tmp)
        (mapcar '(lambda (x) (apply 'max x)) tmp)
  )
) ;_defun
                    ;External contour of objects
(defun C:ECO (/       *error* blk     obj     MinPt   MaxPt   hiden   pt
              pl      unnamed_block   isRus   tmp_blk adoc    blks    lays
              lay     oname   sel     csp     loc     sc      ec      ret
              DS      osm     iNSpT
             )
  (defun *error* (msg)
    (mapcar '(lambda (x) (vla-put-visible x :vlax-true)) hiden)
    (vla-endundomark adoc)
    (if
      (and tmp_blk (not (vlax-erased-p tmp_blk)) (vlax-write-enabled-p tmp_blk))
       (vla-erase tmp_blk)
    )
    (if osm
      (setvar "OSMODE" osm)
    )
    (foreach x loc (vla-put-lock x :vlax-true))
  )
  (vl-load-com)
  (setvar "CMDECHO" 0)
  (setq osm (getvar "OSMODE"))
  (if (zerop (getvar "WORLDUCS"))
    (progn (vl-cmdf "_.UCS" "") (vl-cmdf "_.Plan" ""))
  )
  (setq isRus (= (getvar "SysCodePage") "ANSI_1251"))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        blks (vla-get-blocks adoc)
        lays (vla-get-layers adoc)
  )
  (vla-startundomark adoc)
  (if isRus
    (princ "\n???????? ??????? ??? ?????????? ???????")
    (princ "\nSelect objects for making a contour")
  )
  (vlax-for lay lays
    (if (= (vla-get-lock lay) :vlax-true)
      (progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc)))
    )
  )
  (if (setq sel (ssget))
    (progn
      (setq sel (ssnamex sel))
      (setq iNSpT '(0 0 0))
      (setq sel (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar 'cadr sel))
                )
      )
      (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel))))
      (setq unnamed_block
             (vla-add (vla-get-blocks adoc) (vlax-3d-point inspt) "*U")
      )
      (foreach x sel
        (setq oname (strcase (vla-get-objectname x)))
        (cond
          ((member
             oname
             '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION" "ACDBMTEXT" "ACDBTEXT")
           )
           nil
          )
          ((= oname "ACDBBLOCKREFERENCE")
           (vla-insertblock
             unnamed_block
             (vla-get-insertionpoint x)
             (vla-get-name x)
             (vla-get-xscalefactor x)
             (vla-get-yscalefactor x)
             (vla-get-zscalefactor x)
             (vla-get-rotation x)
           )
           (setq blk (cons x blk))
          )
          (t (setq obj (cons x obj)))
        )
      ) ;_foreach
      (setq lay (vla-item lays (getvar "CLAYER")))
      (if (= (vla-get-lock lay) :vlax-true)
        (progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc)))
      )
      (if obj
        (progn
          (vla-copyobjects
            (vla-get-activedocument (vlax-get-acad-object))
            (vlax-make-variant
              (vlax-safearray-fill
                (vlax-make-safearray vlax-vbobject (cons 0 (1- (length obj))))
                obj
              )
            )
            unnamed_block
          )
        )
      )
      (setq obj (append obj blk))
      (if obj
        (progn
          (setq tmp_blk (vla-insertblock
                          csp
                          (vlax-3d-point inspt)
                          (vla-get-name unnamed_block)
                          1.0
                          1.0
                          1.0
                          0.0
                        )
          )
          (vla-getboundingbox tmp_blk 'MinPt 'MaxPt) ;_??????? ?????
          (setq MinPt (vlax-safearray->list MinPt)
                MaxPt (vlax-safearray->list MaxPt)
                DS    (max (distance MinPt (list (car MinPt) (cadr MaxPt)))
                           (distance MinPt (list (car MaxPt) (cadr MinPt)))
                      )
                DS    (* 0.2 DS) ;1/5
                DS    (max DS 10)
                MinPt (mapcar '- MinPt (list DS DS))
                MaxPt (mapcar '+ MaxPt (list DS DS))
          )
          (lib:Zoom2Lst (list MinPt MaxPt))
          (setq sset (ssget "_C" MinPt MaxPt))
          (if sset
            (progn (setvar "OSMODE" 0)
                   (setq hiden (mapcar 'vlax-ename->vla-object
                                       (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))
                               )
                         hiden (vl-remove tmp_blk hiden)
                   )
                   (mapcar '(lambda (x) (vla-put-visible x :vlax-false)) hiden)
                   (setq pt (mapcar '+ MinPt (list (* 0.5 DS) (* 0.5 DS))))
                   (vl-cmdf "_.RECTANG" (trans MinPt 0 1) (trans MaxPt 0 1))
                   (setq pl (vlax-ename->vla-object (entlast)))
                   (setq sc (1- (vla-get-count csp)))
                   (if (vl-catch-all-error-p
                         (vl-catch-all-apply
                           '(lambda ()
                              (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")
                              (while (> (getvar "CMDACTIVE") 0) (command ""))
                            )
                         )
                       )
                     (if isRus
                       (princ "\n?? ??????? ????????? ??????")
                       (princ "\nIt was not possible to construct a contour")
                     )
                   )
                   (setq ec (vla-get-count csp))
                   (while (< sc ec)
                     (setq ret (append ret (list (vla-item csp sc)))
                           sc  (1+ sc)
                     )
                   )
                   (setq ret (vl-remove pl ret))
                   (mapcar '(lambda (x) (vla-erase x) (vlax-release-object x))
                           (list pl tmp_blk)
                   )
                   (setq pl nil
                         tmp_blk nil
                   )
                   (setq ret (mapcar '(lambda (x / mipt)
                                        (vla-getboundingbox x 'MiPt nil) ;_??????? ?????
                                        (setq MiPt (vlax-safearray->list MiPt))
                                        (list MiPt x)
                                      )
                                     ret
                             )
                   )
                   (setq ret
                          (vl-sort
                            ret
                            '(lambda (e1 e2)
                               (< (distance MinPt (car e1)) (distance MinPt (car e2)))
                             )
                          )
                   )
                   (setq pl  (nth 1 ret)
                         ret (vl-remove pl ret)
                   )
                   (mapcar 'vla-erase (mapcar 'cadr ret))
                   (mapcar '(lambda (x) (vla-put-visible x :vlax-true)) hiden)
                   (foreach x loc (vla-put-lock x :vlax-true))
                   (if pl
                     (progn (initget "Yes No")
                            (if (= (getkword (if isRus
                                               "\n??????? ???????? [Yes/No] : "
                                               "\nDelete objects? [Yes/No] : "
                                             )
                                   )
                                   "Yes"
                                )
                              (mapcar '(lambda (x)
                                         (if (vlax-write-enabled-p x)
                                           (vla-erase x)
                                         )
                                       )
                                      obj
                              )
                            )
                     )
                     (if isRus
                       (princ "\n?? ??????? ????????? ??????")
                       (princ "\nIt was not possible to construct a contour")
                     )
                   )
            )
          )
        )
      )
      (vl-catch-all-apply
        '(lambda ()
           (mapcar 'vlax-release-object
                   (list unnamed_block tmp_blk csp blks lays)
           )
         )
      )
    )
  ) ;_if not
  (foreach x loc (vla-put-lock x :vlax-true))
  (setvar "OSMODE" osm)
  (vla-endundomark adoc)
  (vlax-release-object adoc)
  (princ)
)
(princ "\nType ECO in command line")

<edit: formatted code>

[coffee]

Will give it a go, thanks.

Stephen

[ronjonp]

XCLIP clips nested XREFS\BLOCKS on my computer?  Your lisp routine is also missing 2 closing parenthesis (maybe that's a start to your problem?).

Ron

[coffee]

Ron,
I will have to have a look at the routine and find them then, thanks. As for xclip clipping nested blocks etc, it isn't addressing the purpose. The purpose is to strip the not wanted extras and bring the file size down, not hide them and pretend they are not there. This why I don't wish to use xclip or clipit as that's what they both do, hide rather remove.

Stephen