[pinjener]

Господа,буду объяснять своими словами. Есть видовой экран,в нем есть таблица(в модели),как её присоединить к углу ВЭ.

[Хмурый]

нарисовал прямоугольник поверх видового экрана. переместил прямоуголник в нужную точку. переместил углы видового экрана к углам прямоугольника. удалил прямоугольник. Видовой экран переместил на старое место

[Nike]

Программа создает в модели рамку по контуру выбранного ВЭ

Код:

[Выделить все]

(defun C:VPL (/ ss1 ss2 ss3 zzz PolObj PntArr VptObj XofSet YofSet VptCen PntArr)
 
  (setq ss1 (ssget '((0 . "VIEWPORT"))))
  (setq ss2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
 
  (foreach vp ss2
    (progn
      (vl-cmdf "_.MSPACE")
      (vla-put-activepviewport
        (vla-get-activedocument (vlax-get-acad-object))
        (vlax-ename->vla-object Vp)
      ) ;_ end of vla-put-ActivePViewport
      (vl-cmdf "_.PSPACE")
      (if
        (assoc 340 (entget vp))
         (progn
           (setq zzz nil)
           (setq ss3 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (cdr (assoc 340 (entget vp)))))))
           (foreach pt ss3 (setq zzz (append zzz (trans pt 3 2))))
           (setq PntArr (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length zzz)))))
           (vlax-safearray-fill PntArr zzz)
           (setq PolObj (vla-addpolyline
                          (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
                          PntArr
                        ) ;_ end of vla-AddPolyline
                 PolObj (vla-put-closed PolObj :vlax-true)
 
           ) ;_ end of setq
         ) ;_ end_of_progn
 
         (progn
           (setq VptObj (vlax-ename->vla-object Vp)
                 XofSet (/ (vla-get-width VptObj) 2.0)
                 YofSet (/ (vla-get-height VptObj) 2.0)
                 VptCen (vlax-get VptObj 'Center)
                 PntArr (vlax-make-safearray vlax-vbdouble '(0 . 11))
           ) ;_ end_of_setq
 
           (vlax-safearray-fill
             PntArr
             (append
               (trans (list (- (car VptCen) XofSet) (- (cadr VptCen) YofSet)) 3 2)
               (trans (list (+ (car VptCen) XofSet) (- (cadr VptCen) YofSet)) 3 2)
               (trans (list (+ (car VptCen) XofSet) (+ (cadr VptCen) YofSet)) 3 2)
               (trans (list (- (car VptCen) XofSet) (+ (cadr VptCen) YofSet)) 3 2)
             ) ;_ end of append
           ) ;_ end of vlax-safearray-fill
           (setq PolObj (vla-addpolyline
                          (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
                          PntArr
                        ) ;_ end of vla-AddPolyline
                 PolObj (vla-put-closed PolObj :vlax-true)
           ) ;_ end of setq
           (vlax-release-object VptObj)
         ) ;_ end_of_progn
      ) ;_ end_of_if
    ) ;_ end of progn
  ) ;_ end_of_foreach
  (princ)
) ;_end_of_defun

[РВН]

К сожалению эта команда не работает . Пишет: Команда: ; ошибка: no function definition: VLAX-GET-ACAD-OBJECT
Что делать, как исправить?

[Nike]

(vla-load-com) второй строкой добавить, наверное

[РВН]

Теперь пишет : Команда: VPL
; ошибка: no function definition: VLA-LOAD-COM

[Nike]

(vl-load-com), пардон

[Do$]

А потом объекты модели подгонять под ВЭ?
Не извращайтесь, делайте лучше как Хмурый сказал (#2)

[Nike]

ну да, чего-то я не того втюхивал

Эта программа создаст в листе ВЭ по области, заданной в модели:

Код:

[Выделить все]

;;;CADALYST 06/06  Tip2126:  vplo.lsp  Viewport Layouts   (c) 2006 Phil Tingsley 
 
(DEFUN c:мздщ (/) (c:vplo))
(defun c:vplo (/ vpl vplyes l0 ln layers cp cl cs ofs vpc1 vpc2 vpxd vpyd vpc svpc ssvp ssvp1 sf lpno vpno ssnum vpent nvpc1 nvpc2 nvpc1x nvpc1y nvpc2x nvpc2y)
    ; Creates layout of Paper Space viewports of specified 2D orthagonal views from Model Space
    ; Used when all 2D design is done in Model Space at full scale and all dimensioning is done in Paper Space as associated scale
    ; Start command from destination layout tab
    ; Program will switch to Model Space for selection of desired objects
    ; Program will return to layout tab for creation of viewport frames
    ; First a single viewport is made that includes all relevant views of desired part at the desired zoom level
    ; The single viewport is copied over itself the number of desired separate views
    ; Then the overlaying viewports are individually clipped to the edges of the separate views
    ; The separate views will maintain their original orientation and alignment
    ; The separate views can be rectangular by specifying opposite corners or circular by specifying a center and radius
    ; Afterwards move the individual views orthogonally, if needed, to allow space for dimensions
  (setvar "cmdecho" 0) ; Turn off command line echoing
  (setq cp (getvar "ctab")) ; Store current tab name
  (setq cl (getvar "clayer")) ; Store current layer name
  (setq cs (getvar "osmode")) ; Store current osnap mode
  (setq vpl "-SB-Viewport") ; ==>> Assume using Viewport layer for viewport frames, change code value here if needed <<==
  (setq ofs 0.125) ; ==>> Set viewport border offset from actual detail, change code value here if needed <<==
  (setvar "osmode" 2559) ; Turn osnap on
  (if (/= cp "Model") ; Must be started from a layout tab to establish destination, quit quietly if on Model tab
    (progn
      (princ "\n") ; Clean up command line
      (setq vplyes 0) ; Assume viewport doesn't exist
      (setq l0 (tblnext "LAYER" 1)) ; Get past 0 layer in layer list
      (while (setq layers (tblnext "LAYER")) ; Loop through layer list collection
        (setq ln (cdr (assoc 2 layers))) ; Extract layer name from list
        (if (= (strcase ln) (strcase vpl)) (setq vplyes 1)) ; Check if viewport layer exists
      )
      (if (= vplyes 0) (command "_layer" "_NEW" vpl "_COLOR" "_MAGENTA" vpl "")) ; Make viewport layer and assign color to magenta if doesn't exist
      (command "_-layer" "_p" "_n" vpl "") ; не печатать слой
      (setvar "clayer" vpl) ; Change to viewport layer
      (command "_layer" "_ON" (strcat "0," vpl) "_UNLOCK" (strcat "0," vpl) "") ; Turn on and unlock viewport and 0 layer
      (command "_zoom" "_ALL") ; View entire layout tab
      (setvar "ctab" "Model") ; Activate Model tab
      (command "_zoom" "_ALL") ; View entire Model Space area
      (setq vpc1 (getpoint "\nSpecify first corner of model space window area: ")) ; Just pick rough area including all relavent details, will fine-tune border area later in Paper Space
      (if vpc1 ; Quietly quit if no point specified
    (progn
          (setq vpc2 (getcorner vpc1 "\nSpecify opposite corner of model space window area: ")) ; Window rectangle can be designated in any direction
          (if vpc2 ; Quietly quit if no point specified
        (progn
              (princ "\n") ; Clean up command line
              (setvar "ctab" cp) ; Return to layout tab program was started from
              (command "_pspace") ; Switch to Paper Space of layout tab
              (setq svpc (getpoint "\nSpecify destination of paper space viewport center: ")) ; Can't change layout tabs manually here
          (if svpc ; Quietly quit if no point specified
        (progn
          (setq sf (getreal "\nViewport zoom scale factor <1.0>: ")) ; Default to full-scale if no value is inputted
          (if (= sf nil) (setq sf 1.0) (setq sf (abs sf))) ; Make sure scale factor is positive number
                  (setq vpxd (* sf (abs (- (car vpc2) (car vpc1))))) ; Determine horizontal length of selected window
                  (setq vpyd (* sf (abs (- (cadr vpc2) (cadr vpc1))))) ; Determine vertical height of selected window
                  (setq vpc (list (/ (+ (car vpc1) (car vpc2)) 2.0) (/ (+ (cadr vpc1) (cadr vpc2)) 2.0) 0.0)) ; Determine center point of selected model window
                  (command "_mview" (list (- (car svpc) (/ vpxd 2.0)) (- (cadr svpc) (/ vpyd 2.0))) (strcat "@" (rtos vpxd) "," (rtos vpyd))) ; Create Paper Space viewport
                  (setq ssvp (ssget "_L")) ; Start selection set with last viewport frame
          (setq ssvp1 (ssget "_L")) ; Another copy of viewport frame selection set
                  (command "_mspace") ; Open viewport window to Model Space
                  (command "_ucsicon" "_ON") ; Turn on UCS icon for viewport
                  (command "_ucs" "_WORLD") ; Reset UCS to WCS
                  (command "_zoom" "_C" vpc (rtos vpyd)) ; Center view of viewport window using determined point
;;;                  (command "_zoom" "_SCALE" (strcat (rtos sf) "XP")) ; Set zoom scale of viewport window
;;;          (command "_vports" "_LOCK" "_ON" ssvp "") ; Lock scale and position of model in viewport
                  (command "_pspace") ; Close viewport window
          (command "_zoom" (list (- (car svpc) (/ vpxd 2.0)) (- (cadr svpc) (/ vpyd 2.0))) (strcat "@" (rtos vpxd) "," (rtos vpyd))) ; Zoom in on just created viewport extremes
          (command "_zoom" "0.95X") ; Back zoom off slightly to see edges clearly
                  (setq lpno 2) ; Loop counter for making separate viewports
                  (setq vpno (getint "\nNumber of separate viewports to make from this viewport <1>: ")) ; Will divide single viewport into separate viewports for othagonal views of 2D part
                  (if (>= vpno 2) ; Proceed to copy current viewport if 2 or more separate viewports desired
                    (progn
                      (while (<= lpno vpno) ; Check if viewport loop counter less than number of viewports desired
                        (command "_copy" ssvp "" "0,0" "@0,0") ; Make copy of new viewport laying exactly on top of first viewport
                        (setq lpno (1+ lpno)) ; Increment viewport loop counter
            (ssadd (entlast) ssvp1) ; Add viewport copy to selection set
              )
            )
          )
                  (setq ssnum 0) ; Loop counter for fine-tuning separate viewports
                  (while (< ssnum (sslength ssvp1)) ; Opportunity to fine-tune each separate viewport border
            (setq vpent (ssname ssvp1 ssnum)) ; Get entity name of next viewport in selection set
            (if (>= vpno 2) ; Check for multiple viewports
              (setq clt (strcat " #" (rtos (+ ssnum 1) 2 0))) ; Make command prompt string if using multiple viewports
              (setq clt "") ; Make command prompt string if using single viewport
            )
                    (initget 128) ; Enable string responses from point prompt
            (setq nvpc1 (getpoint (strcat "\nSpecify first corner of viewport" clt " window area or [Center point of circle]: "))) ; Pick actual part corner, program will apply offset
            (if nvpc1 ; Will repeat asking for first corner if none specified
              (progn
                        (if (= 'STR (type nvpc1)) ; Check if string was inputted instead of corner point
                          (progn
                            (if (= "C" (strcase (substr nvpc1 1 1))) ; Check if asking for circular viewport area
                  (progn
                (setq nvpc1 (getpoint (strcat "\nSpecify center of viewport" clt " window area: "))) ; Pick center of separate circular viewport window
                (if nvpc1 ; Will return to asking for first corner if center not specified
                  (progn
                                    (setvar "osmode" 0) ; Turn osnap off
                    (princ (strcat "\nSpecify radius of viewport" clt " window area: ")) ; Make command prompt for circle viewport
                    (command "_circle" nvpc1 pause) ; Make circle to clip existing viewport
                        (setvar "osmode" 2559) ; Turn osnap on
                        (setq ssvp (ssget "_L")) ; Select last circle
                        (command "_vpclip" vpent ssvp) ; Clip existing viewport to circle
                        (setq ssnum (1+ ssnum)) ; Increment fine-tuned viewport loop counter
                  )
                )
                  )
                )
              )
              (progn
                (setq nvpc2 (getcorner nvpc1 (strcat "\nSpecify opposite corner of viewport" clt " window area: "))) ; Window rectangle can be designated in any direction, pick actual part corner, program will apply offset
                (if nvpc2 ; Will repeat asking for first corner if none specified
                  (progn
                                (setq nvpc1x (car nvpc1)) ; Find X portion of first corner
                                (setq nvpc1y (cadr nvpc1)) ; Find Y portion of first corner
                            (setq nvpc2x (car nvpc2)) ; Find X portion of second corner
                                (setq nvpc2y (cadr nvpc2)) ; Find Y portion of second corner
                    (if (> nvpc2x nvpc1x) ; Determine horizontal direction of viewport window rectangle
                        (progn
                        (setq nvpc2x (+ nvpc2x ofs)) ; Add horizontal offset to right of specified left-to-right window rectangle
                        (setq nvpc1x (- nvpc1x ofs)) ; Add horizontal offset to left of specified left-to-right window rectangle
                      )
                      (progn
                          (setq nvpc2x (- nvpc2x ofs)) ; Add horizontal offset to left of specified right-to-left window rectangle
                        (setq nvpc1x (+ nvpc1x ofs)) ; Add horizontal offset to right of specified right-to-left window rectangle
                      )
                    )
                    (if (> nvpc2y nvpc1y) ; Determine vertical direction of viewport window rectangle
                       (progn
                        (setq nvpc2y (+ nvpc2y ofs)) ; Add vertical offset to top of specified lower-to-upper window rectangle
                        (setq nvpc1y (- nvpc1y ofs)) ; Add vertical offset to bottom of specified lower-to-upper window rectangle
                      )
                      (progn
                        (setq nvpc2y (- nvpc2y ofs)) ; Add vertical offset to bottom of specified upper-to-lower window rectangle
                        (setq nvpc1y (+ nvpc1y ofs)) ; Add vertical offset to top of specified upper-to-lower window rectangle
                      )
                    )
                    (setvar "osmode" 0) ; Turn osnap off
                    (command "_rectang" (list nvpc1x nvpc1y) (list nvpc2x nvpc2y)) ; Make rectangle with offset to clip existing viewport
                    (setvar "osmode" 2559) ; Turn osnap on
                    (setq ssvp (ssget "_L")) ; Select last rectange
                    (command "_vpclip" vpent ssvp) ; Clip existing viewport to rectangle
                    (setq ssnum (1+ ssnum)) ; Increment fine-tuned viewport loop counter
                  )
                )
              )
            )
                  )
            )
          )
                )  
              )
            )
      )
    )
      )
    )
    (princ "\nThis command must be started from a layout sheet!") ; Need to start on a layout tab so program knows where to create the new viewports
  )
  (setvar "ctab" cp) ; Reset to stored tab name
  (setvar "clayer" cl) ; Reset to stored layer name
  (setvar "osmode" cs) ; Reset to stored osnap mode
  (setvar "cmdecho" 1) ; Turn on command line echoing
  (princ) ; Clean up and exit
)

[РВН]

Да, но если двигать ВЭ, то он перемещается, а чертеж обрезается как-будто остается на месте. Это по поводу перемещения по точкам видовой экран.
А вообще у меня автоматом создается ВЭ в листе, вместе с рамкой. Остается только в него вписать чертеж с определенным(требуемым) масштабом. Или переместить часть модели к углу ВЭ на листе, чтоб определенная точка попала в угол ВЭ.