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

0 Members and 1 Guest are viewing this topic.

HasanCAD

  • Swamp Rat
  • Posts: 1352
Lisp to Create viewport
« on: July 01, 2012, 02:58:27 AM »
This is final release for lisp to create a viewport for selected area
Your comments are welcome
Code: [Select]
;|------------ Viewport Creator ----------------
    q_|_|| _\|| q_|| _\|

  - Select area
  - ask for viewport scale
  - Go to last layout (first at right)
  - Ask for center point of viewport
  - Create a viewport
  - view the selected area with the viewport
  Create stations for Prestresed tendon

------------------------------------------------
  Author: Hasan M. Asous, 2010
ALL RIGHT RESERVED TO ALL
  Contact: HasanCAD @ TheSwamp.org,
           asos2000 @ CADTutor.net
           HasanCAD@gmail.com
------------------------------------------------
  Version: 1      2012 07 01
________________________________________________
      |;

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;

(defun c:NV (/       doc      p1 p2 temp   mp
     scl      SC       cd:DWG_LayoutsList   res
     a       b        vpp vpdoc vp
    )

  (vl-load-com)
  (setq Doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (setq p1 (getpoint "\Select objects to view:"))
  (setq p2 (getcorner p1))
  (if
    (< (car (trans p2 1 0)) (car (trans p1 1 0)))
     (setq tmp p1
   p1  p2
   p2  tmp
     )
     T
  )
  (setq mp (list (/ (+ (car p1) (car p2)) 2)
(/ (+ (cadr p1) (cadr p2)) 2)
0.0
   )
  )

  (setq sc (cond ((getint (strcat "\nWhat is Viewport Scale 1: <"
  (itoa (setq sc (cond (sc)
       (50)
)
)
  )
  ">: "
  )
  )
)
(sc)
   )
  )
  (setq cd:DWG_LayoutsList
(vlax-for % (vla-get-layouts Doc)
   (setq res (cons (list (vla-get-name %)
(vla-get-TabOrder %)
%
   )
   res
     )
   )
)
  )
  (setvar "CTab"
  (caar (vl-sort cd:DWG_LayoutsList
'(lambda (a b) (> (cadr a) (cadr b)))
)
  )
  )

  (setq VPDoc (vla-get-PaperSpace doc))
  (setq VPp (vlax-3D-point (getpoint "\nSelect Point for Viewport")))
  (setq VP (vla-AddPViewport
     VPDoc
     VPp
     (/ (- (car p2) (car p1)) sc)
     (/ (- (cadr p2) (cadr p1)) sc)
   )
  )
  (vla-display VP :vlax-true)
  (vla-put-mspace doc :vlax-true)
  (vla-put-activepviewport Doc VP)
  (vla-zoomcenter
    (vlax-get-acad-object)
    (vlax-3d-point mp)
    1.0
  )
  (vl-cmdf "_.zoom" (strcat (RTOS (/ 1.0 SC)) "xp"))
  (vla-regen (vla-get-activedocument (vlax-get-acad-object))
     acActiveViewport
  )
  (vla-put-mspace doc :vlax-FALSE)
  (VLA-PUT-DisplayLocked VP :vlax-true)
)


;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;

(princ "\n Type  NV  to Invoke")
(princ)

Updated
« Last Edit: February 27, 2013, 02:59:44 AM by HasanCAD »

kruuger

  • Swamp Rat
  • Posts: 621
Re: Lisp to Create viewport
« Reply #1 on: July 01, 2012, 03:25:35 AM »
hi HasanCAD

lisp not working. there are missing data for VPP variable (center of viewport in paper space).

kruuger

HasanCAD

  • Swamp Rat
  • Posts: 1352
Re: Lisp to Create viewport
« Reply #2 on: July 01, 2012, 04:11:17 AM »
Updated

kruuger

  • Swamp Rat
  • Posts: 621
Re: Lisp to Create viewport
« Reply #3 on: July 01, 2012, 04:28:08 PM »
Updated
if you don't mind. Probably still not perfect:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:NV (/ *error* _RestoreView p1 p2 doc ct vs vc tmp mp sc ll 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.                   %
  39.                   (vla-get-TabOrder %)
  40.                 )
  41.                 res
  42.               )
  43.             )
  44.           )
  45.         )
  46.         (vla-put-ActiveLayout doc
  47.           (caar
  48.             (vl-sort ll
  49.              '(lambda (a b)
  50.                 (> (cadr a) (cadr b))
  51.               )
  52.             )
  53.           )
  54.         )
  55.         (vla-put-MSpace doc :vlax-false)
  56.         (if (setq vpp (getpoint "\nSelect Point for Viewport: "))
  57.           (progn
  58.             (if
  59.               (<
  60.                 (car (trans p2 1 0))
  61.                 (car (trans p1 1 0))
  62.               )
  63.               (setq tmp p1 p1 p2 p2 tmp)
  64.             )
  65.             (setq mp
  66.               (list
  67.                  (/ (+ (car p1) (car p2)) 2)
  68.                  (/ (+ (cadr p1) (cadr p2)) 2)
  69.                  0.0
  70.               )
  71.             )
  72.             (setq vpdoc (vla-get-PaperSpace doc)
  73.                   vp (vla-AddPViewport
  74.                        vpdoc
  75.                        (vlax-3d-point vpp)
  76.                        (/ (- (car p2) (car p1)) sc)
  77.                        (/ (- (cadr p2) (cadr p1)) sc)
  78.                      )
  79.             )
  80.             (vla-display vp :vlax-true)
  81.             (vla-put-MSpace doc :vlax-true)
  82.             (vla-put-ActivePViewport doc vp)
  83.             (vla-ZoomCenter
  84.               (vlax-get-acad-object)
  85.               (vlax-3d-point mp)
  86.               1.0
  87.             )
  88.             (vla-put-CustomScale vp (/ 1. sc))
  89.             (vla-put-MSpace doc :vlax-false)
  90.             (vla-put-DisplayLocked vp :vlax-true)
  91.             (initget "Yes No")
  92.             (setq ans
  93.               (cond
  94.                 ( (getkword "\nBack to model space [Yes/No] <No>: ") )
  95.                 ( "No" )
  96.               )
  97.             )
  98.             (if (= ans "Yes") (_RestoreView))
  99.           )
  100.           (progn
  101.             (princ "\n** Invalid Point ** ")
  102.             (if ct (_RestoreView))
  103.           )
  104.         )
  105.       )
  106.       (princ "\n** Invalid Point ** ")
  107.     )
  108.     (princ "\nStart Program in Model Space ")
  109.   )
  110.   (princ)
  111. )
  112. (princ "\n Type NV to Invoke ")
kruuger

KewlToyZ

  • Guest
Re: Lisp to Create viewport
« Reply #4 on: July 01, 2012, 05:24:03 PM »
My routines below:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:vpt()
  2. ;===================Turn off command line responses==============
  3. (command "CMDECHO" 0);DO NOT CHANGE THIS LINE
  4. ;=======================================================       
  5.        
  6.         (setq userlayer (getvar "clayer"))
  7.         (setq ds2 (getvar "dimscale"))
  8.         (setq userview (getvar "ctab"))
  9.         (setq myTile (getvar "TILEMODE"))
  10.         (autoload "LRG" '("LRG"))
  11.         (autoload "MPL" '("MPL"))
  12.        
  13.         (if (> 0 myTile)
  14.                         (prompt "\n   Switching view tab......")
  15.                         (command "tilemode" 0)
  16.         )
  17.  
  18.         (c:LRG)
  19.         (setvar "CLAYER" "G-VIEW-PORT")        
  20.        
  21.         (princ "\n")
  22.         (command "osmode" "523")
  23.         (princ "\n")
  24.         (command "mview")
  25.         (princ "\n")
  26.         (command (setq p1 (getpoint "\n   Select first corner of window opening: ")))
  27.         (prompt "\n ")
  28.         (command (getcorner p1 "\n   Select opposite corner of window opening: "))
  29.         (prompt "\n ")
  30.         (command "mspace")
  31.        
  32.         ; moved MPL for set scale to invoke in mspace only
  33.         (c:MPL)
  34.        
  35.         (princ "\n")
  36.         (command "zoom" "e")
  37.         (princ "\n")
  38.         (command "zoom" "c")
  39.         (princ "\n")
  40.         (command (getpoint "\n   Select center of view:"))
  41.         (princ "\n")
  42.         (command (strcat "1/" (rtos (getvar "dimscale") 2 0) "xp"))
  43.         (princ "\n")
  44.         (command "pspace")
  45.         (princ "\n")
  46.         (setvar "psltscale" 0)
  47.         (princ "\n")
  48.         (prompt "\n   DIMSCALE returning to original setting. ")
  49.         (princ "\n")
  50.         (setvar "dimscale" ds2)
  51.        
  52. ;===================Turn on command line responses==============
  53. (command "CMDECHO" 1);DO NOT CHANGE THIS LINE
  54. ;======================================================
  55.         (prompt "\n   Returning view and layer.....")
  56.         (command "ctab" userview)
  57.         (command "clayer" userlayer)
  58.         (prompt "\n   View and layer returned!")
  59.         (princ)
  60. )
  61.  
« Last Edit: July 02, 2012, 03:56:02 PM by KewlToyZ »

martinle

  • Mosquito
  • Posts: 15
Re: Lisp to Create viewport
« Reply #5 on: July 01, 2012, 11:58:54 PM »
This is final release for lisp to create a viewport for selected area
Your comments are welcome
Code: [Select]
;|------------ Viewport vreator ----------------
    q_|_|| _\|| q_|| _\|

  - Select area
  - ask for viewport scale
  - Go to last layout (first at right)
  - Ask for center point of viewport
  - Create a viewport
  - view the selected area with the viewport
  Create stations for Prestresed tendon

------------------------------------------------
  Author: Hasan M. Asous, 2010
ALL RIGHT RESERVED TO ALL
  Contact: HasanCAD @ TheSwamp.org,
           asos2000 @ CADTutor.net
           HasanCAD@gmail.com
------------------------------------------------
  Version: 1      2012 07 01
________________________________________________
      |;

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;

(defun c:NV (/       doc      p1 p2 temp   mp
     scl      SC       cd:DWG_LayoutsList   res
     a       b        vpp vpdoc vp
    )

  (vl-load-com)
  (setq Doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (setq p1 (getpoint "\Select objects to view:"))
  (setq p2 (getcorner p1))
  (if
    (< (car (trans p2 1 0)) (car (trans p1 1 0)))
     (setq tmp p1
   p1  p2
   p2  tmp
     )
     T
  )
  (setq mp (list (/ (+ (car p1) (car p2)) 2)
(/ (+ (cadr p1) (cadr p2)) 2)
0.0
   )
  )

  (setq sc (cond ((getint (strcat "\nWhat is Viewport Scale 1: <"
  (itoa (setq sc (cond (sc)
       (50)
)
)
  )
  ">: "
  )
  )
)
(sc)
   )
  )
  (setq cd:DWG_LayoutsList
(vlax-for % (vla-get-layouts Doc)
   (setq res (cons (list (vla-get-name %)
(vla-get-TabOrder %)
%
   )
   res
     )
   )
)
  )
  (setvar "CTab"
  (caar (vl-sort cd:DWG_LayoutsList
'(lambda (a b) (> (cadr a) (cadr b)))
)
  )
  )

  (setq VPDoc (vla-get-PaperSpace doc))
  (setq VPp (vlax-3D-point (getpoint "\nSelect Point for Viewport")))
  (setq VP (vla-AddPViewport
     VPDoc
     VPp
     (/ (- (car p2) (car p1)) sc)
     (/ (- (cadr p2) (cadr p1)) sc)
   )
  )
  (vla-display VP :vlax-true)
  (vla-put-mspace doc :vlax-true)
  (vla-put-activepviewport Doc VP)
  (vla-zoomcenter
    (vlax-get-acad-object)
    (vlax-3d-point mp)
    1.0
  )
  (vl-cmdf "_.zoom" (strcat (RTOS (/ 1.0 SC)) "xp"))
  (vla-regen (vla-get-activedocument (vlax-get-acad-object))
     acActiveViewport
  )
  (vla-put-mspace doc :vlax-FALSE)
  (VLA-PUT-DisplayLocked VP :vlax-true)
)


;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;

(princ "\n Type  NV  to Invoke")
(princ)

Updated

Hello HasanCAD

The Lisp works very well. It would be great if you could choose the layout where you want to create the view window.
Would this be feasible?

Martin

HasanCAD

  • Swamp Rat
  • Posts: 1352
Re: Lisp to Create viewport
« Reply #6 on: July 02, 2012, 03:15:59 AM »
Updated
if you don't mind. Probably still not perfect:
...
kruuger

Of course i would not mind, but give me a time to study yours, compare with mine and see what is missing in mine.
Thanks Krugger for development.
« Last Edit: February 27, 2013, 03:01:05 AM by HasanCAD »

HasanCAD

  • Swamp Rat
  • Posts: 1352
Re: Lisp to Create viewport
« Reply #7 on: July 02, 2012, 03:25:00 AM »
My routines below:
...
Thanks for new idea
but gives error
Code: [Select]
Initializing...
      Scale list being loaded, Please be patient......
bad argument type: numberp: nil

KewlToyZ

  • Guest
Re: Lisp to Create viewport
« Reply #8 on: July 02, 2012, 12:22:26 PM »
My routines below:
...
Thanks for new idea
but gives error
Code: [Select]
Initializing...
      Scale list being loaded, Please be patient......
bad argument type: numberp: nil

I have heard that before. I use it with my own settings and I am not sure what others are missing. I got it working in versions 2010 through 2013 on my end, but I have a reactor built into the startup from here for ScaleListEdit. I'm just wondering what variables I am missing for it.

kruuger

  • Swamp Rat
  • Posts: 621
Re: Lisp to Create viewport
« Reply #9 on: July 02, 2012, 12:44:47 PM »
My routines below:
Code: [Select]
(defun c:vpt()
;=============================================================================Turn off command line responses
(command "CMDECHO" 0);DO NOT CHANGE THIS LINE
;=============================================================================

(setq userlayer (getvar "clayer"))
(setq ds2 (getvar "dimscale"))
(setq userview (getvar "ctab"))
(setq myTile (getvar "TILEMODE"))
(autoload "LRG" '("LRG"))
;(autoload "setviewscale" '("setviewscale"))
(autoload "MPL" '("MPL"))
;(setq vptLayer ("G-VIEW-PORT"))

;(> <NUMB1> <NUMB2>)                      Returns T if <NUMB1>is greater than <NUMB2>.
(if (> 0 myTile)
(prompt "\n   Switching view tab......")
(command "tilemode" 0)
)

(c:LRG)
(setvar "CLAYER" "G-VIEW-PORT")   

(princ "\n")
(command "osmode" "523")
(princ "\n")
(command "mview")
(princ "\n")
(command (setq p1 (getpoint "\n   Select first corner of window opening: ")))
(prompt "\n ")
(command (getcorner p1 "\n   Select opposite corner of window opening: "))
(prompt "\n ")
(command "mspace")

; moved setscale to invoke in mspace only
;(c:setviewscale)
(c:MPL)

(princ "\n")
(command "zoom" "e")
(princ "\n")
(command "zoom" "c")
(princ "\n")
(command (getpoint "\n   Select center of view:"))
(princ "\n")
(command (strcat "1/" (rtos (getvar "dimscale") 2 0) "xp"))
(princ "\n")
    (command "pspace")
    (princ "\n")
(setvar "psltscale" 0)
(princ "\n")
(prompt "\n   DIMSCALE returning to original setting. ")
(princ "\n")
(setvar "dimscale" ds2)

;=============================================================================Turn off command line responses
(command "CMDECHO" 1);DO NOT CHANGE THIS LINE
;=============================================================================
(prompt "\n   Returning view and layer.....")
(command "ctab" userview)
(command "clayer" userlayer)
(prompt "\n   View and layer returned!")
(princ)
)
i saw that you are using some subroutine form here: http://web2.airmail.net/terrycad/AutoLISP-Code.htm (like set_tile_list, maybe more)
without loading some additional function program will not work.
kruuger

KewlToyZ

  • Guest
Re: Lisp to Create viewport
« Reply #10 on: July 02, 2012, 01:14:15 PM »
My routines below:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:vpt()
  2. ;=============================================================================Turn off command line responses
  3. (command "CMDECHO" 0);DO NOT CHANGE THIS LINE
  4. ;============================================================================= 
  5.        
  6.         (setq userlayer (getvar "clayer"))
  7.         (setq ds2 (getvar "dimscale"))
  8.         (setq userview (getvar "ctab"))
  9.         (setq myTile (getvar "TILEMODE"))
  10.         (autoload "LRG" '("LRG"))
  11.         (autoload "MPL" '("MPL"))
  12.        
  13.         (if (> 0 myTile)
  14.                         (prompt "\n   Switching view tab......")
  15.                         (command "tilemode" 0)
  16.         )
  17.  
  18.         (c:LRG)
  19.         (setvar "CLAYER" "G-VIEW-PORT")        
  20.        
  21.         (princ "\n")
  22.         (command "osmode" "523")
  23.         (princ "\n")
  24.         (command "mview")
  25.         (princ "\n")
  26.         (command (setq p1 (getpoint "\n   Select first corner of window opening: ")))
  27.         (prompt "\n ")
  28.         (command (getcorner p1 "\n   Select opposite corner of window opening: "))
  29.         (prompt "\n ")
  30.         (command "mspace")
  31.        
  32.         ; moved MPL set scale to invoke in mspace only
  33.         (c:MPL)
  34.        
  35.         (princ "\n")
  36.         (command "zoom" "e")
  37.         (princ "\n")
  38.         (command "zoom" "c")
  39.         (princ "\n")
  40.         (command (getpoint "\n   Select center of view:"))
  41.         (princ "\n")
  42.         (command (strcat "1/" (rtos (getvar "dimscale") 2 0) "xp"))
  43.         (princ "\n")
  44.         (command "pspace")
  45.         (princ "\n")
  46.         (setvar "psltscale" 0)
  47.         (princ "\n")
  48.         (prompt "\n   DIMSCALE returning to original setting. ")
  49.         (princ "\n")
  50.         (setvar "dimscale" ds2)
  51.        
  52. ;=============================================================================Turn off command line responses
  53. (command "CMDECHO" 1);DO NOT CHANGE THIS LINE
  54. ;============================================================================= 
  55.         (prompt "\n   Returning view and layer.....")
  56.         (command "ctab" userview)
  57.         (command "clayer" userlayer)
  58.         (prompt "\n   View and layer returned!")
  59.         (princ)
  60. )
  61.  
i saw that you are using some subroutine form here: http://web2.airmail.net/terrycad/AutoLISP-Code.htm (like set_tile_list, maybe more)
without loading some additional function program will not work.
kruuger
Yes I included the additional routines in my zip file?
One is a layer insert routine, the other is a scale setting routine.
« Last Edit: July 02, 2012, 03:52:11 PM by KewlToyZ »

antistar

  • Newt
  • Posts: 96
Re: Lisp to Create viewport
« Reply #11 on: July 05, 2012, 09:52:36 AM »
HasanCAD,
Congratulations, this routine is very helpful to me.
However, in some designs, it returns the following error:

Select Point for Viewport
ERROR: Automation Error. Invalid arqument Height in AddPViewport method

I work in centimeters.

Now a suggestion:
I work with many layouts in drawings.
There are how to select layout that I want to creat the viewport?

Thanks in advance
« Last Edit: July 05, 2012, 10:08:13 AM by antistar »

kruuger

  • Swamp Rat
  • Posts: 621
Re: Lisp to Create viewport
« Reply #12 on: July 09, 2012, 06:14:10 AM »
Now a suggestion:
I work with many layouts in drawings.
There are how to select layout that I want to creat the viewport?

The Lisp works very well. It would be great if you could choose the layout where you want to create the view window.
Would this be feasible?

you can try this one.
kruuger

martinle

  • Mosquito
  • Posts: 15
Re: Lisp to Create viewport
« Reply #13 on: July 10, 2012, 12:05:05 AM »
Hello Kruuger!

Unfortunately I get an error message:


command:
Select Point for Viewport: Error: Automation error Invalid argument
Height in methodRegeneriert AddPViewport model.

Martin

kruuger

  • Swamp Rat
  • Posts: 621
Re: Lisp to Create viewport
« Reply #14 on: July 10, 2012, 06:53:20 AM »
Hello Kruuger!

Unfortunately I get an error message:


command:
Select Point for Viewport: Error: Automation error Invalid argument
Height in methodRegeneriert AddPViewport model.

Martin
hmm, this is very weird.
sometimes is Invalid Height, sometimes Error setting current viewportRestoring cached viewports. and sometimes is working.
i will try to investigate this. maybe replace with (command "vports" ...)
kruuger

martinle

  • Mosquito
  • Posts: 15
Re: Lisp to Create viewport
« Reply #15 on: July 12, 2012, 12:05:10 AM »
Hello Mr. Kruuger!

I believe I have found the error.
When I go to "Select first point of view:" A window on the lower left to upper right aufziehe then it works. When I became a window from bottom right to top left aufziehe is the error message!
Could this be the problem?

Martin

martinle

  • Mosquito
  • Posts: 15
Re: Lisp to Create viewport
« Reply #16 on: July 12, 2012, 12:41:21 AM »
addendum:

Hello Mr. Kruuger

Furthermore, I noticed when ucs not "world" then it brings the wrong section of the layout.
Maybe this helps even more.

Martin

Lee Mac

  • Seagull
  • Posts: 12711
  • London, England
Re: Lisp to Create viewport
« Reply #17 on: July 12, 2012, 07:21:21 AM »
After a brief glance over the code, as a quick fix I would say change Line 83 / 84:

Code: [Select]
(/ (- (car p2) (car p1)) sc)
(/ (- (cadr p2) (cadr p1)) sc)

to:

Code: [Select]
(abs (/ (- (car p2) (car p1)) sc))
(abs (/ (- (cadr p2) (cadr p1)) sc))

martinle

  • Mosquito
  • Posts: 15
Re: Lisp to Create viewport
« Reply #18 on: July 12, 2012, 11:43:37 PM »
Hello Mr. Kruuger
Hello Mr. Lee!

After the change, according to Mr. Lee is now no error message.
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. :-(

Greetings

Martin

Hugo

  • Bull Frog
  • Posts: 340
Re: Lisp to Create viewport
« Reply #19 on: July 13, 2012, 12:49:22 AM »
Hallo

I would like to have the insertion point of the bottom left to change what I need there.
Thank you

Ich würde gern den Einfügepunkt links unten haben was muss ich da ändern.
Danke

smemo

  • Mosquito
  • Posts: 18
Re: Lisp to Create viewport
« Reply #20 on: July 25, 2012, 08:59:50 AM »
This is the version I wrote a while ago and I also used to improve the functions of:
Bill Kramer: "HarryDialog1.lsp/dcl";
Tee Square Graphics: "SAVARS.LSP";
Gilles Chanteau: "ArchSort" and "SplitStr";
Marc'Antonio Alessi: "ALE_ReplaceFirst" and "ALE_List_RemoveNth";
Lee McDonnell: "ADjoin", "toTop", "Remove_nth", "write_config", "read_config" and "GetLays".
LOAD.LSP the file used to load the various lisp.
CFL to run
I hope I have made ​​a decent translation

antistar

  • Newt
  • Posts: 96
Re: Lisp to Create viewport
« Reply #21 on: July 25, 2012, 06:23:31 PM »
This is the version I wrote a while ago and I also used to improve the functions of:
Bill Kramer: "HarryDialog1.lsp/dcl";
Tee Square Graphics: "SAVARS.LSP";
Gilles Chanteau: "ArchSort" and "SplitStr";
Marc'Antonio Alessi: "ALE_ReplaceFirst" and "ALE_List_RemoveNth";
Lee McDonnell: "ADjoin", "toTop", "Remove_nth", "write_config", "read_config" and "GetLays".
LOAD.LSP the file used to load the various lisp.
CFL to run
I hope I have made ​​a decent translation

Hi smemo,
Excellent research work.
It is very useful to me.

 However, I have two requests:
 
- Do not want to create the dimstyles cfstandard, cfMeccanico and cfArchitettonico;
- Disable the frame OPTION in DCL box.

 Thanks in advance    

smemo

  • Mosquito
  • Posts: 18
Re: Lisp to Create viewport
« Reply #22 on: July 26, 2012, 02:15:13 AM »
You need to comment in the file lisp lines:
Code: [Select]
953 (StiliDIM)
959 (ListaDimStili)
965 (set_tile "$CSD" "0")
966 (setq CreDimScala "0")
974 (mode_tile "$DST" 1)
983 (action_tile "$CSD" "(setq CreDimScala (get_tile \"$CSD\"))(if (= CreDimScala \"1\" )(congela)(scongela))")
990 (action_tile "$DST" "(setq DS_nlst (atoi $value))")
999 (setq DS_nlst (atoi (get_tile "$DST")))
1000 (setq StQuo (nth DS_nlst ListaDS))
1023 (if (/= CreDimScala "1")
1033 );if
1035 (if (= CreDimScala "1")
1036 (progn
1037     (command "_.-dimstyle" "_restore" StQuo)
1038 (CreaStyDim)
1039 (setvar "textsize" (/ 2.5 (distof FattZoom 2)))
1040 ;; Se è stato selezionato la creazione delle quote imposta anche l'altezza dei testi a 2.5 mm
1041     )
1042 )

and comment in the file DCL lines:
Code: [Select]
100 : toggle {
101 label = "Creates only Style DIM";
102 key = "$CSD";
103 value = "0";
104 }
105 : popup_list {
106 label = "from Style:";
107 key = "$DST";
108 width = 30 ;
109 allow_accept = false;
110 }

luisternou

  • Newt
  • Posts: 32
Re: Lisp to Create viewport
« Reply #23 on: June 19, 2014, 12:36:34 PM »
As result of the first post about how to create a viewport in modelspace, the code listed below only works in WCS. Most off the time I'm working in a UCS. If I use this lisp in UCS it doesn't work.
Please, can someone help!!

Thanks in advance!!


Code: [Select]
(defun c:NV (/ *error* _RestoreView p1 p2 doc ct vs vc tmp mp sc ll sl res vpdoc vpp vp ans)
  (defun *error* (Msg)
    (princ "Error: ")
    (princ Msg)
    (if ct (_RestoreView))
    (princ)
  )
  (defun _RestoreView ()
    (setvar "ctab" ct)
    (vla-ZoomCenter (vlax-Get-Acad-Object) (vlax-3d-Point (trans vc 1 0)) vs)
  )
  (vl-load-com)
  (if (/= (getvar "cvport") 1)
    (if
      (and
        (setq p1 (getpoint "\nSelect first point of view: "))
        (setq p2 (getcorner p1 "\nSelect second point of view: "))
      )
      (progn
        (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
              ct (getvar "ctab")
              vs (getvar "viewsize")
              vc (getvar "viewctr")
              sc (cond
                   ( (getint
                       (strcat
                         "\nWhat is Viewport Scale 1: <"
                         (itoa (setq sc (cond (sc) (50))))
                         ">: "
                       )
                     )
                   )
                   ( sc )
                 )
        )
        (setq ll
          (vlax-for % (vla-get-layouts doc)
            (setq res
              (cons
                (list
                  (vla-get-name %)
                  %
                  (vla-get-TabOrder %)
                )
                res
              )
            )
          )
        )
        (setq ll
          (cdr
            (vl-sort ll
             '(lambda (a b)
                (< (last a) (last b))
              )
            )
          )
        )
        (if (setq sl (cd:DCL_StdListDialog (mapcar ' car ll) 0 "NewViewport" "Select layout:" 40 15 2 nil T T))
          (progn
            (setvar "ctab" (car (nth sl ll)))
            (vla-put-MSpace doc :vlax-false)
            (if (setq vpp (getpoint "\nSelect Point for Viewport: "))
              (progn
                (if
                  (<
                    (car (trans p2 1 0))
                    (car (trans p1 1 0))
                  )
                  (setq tmp p1 p1 p2 p2 tmp)
                )
                (setq mp
                  (list
                     (/ (+ (car p1) (car p2)) 2)
                     (/ (+ (cadr p1) (cadr p2)) 2)
                     0.0
                  )
                )
                (setq vpdoc (vla-get-PaperSpace doc)
                      vp (vla-AddPViewport
                           vpdoc
                           (vlax-3d-point vpp)
                           (abs (/ (- (car p2) (car p1)) sc))
                           (abs (/ (- (cadr p2) (cadr p1)) sc))
                         )
                )
                (vla-display vp :vlax-true)
                (vla-put-MSpace doc :vlax-true)
                (vla-put-ActivePViewport doc vp)
                (vla-ZoomCenter
                  (vlax-get-acad-object)
                  (vlax-3d-point mp)
                  1.0
                )
                (vla-put-CustomScale vp (/ 1. sc))
                (vla-put-MSpace doc :vlax-false)
                (vla-put-DisplayLocked vp :vlax-true)
                (initget "Yes No")
                (setq ans
                  (cond
                    ( (getkword "\nBack to model space [Yes/No] <No>: ") )
                    ( "No" )
                  )
                )
                (if (= ans "Yes") (_RestoreView))
              )
              (progn
                (princ "\n** Invalid Point ** ")
                (if ct (_RestoreView))
              )
            )
          )
          (princ "\n** Layout not selected ** ")
        )
      )
      (princ "\n** Invalid Point ** ")
    )
    (princ "\nStart Program in Model Space ")
  )
  (princ)
)
; =========================================================================================== ;
; Okno dialogowe z lista (list_box) / Dialog control with list (list_box)                     ;
;  Data      - lista do wyswietlenia / list to display                              ;
;  Pos       [INT]     - pozycja poczatkowa na liscie / select list position                  ;
;  Title     [STR/nil] - tytul okna / window title                                            ;
;  ListTitle [STR/nil] - tytul list_box / list_box title                                      ;
;  Width     [INT]     - szerokosc / width                                                    ;
;  Height    [INT]     - wysokosc / height                                                    ;
;  Btns      [0/1/2]   - [cancel/ok/ok_cancel] przyciski / buttons                            ;
;  MSelect   [T/nil]   - dopuszczenie multiple_select / allow multiple select                 ;
;  DPos      [T/nil]   - zapamietanie pozycji okna / save window position                     ;
;  DblClick  [T/nil]   - podwojny klik (wykluczone Cancel) / double click (not for Cancel)    ;
; ------------------------------------------------------------------------------------------- ;
; Zwraca / Return:                                                                            ;
;  nil  = nic nie wybrano (anulowano) / nothing was selected (canceled)                       ;
;  INT  = wybrano jedna pozycje / one position selected  | MSelect = nil                      ;
;  LIST = wybrano kilka pozycji / few positions selected | MSelect = T                        ;
; ------------------------------------------------------------------------------------------- ;
; (cd:DCL_StdListDialog '("A" "B" "C") 0 "Title" "ListTitle:" 40 15 2 nil T nil)              ;
; =========================================================================================== ;
(defun cd:DCL_StdListDialog (Data Pos Title ListTitle Width Height Btns MSelect DPos DblClk
                             / f tmp dc res)
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  (cond
    ( (not
        (and
          (setq f
            (open
              (setq tmp (vl-FileName-MkTemp nil nil ".dcl"))
              "w"
            )
          )
          (foreach %
            (list
              "StdListDialog:dialog{"
              (strcat "label=\""
                (if Title (strcat Title "\";") "\"\";")
              )
              ":list_box{key=\"list\";"
              (if ListTitle
                (strcat "label=\"" ListTitle "\";")""
              )
              "fixed_width=true;fixed_height=true;"
              (strcat "width="
                (if (not Width) "20" (itoa Width))";"
              )
              (strcat "height="
                (if (not Height) "20" (itoa Height))";"
              )
              (if (not DblClck)
                (strcat "multiple_select="
                  (if MSelect "true;" "false;")
                )
                "multiple_select=false;"
              )
              "}"
              (cond
                ( (zerop Btns) "cancel_button;")
                ( (= 1 Btns) "ok_only;")
                (T "ok_cancel;")
              )
              "}"
            )
            (write-line % f)
          )
          (not (close f))
          (< 0 (setq dc (load_dialog tmp)))
          (new_dialog "StdListDialog" dc ""
            (cond
              ( *cd-TempDlgPosition* )
              ( (quote (-1 -1)) )
            )
          )
        )
      )
    )
    ( T     
      (start_list "list")
      (mapcar (quote add_list) Data)
      (end_list)
      (if (not Pos)
        (setq Pos 0)
        (if (> Pos (length Data)) (setq Pos 0))
      )
      (setq res (set_tile "list" (itoa Pos)))
      (action_tile "list"
        (strcat
          "(setq res $value)(if DblClk (if(or(not MSelect)"
          "(not (zerop Btns)))"
          "(if (= $reason 4)(setq "
          "*cd-TempDlgPosition* (done_dialog 1)))))"
        )
      )
      (action_tile "accept" "(setq *cd-TempDlgPosition* (done_dialog 1))")
      (action_tile "cancel" "(setq res nil) (done_dialog 0)")
      (setq res
        (if (= 1 (start_dialog))
          (read (strcat "(" res ")"))
          nil
        )
      )         
    )
  )
  (if (< 0 dc) (unload_dialog dc))
  (if (setq tmp (findfile tmp)) (vl-File-Delete tmp))
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  (if res (if (= 1 (length res)) (car res) res))
)
(princ "\n Type NV to Invoke ")
(princ)
« Last Edit: June 22, 2014, 09:54:32 AM by CAB »

luisternou

  • Newt
  • Posts: 32
Re: Lisp to Create viewport
« Reply #24 on: June 21, 2014, 06:03:35 PM »
Anybody?  :roll:

luisternou

  • Newt
  • Posts: 32
Re: Lisp to Create viewport
« Reply #25 on: June 21, 2014, 06:05:02 PM »
......much appreciated!!!  :-)

luisternou

  • Newt
  • Posts: 32
Re: Lisp to Create viewport
« Reply #26 on: June 21, 2014, 06:20:52 PM »
....the solution is near! See topic:
http://www.theswamp.org/index.php?topic=47145.0;all
Big thanks to Roy_43!!

luisternou

  • Newt
  • Posts: 32
Re: Lisp to Create viewport
« Reply #27 on: April 23, 2015, 12:45:20 PM »
....is there someone to help? Thanks in advance!!!!  :-)

kruuger

  • Swamp Rat
  • Posts: 621
Re: Lisp to Create viewport
« Reply #28 on: April 24, 2015, 04:21:22 AM »
....is there someone to help? Thanks in advance!!!!  :)
check this tool. also in english.
http://forum.cad.pl/viewportmaster-mened-er-rzutni-t84275.html
kruuger

luisternou

  • Newt
  • Posts: 32
Re: Lisp to Create viewport
« Reply #29 on: May 01, 2015, 06:39:11 AM »
Thanks Kruuger for the tip! Sorry for the late respond! This could be more then I expected!  :-)

ahsattarian

  • Newt
  • Posts: 94
Re: Lisp to Create viewport
« Reply #30 on: September 20, 2021, 06:49:03 AM »

ahsattarian

  • Newt
  • Posts: 94
Re: Lisp to Create viewport
« Reply #31 on: September 20, 2021, 06:57:03 AM »
And This May Help U  :


Code - Auto/Visual Lisp: [Select]
  1. (defun c:a ()
  2.   (defun sub1 ()
  3.     (setq method2 2) ;|  #zoom  |;
  4.     (cond
  5.       ((= method2 1) (command "zoom" p1 p2 "zoom" (strcat (rtos sc) "x")))
  6.       ((= method2 2) (command "zoom" "c" pm (/ dy sc)))
  7.     )
  8.   )
  9.   (setq fuzzy 0.0001)
  10.   (setvar "tilemode" 1)
  11.   (setq s (car (entsel " Select Object : ")))
  12.   (redraw s 4)
  13.   (setq bbox (acet-ent-geomextents s)) ;|  #bounding box  |;
  14.   (setq p1 (car bbox))
  15.   (setq p2 (cadr bbox))
  16.   (setq pm (acet-geom-midpoint p1 p2))
  17.   (setq dx (abs (- (car p2) (car p1))))
  18.   (setq dy (abs (- (cadr p2) (cadr p1))))
  19.   (cond ((or (equal dx 0.0 fuzzy) (equal dy 0.0 fuzzy)) (print " ERROR !! ") (exit)))
  20.   (setvar "tilemode" 0)
  21.   ;;(setq sc 0.9)
  22.   (setq sc 1.0)
  23.   (setq method1 2)
  24.   (cond
  25.     ((= method1 1)
  26.      (command "pspace")
  27.      (sub1)
  28.      (setq method3 2)
  29.      (cond
  30.        ((= method3 1) (command "vports"))
  31.        ((= method3 2) (command "mview")) ;|  #mview  |;
  32.      )
  33.      (command p1 p2)
  34.      (command "mview" "on" "last" "")
  35.      (command "mview" "lock" "off" "last" "")
  36.      (command "mspace")
  37.      (setvar "cvport" (cdr (assoc 69 (entget (entlast))))) ;|  #cvport  |;
  38.      (sub1)
  39.      (command "regen")
  40.      (command "pspace")
  41.      (command "mview" "lock" "on" "last" "")
  42.     )
  43.     ((= method1 2)
  44.      (vla-put-mspace doc :vlax-false) ;|  #pspace  |;
  45.      (vla-zoomcenter (vlax-get-acad-object) (vlax-3d-point pm) (/ dy sc)) ;|  #zoom  |;
  46.      (setq obj (vla-addpviewport (vla-get-paperspace doc) (vlax-3d-point pm) dx dy))
  47.      (vla-display obj :vlax-true)
  48.      (vla-put-displaylocked obj :vlax-false)
  49.      (vla-put-mspace doc :vlax-true) ;|  #mspace  |;
  50.      (vla-put-activepviewport doc obj) ;|  #cvport  |;
  51.      (vla-zoomcenter (vlax-get-acad-object) (vlax-3d-point pm) (/ dy sc)) ;|  #zoom  |;
  52.      (vla-put-mspace doc :vlax-false) ;|  #pspace  |;
  53.      (vla-put-displaylocked obj :vlax-true)
  54.     )
  55.   )
  56.   (princ)
  57. )