Author Topic: Copy part of drawing placed in PS viewport from one drawing to other drawing  (Read 1320 times)

0 Members and 1 Guest are viewing this topic.

danglar

  • Newt
  • Posts: 161
  • Read My Li(s)(p)
I often need to copy part of drawing placed in PS viewport from one drawing to other drawings
I did it manually by following steps:
1.   First of  all in a source drawing  from  PS I draw outline for viewport, I want to copy to other drawings
2.   UCS – World and From MS I do “copy with base point”  0,0,0
3.   In target drawing I change UCS to World too and do “Paste with original coordinates”
4.   In a source drawing   in PS I copy to clipboard viewport..
5.   In target drawing I go to PS and paste saved viewport when I already have in MS necessary part of drawing.

My question is: How can I automate this “short” algorithm via lisp
Any help will be appreciated


MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Quickly bashed together from existing code. Use and abuse to suit:

Code: [Select]
(progn

    (defun _Doc ( )

        (vl-load-com)
       
        (setq *doc* (vla-get-activedocument (vlax-get-acad-object)))

        (defun _Doc ( ) *doc*)

        *doc*
   
    )
   
    (defun _Try ( try_statement / try_result )
   
        (vl-catch-all-apply
            (function
                (lambda ( )
                    (setq try_result (eval try_statement))
                )
            )
        )
   
        try_result   
   
    )

    (defun _Item ( collection key )
   
        (_Try '(vla-item collection key))
   
    )
   
    (defun _MakeKey ( collection / prefix result i )
   
        (setq
            prefix "$temp"
            result prefix
            i      0
        )
   
        (while (_Item collection result)
            (setq result (strcat prefix "_" (itoa (setq i (1+ i)))))
        )
   
        result
   
    )
   
    (defun _PushUCS ( / key )
   
        (setq key (_MakeKey (vla-get-usercoordinatesystems (_Doc))))

        (vl-cmdf ".ucs" "_save" key)
 
        key
   
    )
   
    (defun _PopUCS ( key )
   
        ;;  Caller's responsibility to pass valid key.

        (vl-cmdf ".ucs" "_restore" key)
 
        (vl-cmdf ".ucs" "_delete" key)
 
        (princ)
   
    )
   
    (defun c:CB ( / cmdecho ucs ss )
   
        (if (setq ss (ssget))
            (progn
                (setq cmdecho (getvar 'cmdecho))
                (setvar 'cmdecho 0)
                (setq ucs (_PushUCS))
                (command ".ucs" "_world")
                (_Try '(vl-cmdf ".copybase" "_non" "0,0,0" ss ""))
                (_PopUCS ucs)   
                (setvar 'cmdecho cmdecho)
            )
        )
   
        (princ)
   
    )
   
    (defun c:PB ( / cmdecho ucs elev )
   
        (setq
            cmdecho (getvar 'cmdecho)
            elev    (getvar 'elevation)
        )

        (setvar 'cmdecho 0)
        (setvar 'elevation 0.0)
        (setq ucs (_PushUCS))
        (command ".ucs" "_world")

        (_Try '(vl-cmdf ".pasteclip" "_non" "0,0"))
   
        (_PopUCS ucs)
        (setvar 'cmdecho cmdecho)
        (setvar 'elevation elev)
        (princ)
   
    )

    (princ)

)

FWIW, Cheers and good luck, MP.
« Last Edit: March 23, 2015, 08:42:11 AM by MP »
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

danglar

  • Newt
  • Posts: 161
  • Read My Li(s)(p)
Thank you MP. Your program work fine but it still remain semi-automated, i mean in order to copy viewport with part of source drawing within I must  to invoke it twice: one in MS for part of drawing within the viewport frame and another one in PS in order to copy viewport to clipboard..

My question is: Is it possible to combine two these processes in one routine?

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Given more dev't time sure, everything is possible. But it's not time I have (I'm working 7 days a week). You'll have to cross the finish line without me. Cheers. :)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

danglar

  • Newt
  • Posts: 161
  • Read My Li(s)(p)
I did some unsuccessful changes in c:Cb routine in order to make a selection set from PS and during selection to activate floating MS viewport to continue to make a selection set but program don’t  want to make me happy:) Please check the code and tell me that's wrong
Code: [Select]
(progn

    (defun _Doc ( )

        (vl-load-com)
       
        (setq *doc* (vla-get-activedocument (vlax-get-acad-object)))

        (defun _Doc ( ) *doc*)

        *doc*
   
    )
   
    (defun _Try ( try_statement / try_result )
   
        (vl-catch-all-apply
            (function
                (lambda ( )
                    (setq try_result (eval try_statement))
                )
            )
        )
   
        try_result   
   
    )

    (defun _Item ( collection key )
   
        (_Try '(vla-item collection key))
   
    )
   
    (defun _MakeKey ( collection / prefix result i )
   
        (setq
            prefix "$temp"
            result prefix
            i      0
        )
   
        (while (_Item collection result)
            (setq result (strcat prefix "_" (itoa (setq i (1+ i)))))
        )
   
        result
   
    )
   
    (defun _PushUCS ( / key )
   
        (setq key (_MakeKey (vla-get-usercoordinatesystems (_Doc))))

        (vl-cmdf ".ucs" "_save" key)
 
        key
   
    )
   
    (defun _PopUCS ( key )
   
        ;;  Caller's responsibility to pass valid key.

        (vl-cmdf ".ucs" "_restore" key)
 
        (vl-cmdf ".ucs" "_delete" key)
 
        (princ)
   
    )
   
    (defun c:CB ( / cmdecho ucs ss )
   
        (if (setq ss (ssget))

            (progn
                (setq cmdecho (getvar 'cmdecho))
                (setvar 'cmdecho 0)
                (setq ucs (_PushUCS))
(while (> (getvar "CmdActive") 0)
    (command pause)
  )
  (setvar "autosnap" 39)
(setvar "osmode" 1)
((command ".MSPACE")
   (SetVar "cmdecho" 1)
)
                (command ".ucs" "_world")
                (_Try '(vl-cmdf ".copybase" "_non" "0,0,0" ss ""))
                (_PopUCS ucs)   
                (setvar 'cmdecho cmdecho)
            )
        )
   
        (princ)
   
    )
   
    (defun c:PB ( / cmdecho ucs elev )
   
        (setq
            cmdecho (getvar 'cmdecho)
            elev    (getvar 'elevation)
        )

        (setvar 'cmdecho 0)
        (setvar 'elevation 0.0)
        (setq ucs (_PushUCS))
        (command ".ucs" "_world")

        (_Try '(vl-cmdf ".pasteclip" "_non" "0,0"))
   
        (_PopUCS ucs)
        (setvar 'cmdecho cmdecho)
        (setvar 'elevation elev)
        (princ)
   
    )

    (princ)

)