help ...with routine select by viewport

[leonucadomi]

hello:

 

a while ago they gave me a code which is used to copy model space objects 

selecting a viewport , instead of selecting a viewport  I would like to modify it to make a selection in the window

from paperspace and select the objects inside that area to be able to copy them.

 

any help is welcome thanks

 

(vl-load-com)
(defun l-coor2l-pt (lst flag / )
    (if lst
        (cons (list (car lst) (cadr lst) (if flag (caddr lst) 0.0))
            (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
        )
    )
)





(defun c:sv ( / AcDoc Space js pt_v id_vp l h lst_pt js_obj UCS save_ucs WSC nw_pl ob_lst_pt vps inv-vps)
  (setvar "CMDECHO" 0)
    (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space (vla-get-PaperSpace AcDoc)
  )
  (vla-StartUndoMark AcDoc)
  (if (eq (getvar "CTAB") "Model") (setvar "TILEMODE" 0))
  (command "_.PSPACE")
  (princ "\nSelect a viewport: ")
  (while
    (null
      (setq js
        (ssget "_+.:E:S:L"
          (list
            '(0 . "VIEWPORT")
            '(67 . 1)
            (cons 410 (getvar "CTAB"))
            '(-4 . "!=")
            '(69 . 1)
          )
        )
      )
    )
  )
  (setq
    pt_v (cdr (assoc 10 (setq dxf_ent (entget (setq ent (ssname js 0))))))
    id_vp (cdr (assoc 69 dxf_ent))
    l (cdr (assoc 40 dxf_ent))
    h (cdr (assoc 41 dxf_ent))
    lst_pt
    (list
      (list (- (car pt_v) (* 0.5 l)) (- (cadr pt_v) (* 0.5 h)) 0.0)
      (list (+ (car pt_v) (* 0.5 l)) (- (cadr pt_v) (* 0.5 h)) 0.0)
      (list (+ (car pt_v) (* 0.5 l)) (+ (cadr pt_v) (* 0.5 h)) 0.0)
      (list (- (car pt_v) (* 0.5 l)) (+ (cadr pt_v) (* 0.5 h)) 0.0)
    )
    js_obj (ssadd)
  )
  (entmakex
    (vl-list*
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 67 1)
      (cons 100 "AcDbPolyline")
      (cons 90 (length lst_pt))
      (cons 70 1)
      (mapcar '(lambda (p) (cons 10 p)) lst_pt)
    )
  )
  (ssadd (setq nw_pl (entlast)) js_obj)
(setq vps (vla-get-CustomScale (vlax-ename->vla-object (ssname js 0))))
(setq inv-vps (/ 1 vps))


  (command "_.MSPACE")
  (setvar "CVPORT" id_vp)
  (command "_.PSPACE")
  (command "_.CHSPACE" js_obj "" (if (> id_vp 2) ""))
  (command "_.MSPACE")
  (setq
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
    UCS (vla-get-UserCoordinateSystems AcDoc)
    save_ucs
    (vla-add UCS
      (vlax-3d-point '(0.0 0.0 0.0))
      (vlax-3d-point (getvar "UCSXDIR"))
      (vlax-3d-point (getvar "UCSYDIR"))
      "CURRENT_UCS"
    )
  )
  (vla-put-Origin save_ucs (vlax-3d-point (getvar "UCSORG")))
  (setq WCS (vla-add UCS (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(1.0 0.0 0.0)) (vlax-3d-Point '(0.0 1.0 0.0)) "TEMP_WCS"))
  (vla-put-activeUCS AcDoc WCS)
  (setq
    nw_pl (vlax-ename->vla-object nw_pl)
    ob_lst_pt (l-coor2l-pt (vlax-get nw_pl 'coordinates) nil)
  )
  (vla-put-layer nw_pl "0")
  (vla-delete nw_pl)
  ;(sssetfirst nil (ssget "_WP" ob_lst_pt ))
  (setq objetos (ssget "_WP" ob_lst_pt ))
  (command "_copyclip" objetos "")
  (and save_ucs (vla-put-activeUCS AcDoc save_ucs))
  (and WCS (vla-delete WCS) (setq WCS nil))
  (vla-EndUndoMark AcDoc)
  
  (setvar "CMDECHO" 1)

  (prin1)
)

 

[BIGAL]

Like this sets the size based on your title block, the rectangs can be moved, rotated, copied or deleted, the next step is that all layouts are created.

 

2nd option follow pline.

[leonucadomi]

where is that routine to try