| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Начертить контур видового экрана в пространстве модели

Начертить контур видового экрана в пространстве модели

Ответ
Поиск в этой теме
Непрочитано 20.10.2017, 07:56 #1
Начертить контур видового экрана в пространстве модели
olga87
 
Регистрация: 28.05.2007
Сообщений: 207

Здравствуйте Уважаемые программисты!
Подскажите пожалуйста как исправить код (lisp cad2007), чтобы он работал c видовым экраном "кругом" (т.е. в пространстве Листа нарисован круг и преобразован в видовой экран). Сейчас код выдает ошибку: Error: неверный тип аргумента: lentityp nil. Другими словами, код работает только с полилиниями.
Заранее спасибо!

Код:
[Выделить все]
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2015  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;

(vl-load-com)
(defun c:vpo ( / *error* cen dpr ent lst ocs ofe off tmp vpe vpt )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (setq

;;----------------------------------------------------------------------;;
;;                          Program Parameters                          ;;
;;----------------------------------------------------------------------;;

        ;; Optional Interior Offset
        ;; Set this parameter to nil or 0.0 for no offset
        off 0.0

        ;; Default Polyline Properties
        ;; Omitted properties will use current settings when the program is run
        dpr
       '(
            (006 . "BYLAYER")   ;; Linetype (must be loaded)
           ;(008 . "VPOutline") ;; Layer (automatically created if not present in drawing)
            (039 . 0.0)         ;; Thickness
            (048 . 1.0)         ;; Linetype Scale
            (062 . 256)         ;; Colour (0 = ByBlock, 256 = ByLayer)
            (370 . -1)          ;; Lineweight (-1 = ByLayer, -2 = ByBlock, -3 = Default, 0.3 = 30 etc.)
        )
        
;;----------------------------------------------------------------------;;

    )
    
    (LM:startundo (LM:acdoc))
    (cond
        (   (/= 1 (getvar 'cvport))
            (princ "\nCommand not available in Modelspace.")
        )
        (   (setq vpt (LM:ssget "\nSelect viewport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
            (setq vpt (entget (ssname vpt 0)))
            (if (setq ent (cdr (assoc 340 vpt)))
                (setq lst (vpo:polyvertices ent))
                (setq cen (mapcar 'list (cdr (assoc 10 vpt))
                              (list
                                  (/ (cdr (assoc 40 vpt)) 2.0)
                                  (/ (cdr (assoc 41 vpt)) 2.0)
                              )
                          )
                      lst (mapcar
                             '(lambda ( a ) (cons (mapcar 'apply a cen) '(42 . 0.0)))
                             '((- -) (+ -) (+ +) (- +))
                          )
                )
            )
            (if (not (LM:listclockwise-p (mapcar 'car lst)))
                (setq lst (reverse (mapcar '(lambda ( a b ) (cons (car a) (cons 42 (- (cddr b))))) lst (cons (last lst) lst))))
            )
            (if (and (numberp off) (not (equal 0.0 off 1e-8)))
                (cond
                    (   (null
                            (setq tmp
                                (entmakex
                                    (append
                                        (list
                                           '(000 . "LWPOLYLINE")
                                           '(100 . "AcDbEntity")
                                           '(100 . "AcDbPolyline")
                                            (cons 90 (length lst))
                                           '(070 . 1)
                                        )
                                        (apply 'append (mapcar '(lambda ( x ) (list (cons 10 (car x)) (cdr x))) lst))
                                    )
                                )
                            )
                        )
                        (princ "\nUnable to generate Paperspace outline for offset.")
                    )
                    (   (vl-catch-all-error-p (setq ofe (vl-catch-all-apply 'vlax-invoke (list (vlax-ename->vla-object tmp) 'offset off))))
                        (princ (strcat "\nViewport dimensions too small to offset outline by " (rtos off) " units."))
                        (entdel tmp)
                    )
                    (   (setq ofe (vlax-vla-object->ename (car ofe))
                              lst (vpo:polyvertices ofe)
                        )
                        (entdel ofe)
                        (entdel tmp)
                    )
            	)
            )
            (setq vpe (cdr (assoc -1 vpt))
                  ocs (cdr (assoc 16 vpt))
            )
            (entmakex
                (append
                    (list
                       '(000 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbPolyline")
                        (cons 90 (length lst))
                       '(070 . 1)
                       '(410 . "Model")
                    )
                    (if (and (setq ltp (assoc 6 dpr)) (not (tblsearch "ltype" (cdr ltp))))
                        (progn
                            (princ  (strcat "\n\"" (cdr ltp) "\" linetype not loaded - linetype set to \"ByLayer\"."))
                            (subst '(6 . "BYLAYER") ltp dpr)
                        )
                        dpr
                    )
                    (apply 'append (mapcar '(lambda ( x ) (list (cons 10 (trans (pcs2wcs (car x) vpe) 0 ocs)) (cdr x))) lst))
                    (list (cons 210 ocs))
                )
            )
        )
    )
    (LM:endundo (LM:acdoc))
    (princ)
)

(defun vpo:polyvertices ( ent )
    (apply '(lambda ( foo bar ) (foo bar))
        (if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
            (list
                (lambda ( enx )
                    (if (setq enx (member (assoc 10 enx) enx))
                        (cons (cons  (cdr (assoc 10 enx)) (assoc 42 enx)) (foo (cdr enx)))
                    )
                )
                (entget ent)
            )
            (list
                (lambda ( ent / enx )
                    (if (= "VERTEX" (cdr (assoc 0 (setq enx (entget ent)))))
                        (cons (cons (cdr (assoc 10 enx)) (assoc 42 enx)) (foo (entnext ent)))
                    )
            	)
                (entnext ent)
            )
        )
    )
)

;; List Clockwise-p  -  Lee Mac
;; Returns T if the point list is clockwise oriented

(defun LM:listclockwise-p ( lst )
    (minusp
        (apply '+
            (mapcar
                (function
                    (lambda ( a b )
                        (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                    )
                )
                lst (cons (last lst) lst)
            )
        )
    )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; PCS2WCS (gile)
;; Translates a PCS point to WCS based on the supplied Viewport
;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active
;; pnt : PCS point
;; ent : Viewport ename

(defun PCS2WCS ( pnt ent / ang enx mat nor scl )
    (setq pnt (trans pnt 0 0)
          enx (entget ent)
          ang (- (cdr (assoc 51 enx)))
          nor (cdr (assoc 16 enx))
          scl (/ (cdr (assoc 45 enx)) (cdr (assoc 41 enx)))
          mat (mxm
                  (mapcar (function (lambda ( v ) (trans v 0 nor t)))
                     '(   (1.0 0.0 0.0)
                          (0.0 1.0 0.0)
                          (0.0 0.0 1.0)
                      )
                  )
                  (list
                      (list (cos ang) (- (sin ang)) 0.0)
                      (list (sin ang)    (cos ang)  0.0)
                     '(0.0 0.0 1.0)
                  )
              )
    )
    (mapcar '+
        (mxv mat
            (mapcar '+
                (vxs pnt scl)
                (vxs (cdr (assoc 10 enx)) (- scl))
                (cdr (assoc 12 enx))
            )
        )
        (cdr (assoc 17 enx))
    )
)

;; Matrix Transpose  -  Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m )
    (apply 'mapcar (cons 'list m))
)

;; Matrix x Matrix  -  Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
    ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Vector x Scalar  -  Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
    (mapcar '(lambda ( n ) (* n s)) v)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

;;----------------------------------------------------------------------;;

(princ
    (strcat
        "\n:: VPOutline.lsp | Version 1.2 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type \"vpo\" to Invoke ::"
    )
)
(princ)

Последний раз редактировалось olga87, 20.10.2017 в 08:03.
Просмотров: 4641
 
Непрочитано 20.10.2017, 12:09
#2
Enik

ГИП
 
Регистрация: 07.06.2015
Сообщений: 1,254


А превратить круг в полилинию не пробовали?
Enik вне форума  
 
Непрочитано 20.10.2017, 12:52
#3
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,002


Или воспользоваться поиском - недавно совсем та же тема поднималась.
Сергей812 вне форума  
 
Непрочитано 22.10.2017, 08:40
#4
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от olga87 Посмотреть сообщение
чтобы он работал c видовым экраном "кругом"
Цитата:
Сообщение от olga87 Посмотреть сообщение
Другими словами, код работает только с полилиниями
Цитата:
Сообщение от Enik Посмотреть сообщение
А превратить круг в полилинию не пробовали?
Circles to LWPolylines
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 22.10.2017, 22:40
#5
olga87


 
Регистрация: 28.05.2007
Сообщений: 207


Цитата:
Сообщение от VVA Посмотреть сообщение
Подскажите пожалуйста, как прописать в исходном коде: после выбора видового экрана делать проверку типа объекта, и если это Круг - то прежде преобразовать в Полилинию, и далее продолжить код?
Заранее спасибо!
olga87 вне форума  
 
Непрочитано 26.10.2017, 18:07
#6
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от olga87 Посмотреть сообщение
Подскажите пожалуйста, как прописать в исходном коде: после выбора видового экрана делать проверку типа объекта, и если это Круг - то прежде преобразовать в Полилинию, и далее продолжить код?
Код:
[Выделить все]
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2015  -  www.lee-mac.com              ;;
;;  2017-10-26 VVA
;;----------------------------------------------------------------------;;

(vl-load-com)
(defun c:vpo ( / *error* cen dpr ent lst ocs ofe off tmp vpe vpt )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (setq

;;----------------------------------------------------------------------;;
;;                          Program Parameters                          ;;
;;----------------------------------------------------------------------;;

        ;; Optional Interior Offset
        ;; Set this parameter to nil or 0.0 for no offset
        off 0.0

        ;; Default Polyline Properties
        ;; Omitted properties will use current settings when the program is run
        dpr
       '(
            (006 . "BYLAYER")   ;; Linetype (must be loaded)
           ;(008 . "VPOutline") ;; Layer (automatically created if not present in drawing)
            (039 . 0.0)         ;; Thickness
            (048 . 1.0)         ;; Linetype Scale
            (062 . 256)         ;; Colour (0 = ByBlock, 256 = ByLayer)
            (370 . -1)          ;; Lineweight (-1 = ByLayer, -2 = ByBlock, -3 = Default, 0.3 = 30 etc.)
        )
        
;;----------------------------------------------------------------------;;

    )
    
    (LM:startundo (LM:acdoc))
    (cond
        (   (/= 1 (getvar 'cvport))
            (princ "\nCommand not available in Modelspace.")
        )
        (   (setq vpt (LM:ssget "\nSelect viewport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
            (setq vpt (entget (ssname vpt 0)))
            (if (setq ent (cdr (assoc 340 vpt)))
              (progn
                ;;; VVA 2017-10-26 BEGIN
                ;;;Ïðîâåðêà ÷òî ýòî çà îáúåêò
                (cond
                  ((eq (cdr(assoc 0 (entget ent))) "CIRCLE") ;_ Êðóã
                   (setq lst (mapcar '(lambda(x)(mapcar '+ x '(0 0)))(vpo:circle2polygon ent 32))) ;_32 ìíîãîóãîëüíèê
                   (setq tmp (entmakelwpline lst 1 0 (caddr (trans '(0 0 0) 1 (ucszdir))) (ucszdir) nil))
                   (setvar "EXPERT" 5)
                   (if command-s
                     (command-s  "_vpclip" (cdr (assoc -1 vpt)) tmp)
                     (command  "_vpclip" (cdr (assoc -1 vpt)) tmp)
                     )
                   (entdel ent)
                   (setq ent (cdr (assoc 340 (entget(cdr(assoc -1 vpt))))))
                   )
                  (t nil)
                  )
                 ;;; VVA 2017-10-26 END
                (setq lst (vpo:polyvertices ent))
                )
                (setq cen (mapcar 'list (cdr (assoc 10 vpt))
                              (list
                                  (/ (cdr (assoc 40 vpt)) 2.0)
                                  (/ (cdr (assoc 41 vpt)) 2.0)
                              )
                          )
                      lst (mapcar
                             '(lambda ( a ) (cons (mapcar 'apply a cen) '(42 . 0.0)))
                             '((- -) (+ -) (+ +) (- +))
                          )
                )
            )
            (if (not (LM:listclockwise-p (mapcar 'car lst)))
                (setq lst (reverse (mapcar '(lambda ( a b ) (cons (car a) (cons 42 (- (cddr b))))) lst (cons (last lst) lst))))
            )
            (if (and (numberp off) (not (equal 0.0 off 1e-8)))
                (cond
                    (   (null
                            (setq tmp
                                (entmakex
                                    (append
                                        (list
                                           '(000 . "LWPOLYLINE")
                                           '(100 . "AcDbEntity")
                                           '(100 . "AcDbPolyline")
                                            (cons 90 (length lst))
                                           '(070 . 1)
                                        )
                                        (apply 'append (mapcar '(lambda ( x ) (list (cons 10 (car x)) (cdr x))) lst))
                                    )
                                )
                            )
                        )
                        (princ "\nUnable to generate Paperspace outline for offset.")
                    )
                    (   (vl-catch-all-error-p (setq ofe (vl-catch-all-apply 'vlax-invoke (list (vlax-ename->vla-object tmp) 'offset off))))
                        (princ (strcat "\nViewport dimensions too small to offset outline by " (rtos off) " units."))
                        (entdel tmp)
                    )
                    (   (setq ofe (vlax-vla-object->ename (car ofe))
                              lst (vpo:polyvertices ofe)
                        )
                        (entdel ofe)
                        (entdel tmp)
                    )
            	)
            )
            (setq vpe (cdr (assoc -1 vpt))
                  ocs (cdr (assoc 16 vpt))
            )
            (if (not(tblsearch "LAYER" "ViewportToModel"))
              (entmakeLayer "ViewportToModel" 5 "Continuous" 60 0)
              )
         (if
            (setq *VPT*
            (entmakex
                (append
                    (list
                       '(0 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbPolyline")
                        (cons 90 (length lst))
                       '(8 . "ViewportToModel")
                       '(70 . 1)
                       '(410 . "Model")
                    )
                    (if (and (setq ltp (assoc 6 dpr)) (not (tblsearch "ltype" (cdr ltp))))
                        (progn
                            (princ  (strcat "\n\"" (cdr ltp) "\" linetype not loaded - linetype set to \"ByLayer\"."))
                            (subst '(6 . "BYLAYER") ltp dpr)
                        )
                        dpr
                    )
                    (apply 'append (mapcar '(lambda ( x ) (list (cons 10 (trans (pcs2wcs (car x) vpe) 0 ocs)) (cdr x))) lst))
                    (list (cons 210 ocs))
                )
            )
                  )
           (progn
             (eval(read "(defun C:ZVPO nil(command \"_regenall\")(command \"_.ZOOM\" \"_o\" *VPT* \"\"))"))
             (princ "\nCommand ZVRO defined. Type ZVPO in command line to zoom to VPOutline")
             )
           )
        )
    )
    (LM:endundo (LM:acdoc))
    (princ)
)
(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acallviewports)
(defun vpo:polyvertices ( ent )
    (apply '(lambda ( foo bar ) (foo bar))
        (if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
            (list
                (lambda ( enx )
                    (if (setq enx (member (assoc 10 enx) enx))
                        (cons (cons  (cdr (assoc 10 enx)) (assoc 42 enx)) (foo (cdr enx)))
                    )
                )
                (entget ent)
            )
            (list
                (lambda ( ent / enx )
                    (if (= "VERTEX" (cdr (assoc 0 (setq enx (entget ent)))))
                        (cons (cons (cdr (assoc 10 enx)) (assoc 42 enx)) (foo (entnext ent)))
                    )
            	)
                (entnext ent)
            )
        )
    )
)
(defun entmakeLayer (Nme Col Ltyp LWgt Plt)
  (entmake (list (cons 0 "LAYER")
                 (cons 100 "AcDbSymbolTableRecord")
                 (cons 100 "AcDbLayerTableRecord")
                 (cons 2  Nme)
                 (cons 70 0)
                 (cons 62 Col)
                 (cons 6 Ltyp)
                 (cons 290 Plt)
                 (cons 370 LWgt))))
(defun entmakelwpline (plist flag width Elev ucszdir space)
  (entmakex
    (append
      (list
	'(0 . "LWPOLYLINE" )
	'(100 . "AcDbEntity" )
	(cons 8 (getvar "CLAYER"))
	'(100 . "AcDbPolyline" )
        (if space (cons 410 space)(cons 410 (getvar "CTAB")))
	(cons 90 (length plist))	;÷èñëî âåðøèí
	(cons 70 flag)			; ôëàã çàìêíóòîñòè
	(cons 43 width)			;øèðèíà ïîëèëèíèè
        (cons 38 Elev)                  ;óðîâåíü
      )
      (mapcar '(lambda (x) (cons 10 x)) plist)
      (list(cons 210 ucszdir))
    )
  )
)
(defun ucszdir ()(trans '(0 0 1) 1 0 T))
(defun vpo:circle2polygon ( ent seg / increment center radius num plist pangle)
  ;;; ent - ename
  ;;; seg - number of segments to create polygon
  (setq increment (/ (* pi 2) seg)
        center (cdr (assoc 10 (entget ent)))
        radius (cdr (assoc 40 (entget ent)))
        num 0
        pangle increment
        )
  (while (<= num seg)
       (setq num (1+ num)
             plist (append plist (list (polar center pangle radius)))
             pangle (+ pangle increment))
      )
  plist
  )

;; List Clockwise-p  -  Lee Mac
;; Returns T if the point list is clockwise oriented

(defun LM:listclockwise-p ( lst )
    (minusp
        (apply '+
            (mapcar
                (function
                    (lambda ( a b )
                        (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                    )
                )
                lst (cons (last lst) lst)
            )
        )
    )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; PCS2WCS (gile)
;; Translates a PCS point to WCS based on the supplied Viewport
;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active
;; pnt : PCS point
;; ent : Viewport ename

(defun PCS2WCS ( pnt ent / ang enx mat nor scl )
    (setq pnt (trans pnt 0 0)
          enx (entget ent)
          ang (- (cdr (assoc 51 enx)))
          nor (cdr (assoc 16 enx))
          scl (/ (cdr (assoc 45 enx)) (cdr (assoc 41 enx)))
          mat (mxm
                  (mapcar (function (lambda ( v ) (trans v 0 nor t)))
                     '(   (1.0 0.0 0.0)
                          (0.0 1.0 0.0)
                          (0.0 0.0 1.0)
                      )
                  )
                  (list
                      (list (cos ang) (- (sin ang)) 0.0)
                      (list (sin ang)    (cos ang)  0.0)
                     '(0.0 0.0 1.0)
                  )
              )
    )
    (mapcar '+
        (mxv mat
            (mapcar '+
                (vxs pnt scl)
                (vxs (cdr (assoc 10 enx)) (- scl))
                (cdr (assoc 12 enx))
            )
        )
        (cdr (assoc 17 enx))
    )
)

;; Matrix Transpose  -  Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m )
    (apply 'mapcar (cons 'list m))
)

;; Matrix x Matrix  -  Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
    ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Vector x Scalar  -  Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
    (mapcar '(lambda ( n ) (* n s)) v)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

;;----------------------------------------------------------------------;;

(princ
    (strcat
        "\n:: VPOutline.lsp | Version 1.2a (VVA) | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type \"vpo\" to Invoke ::"
    )
)
(princ)
Вставка помечена комментариями
Код:
[Выделить все]
;;; VVA 2017-10-26 BEGIN
;;; VVA 2017-10-26 END
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 15.11.2017 в 12:33. Причина: Изменения по ТЗ из #9. Добавлена команда ZVPO для зуммирования в модели
VVA вне форума  
 
Автор темы   Непрочитано 26.10.2017, 23:36
#7
olga87


 
Регистрация: 28.05.2007
Сообщений: 207


Спасибо!
olga87 вне форума  
 
Непрочитано 27.10.2017, 12:33
#8
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


olga87, Незачто.
Если потребуется большее число вершин, то в этой строке
Код:
[Выделить все]
(setq lst (mapcar '(lambda(x)(mapcar '+ x '(0 0)))(vpo:circle2polygon ent 32))) ;_32 многоугольник
Замени 32 на 64, 128 и т.д.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 13.11.2017, 22:04
#9
olga87


 
Регистрация: 28.05.2007
Сообщений: 207


Подскажите пожалуйста, как добавить в код, чтобы вычерченная полилиния (контур выбранного видового экрана) в Модели зуммировалась (приближалась по центру экрана), т.к. если в Модели много объектов, то начерченную полилинию сложно найти.

Может быть добавить в код выше следующее: после выполнения кода, когда пользователь возвращается в Модель - выбрать только что созданную кодом Полилинию и выполнить команду "Показать - Объект (т.е. зуммировать выбранный объект-полилинию)"?

Заранее спасибо!

Последний раз редактировалось olga87, 14.11.2017 в 13:56.
olga87 вне форума  
 
Непрочитано 15.11.2017, 12:40
#10
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


olga87, Обновил #6
1. Границы видового экрана в модели размещаются на непечатаемом слое ViewportToModel синего цвета
2. Добавлена команда ZVPO для зуммирования видового экрана
Т.е. выполняешь команду VPO. Если все хорошо, то в командной строке появляется надпись
Цитата:
Command ZVRO defined. Type ZVPO in command line to zoom to VPOutline
После этого переходите в модель и набираете ZVPO (вызывается команда "ПОКАЗАТЬ" с опцией "Объект"
и указанием полилинии границы видового экрана в модели
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 15.11.2017, 20:00
#11
olga87


 
Регистрация: 28.05.2007
Сообщений: 207


Спасибо!
olga87 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Начертить контур видового экрана в пространстве модели

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
При работе на листе за границы видового экрана отражается весь чертеж с модели Engineering RUS AutoCAD 11 16.01.2015 12:36
Изменение масштаба видового экрана при зумировании DianaChTailor Программирование 26 26.12.2014 21:02
Как повернуть курсор при работе в пространстве модели на определенном листе balerinagv AutoCAD 4 23.10.2013 16:41
Как вы боретесь с выравниванием элементов модели относительно штампа в пространстве Листа? hellt AutoCAD 15 20.03.2013 12:24
Поворот видового экрана? esp1413 AutoCAD 2 16.03.2012 14:56