Author Topic: Lisp to Create viewport (  (Read 8357 times)

0 Members and 1 Guest are viewing this topic.

luisternou

  • Newt
  • Posts: 32
Lisp to Create viewport (
« on: May 26, 2014, 07:26:40 AM »
Hello everyone!

I read this old post: http://www.theswamp.org/index.php?topic=42149.0;all
I also have the same question as Martin had on July 12, 2012, 10:43:37 pm. Quote "It works in the "UCS" world very well.
But if I have turned my plan in model space in the user coordinate system and then create a new viewport does not fit the new viewport in the layout. The section shown is postponed.
As I said, everything fits in the world UCS. Not only in the user coordinate system."
So, the thing is: the viewport content in PS is placed wrong acording to the UCS set in MS, instead, it positions/rotates the content in the viewport back in to WCS in paperspace.

This is the lisp (a big thanks to Kruuger and support!):

Code - Auto/Visual Lisp: [Select]
  1. (defun c:NV (/ *error* _RestoreView p1 p2 doc ct vs vc tmp mp sc ll sl res vpdoc vpp vp ans)
  2.   (defun *error* (Msg)
  3.     (princ "Error: ")
  4.     (princ Msg)
  5.     (if ct (_RestoreView))
  6.     (princ)
  7.   )
  8.   (defun _RestoreView ()
  9.     (setvar "ctab" ct)
  10.   )
  11.   (if (/= (getvar "cvport") 1)
  12.     (if
  13.       (and
  14.         (setq p1 (getpoint "\nSelect first point of view: "))
  15.         (setq p2 (getcorner p1 "\nSelect second point of view: "))
  16.       )
  17.       (progn
  18.               ct (getvar "ctab")
  19.               vs (getvar "viewsize")
  20.               vc (getvar "viewctr")
  21.               sc (cond
  22.                    ( (getint
  23.                        (strcat
  24.                          "\nWhat is Viewport Scale 1: <"
  25.                          (itoa (setq sc (cond (sc) (50))))
  26.                          ">: "
  27.                        )
  28.                      )
  29.                    )
  30.                    ( sc )
  31.                  )
  32.         )
  33.         (setq ll
  34.           (vlax-for % (vla-get-layouts doc)
  35.             (setq res
  36.               (cons
  37.                 (list
  38.                   (vla-get-name %)
  39.                   %
  40.                   (vla-get-TabOrder %)
  41.                 )
  42.                 res
  43.               )
  44.             )
  45.           )
  46.         )
  47.         (setq ll
  48.           (cdr
  49.             (vl-sort ll
  50.              '(lambda (a b)
  51.                 (< (last a) (last b))
  52.               )
  53.             )
  54.           )
  55.         )
  56.         (if (setq sl (cd:DCL_StdListDialog (mapcar ' car ll) 0 "NewViewport" "Select layout:" 40 15 2 nil T T))
  57.           (progn
  58.             (setvar "ctab" (car (nth sl ll)))
  59.             (vla-put-MSpace doc :vlax-false)
  60.             (if (setq vpp (getpoint "\nSelect Point for Viewport: "))
  61.               (progn
  62.                 (if
  63.                   (<
  64.                     (car (trans p2 1 0))
  65.                     (car (trans p1 1 0))
  66.                   )
  67.                   (setq tmp p1 p1 p2 p2 tmp)
  68.                 )
  69.                 (setq mp
  70.                   (list
  71.                      (/ (+ (car p1) (car p2)) 2)
  72.                      (/ (+ (cadr p1) (cadr p2)) 2)
  73.                      0.0
  74.                   )
  75.                 )
  76.                 (setq vpdoc (vla-get-PaperSpace doc)
  77.                       vp (vla-AddPViewport
  78.                            vpdoc
  79.                            (vlax-3d-point vpp)
  80.                            (abs (/ (- (car p2) (car p1)) sc))
  81.                            (abs (/ (- (cadr p2) (cadr p1)) sc))
  82.                          )
  83.                 )
  84.                 (vla-display vp :vlax-true)
  85.                 (vla-put-MSpace doc :vlax-true)
  86.                 (vla-put-ActivePViewport doc vp)
  87.                 (vla-ZoomCenter
  88.                   (vlax-get-acad-object)
  89.                   (vlax-3d-point mp)
  90.                   1.0
  91.                 )
  92.                 (vla-put-CustomScale vp (/ 1. sc))
  93.                 (vla-put-MSpace doc :vlax-false)
  94.                 (vla-put-DisplayLocked vp :vlax-true)
  95.                 (initget "Yes No")
  96.                 (setq ans
  97.                   (cond
  98.                     ( (getkword "\nBack to model space [Yes/No] <No>: ") )
  99.                     ( "No" )
  100.                   )
  101.                 )
  102.                 (if (= ans "Yes") (_RestoreView))
  103.               )
  104.               (progn
  105.                 (princ "\n** Invalid Point ** ")
  106.                 (if ct (_RestoreView))
  107.               )
  108.             )
  109.           )
  110.           (princ "\n** Layout not selected ** ")
  111.         )
  112.       )
  113.       (princ "\n** Invalid Point ** ")
  114.     )
  115.     (princ "\nStart Program in Model Space ")
  116.   )
  117.   (princ)
  118. )
  119. ; =========================================================================================== ;
  120. ; Okno dialogowe z lista (list_box) / Dialog control with list (list_box)                     ;
  121. ;  Data      [list]    - lista do wyswietlenia / list to display                              ;
  122. ;  Pos       [INT]     - pozycja poczatkowa na liscie / select list position                  ;
  123. ;  Title     [STR/nil] - tytul okna / window title                                            ;
  124. ;  ListTitle [STR/nil] - tytul list_box / list_box title                                      ;
  125. ;  Width     [INT]     - szerokosc / width                                                    ;
  126. ;  Height    [INT]     - wysokosc / height                                                    ;
  127. ;  Btns      [0/1/2]   - [cancel/ok/ok_cancel] przyciski / buttons                            ;
  128. ;  MSelect   [T/nil]   - dopuszczenie multiple_select / allow multiple select                 ;
  129. ;  DPos      [T/nil]   - zapamietanie pozycji okna / save window position                     ;
  130. ;  DblClick  [T/nil]   - podwojny klik (wykluczone Cancel) / double click (not for Cancel)    ;
  131. ; ------------------------------------------------------------------------------------------- ;
  132. ; Zwraca / Return:                                                                            ;
  133. ;  nil  = nic nie wybrano (anulowano) / nothing was selected (canceled)                       ;
  134. ;  INT  = wybrano jedna pozycje / one position selected  | MSelect = nil                      ;
  135. ;  LIST = wybrano kilka pozycji / few positions selected | MSelect = T                        ;
  136. ; ------------------------------------------------------------------------------------------- ;
  137. ; (cd:DCL_StdListDialog '("A" "B" "C") 0 "Title" "ListTitle:" 40 15 2 nil T nil)              ;
  138. ; =========================================================================================== ;
  139. (defun cd:DCL_StdListDialog (Data Pos Title ListTitle Width Height Btns MSelect DPos DblClk
  140.                              / f tmp dc res)
  141.   (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  142.   (cond
  143.     ( (not
  144.         (and
  145.           (setq f
  146.             (open
  147.               (setq tmp (vl-FileName-MkTemp nil nil ".dcl"))
  148.               "w"
  149.             )
  150.           )
  151.           (foreach %
  152.             (list
  153.               "StdListDialog:dialog{"
  154.               (strcat "label=\""
  155.                 (if Title (strcat Title "\";") "\"\";")
  156.               )
  157.               ":list_box{key=\"list\";"
  158.               (if ListTitle
  159.                 (strcat "label=\"" ListTitle "\";")""
  160.               )
  161.               "fixed_width=true;fixed_height=true;"
  162.               (strcat "width="
  163.                 (if (not Width) "20" (itoa Width))";"
  164.               )
  165.               (strcat "height="
  166.                 (if (not Height) "20" (itoa Height))";"
  167.               )
  168.               (if (not DblClck)
  169.                 (strcat "multiple_select="
  170.                   (if MSelect "true;" "false;")
  171.                 )
  172.                 "multiple_select=false;"
  173.               )
  174.               "}"
  175.               (cond
  176.                 ( (zerop Btns) "cancel_button;")
  177.                 ( (= 1 Btns) "ok_only;")
  178.                 (T "ok_cancel;")
  179.               )
  180.               "}"
  181.             )
  182.             (write-line % f)
  183.           )
  184.           (not (close f))
  185.           (< 0 (setq dc (load_dialog tmp)))
  186.           (new_dialog "StdListDialog" dc ""
  187.             (cond
  188.               ( *cd-TempDlgPosition* )
  189.               ( (quote (-1 -1)) )
  190.             )
  191.           )
  192.         )
  193.       )
  194.     )
  195.     ( T    
  196.       (start_list "list")
  197.       (mapcar (quote add_list) Data)
  198.       (end_list)
  199.       (if (not Pos)
  200.         (setq Pos 0)
  201.         (if (> Pos (length Data)) (setq Pos 0))
  202.       )
  203.       (setq res (set_tile "list" (itoa Pos)))
  204.       (action_tile "list"
  205.         (strcat
  206.           "(setq res $value)(if DblClk (if(or(not MSelect)"
  207.           "(not (zerop Btns)))"
  208.           "(if (= $reason 4)(setq "
  209.           "*cd-TempDlgPosition* (done_dialog 1)))))"
  210.         )
  211.       )
  212.       (action_tile "accept" "(setq *cd-TempDlgPosition* (done_dialog 1))")
  213.       (action_tile "cancel" "(setq res nil) (done_dialog 0)")
  214.       (setq res
  215.         (if (= 1 (start_dialog))
  216.           (read (strcat "(" res ")"))
  217.           nil
  218.         )
  219.       )          
  220.     )
  221.   )
  222.   (if (< 0 dc) (unload_dialog dc))
  223.   (if (setq tmp (findfile tmp)) (vl-File-Delete tmp))
  224.   (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  225.   (if res (if (= 1 (length res)) (car res) res))
  226. )
  227. (princ "\n Type NV to Invoke ")
    Thanks in advance!
    Regards,
    Luis


EDIT (John): Added code tags.
« Last Edit: February 11, 2022, 11:33:26 AM by JohnK »

snownut2

  • Swamp Rat
  • Posts: 971
  • Bricscad 22 Ultimate
Re: Lisp to Create viewport (
« Reply #1 on: May 26, 2014, 09:25:29 AM »
The thing about joining a new community is having the courtesy to follow it rules, please read the "First hings first" thread and update post accordingly.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Lisp to Create viewport (
« Reply #2 on: May 26, 2014, 10:18:14 AM »
Another tip might be eschew speaking as if one had the authority to represent the host. Barring that using friendly, ambassader verbiage.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

snownut2

  • Swamp Rat
  • Posts: 971
  • Bricscad 22 Ultimate
Re: Lisp to Create viewport (
« Reply #3 on: May 26, 2014, 11:35:42 AM »
Another tip might be eschew speaking as if one had the authority to represent the host. Barring that using friendly, ambassader verbiage.

My apologies if I stepped over some sort of boundary here.

dgorsman

  • Water Moccasin
  • Posts: 2437
Re: Lisp to Create viewport (
« Reply #4 on: May 26, 2014, 11:37:24 AM »
As in, code tags make things easier to read (like this):

Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo ( / )
  2.   (princ "\nWhat FOO!")
  3. )
  4.  

There's a button which automatically generates code tags for the formatting if you don't want to add them.

Extremely long code is usually better posted as an attachment, with excerpts provided in the post to illustrate the specific problem areas.

And welcome aboard.  Most members don't bite but they can be a bit tetchy when somebody does a code dump.
If you are going to fly by the seat of your pants, expect friction burns.

try {GreatPower;}
   catch (notResponsible)
      {NextTime(PlanAhead);}
   finally
      {MasterBasics;}

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Lisp to Create viewport (
« Reply #5 on: May 26, 2014, 06:15:38 PM »
@ luisternou: There are two possible approaches to solving your problem:

1.
Change the direction, target and twistangle property of the viewport object. You will need some understanding of the trans function for this.

2.
Use the _.MVIEW command to create the viewport. This will give you a viewport with the correct direction and twistangle. All you then have to do is zoom the viewport to the corners selected in MS to get the correct customscale and target.

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Lisp to Create viewport (
« Reply #6 on: May 27, 2014, 04:16:37 AM »
Example of approach #2. There is actually no need to change the existing code to get the correct target and customscale. Note: I use BricsCAD.
Code - Auto/Visual Lisp: [Select]
  1.         ...
  2.         (setq ll
  3.           (cdr
  4.             (vl-sort ll
  5.              '(lambda (a b)
  6.                 (< (last a) (last b))
  7.               )
  8.             )
  9.           )
  10.         )
  11. ;;; ============================================================ Start of mod.
  12.         ;; 'Trans stuff' has to be done before changing the active layout:
  13.         (setq mp (trans (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)) 1 0)) ; WCS.
  14.         (setq p1 (trans p1 1 2)) ; DCS.
  15.         (setq p2 (trans p2 1 2)) ; DCS.
  16.         (if (setq sl (cd:DCL_StdListDialog (mapcar ' car ll) 0 "NewViewport" "Select layout:" 40 15 2 nil T T))
  17.           (progn
  18.             (setvar "ctab" (car (nth sl ll)))
  19.             (vla-put-mspace doc :vlax-false)
  20.             (if (setq vpp (getpoint "\nSelect bottom left point for viewport: "))
  21.               (progn
  22.                 (setvar 'cmdecho 0)
  23.                 (command
  24.                   "_.mview"
  25.                   "_none" ; Avoid esnap.
  26.                   vpp
  27.                   "_none" ; Avoid esnap.
  28.                   (list
  29.                     (+ (car vpp) (/ (abs (- (car p1) (car p2))) sc))
  30.                     (+ (cadr vpp) (/ (abs (- (cadr p1) (cadr p2))) sc))
  31.                     0.0
  32.                   )
  33.                 )
  34.                 (setvar 'cmdecho 1)
  35.                 (setq vp (vlax-ename->vla-object (entlast)))
  36. ;;; ============================================================ End of mod.
  37.                 (vla-put-MSpace doc :vlax-true)
  38.                 (vla-put-ActivePViewport doc vp)
  39.                 (vla-ZoomCenter
  40.                   (vlax-get-acad-object)
  41.                   (vlax-3d-point mp)
  42.                   1.0
  43.                 )
  44.                 (vla-put-CustomScale vp (/ 1. sc))
  45.                 ...
  46.  

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Lisp to Create viewport (
« Reply #7 on: May 27, 2014, 04:50:38 AM »
Example of approach #1.
Code - Auto/Visual Lisp: [Select]
  1.         ...
  2.         (setq ll
  3.           (cdr
  4.             (vl-sort ll
  5.              '(lambda (a b)
  6.                 (< (last a) (last b))
  7.               )
  8.             )
  9.           )
  10.         )
  11. ;;; ============================================================ Start of mod.
  12.         (if (setq sl (cd:DCL_StdListDialog (mapcar ' car ll) 0 "NewViewport" "Select layout:" 40 15 2 nil T T))
  13.           (progn
  14.             ;; 'Trans stuff' has to be done before changing the active layout:
  15.             (setq mp (trans (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)) 1 0)) ; WCS.
  16.             (setq vpDir (trans '(0.0 0.0 1.0) 2 0 T))
  17.             (setq vpDims (mapcar '* (mapcar 'abs (mapcar '- (trans p1 1 2) (trans p2 1 2))) (list (/ 1.0 sc) (/ 1.0 sc) 0.0)))
  18.             (setq vpTwist (getvar 'viewtwist))
  19.             (setvar "ctab" (car (nth sl ll)))
  20.             (vla-put-mspace doc :vlax-false)
  21.             (if (setq vpp (getpoint "\nSelect bottom left point for viewport: "))
  22.               (progn
  23.                 (setq vp
  24.                   (vla-addpviewport
  25.                     (vla-get-paperspace doc)
  26.                     (vlax-3d-point (mapcar '+ vpp (mapcar '* vpDims '(0.5 0.5 0.5))))
  27.                     (car vpDims)
  28.                     (cadr vpDims)
  29.                   )
  30.                 )
  31.                 (vla-put-customscale vp (/ 1.0 sc))
  32.                 (vla-put-direction vp (vlax-3d-point vpDir))
  33.                 (vla-put-target vp (vlax-3d-point mp))
  34.                 (vla-put-twistangle vp vpTwist)
  35.                 (vla-put-displaylocked vp :vlax-true)
  36. ;;; ============================================================ End of mod.
  37.                 (initget "Yes No")
  38.                 ...
  39.  

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Lisp to Create viewport (
« Reply #8 on: May 27, 2014, 07:17:56 AM »
The OP forgot to mention that the original version of the program was created by HasanCAD.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Lisp to Create viewport (
« Reply #9 on: May 27, 2014, 07:47:32 AM »
The OP forgot to mention that the original version of the program was created by HasanCAD.

I thought the link in the first post covered that pretty well.

//------
@Luis,
Welcome to theSwamp.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

luisternou

  • Newt
  • Posts: 32
Re: Lisp to Create viewport (
« Reply #10 on: June 19, 2014, 12:47:28 PM »
Thanks guys for your support!  :wink: I will keep your advice in mind!  :police:
Sorry for the late response but somehow I could not see if there are any replies to my post  :ugly:

luisternou

  • Newt
  • Posts: 32
Re: Lisp to Create viewport (
« Reply #11 on: June 19, 2014, 12:49:04 PM »
....oh, and almost forgot!
The original version of the program was created by HasanCAD!!!

luisternou

  • Newt
  • Posts: 32
Re: Lisp to Create viewport (
« Reply #12 on: June 19, 2014, 01:06:42 PM »
Roy_043, thanks you very much!!! This works great!!!! Just what I needed!!

Regards,
Luisternou

luisternou

  • Newt
  • Posts: 32
Re: Lisp to Create viewport (
« Reply #13 on: June 20, 2014, 05:06:45 AM »
Hello Roy_043,

The first time in UCS it works oké. If I want to place a second Vport, the detail in the Vport is shown in WCS view. After deleting al the Vports and start al over again, the same situation. First time oké...

Can you help me?
I used the "NewViewport_Approach_2.lsp" and I attached the dwg

Thanks in advance!



roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Lisp to Create viewport (
« Reply #14 on: June 20, 2014, 07:16:08 AM »
Hello Roy_043,

The first time in UCS it works oké. If I want to place a second Vport, the detail in the Vport is shown in WCS view. After deleting al the Vports and start al over again, the same situation. First time oké...

Can you help me?
I used the "NewViewport_Approach_2.lsp" and I attached the dwg

Thanks in advance!
I cannot reproduce this (Note: I use BricsCAD). I have tried creating 4 viewports. #1 and #2 are identical. #3 connects perfectly with #2. #4 was created from inside the 'floating' viewport #1.

Maybe NewViewport_Approach_1.lsp works better for you?