[Nikolays]

перестала работать команда nscale ( лисп файл nsacale.lsp масштабирование по двум осям)lisp ниже
;; lordALEX
;; NSCALE.LSP
;;
;; Не пропорциональный масштаб
;;
;;
;; Без проверок на корректность выбора и др. Т.Е В ЛОБ
;;
(defun C:NSCALE (/ KX KY NAB T0)
(setvar "CMDECHO" 0)
(setq NAB (ssget))
(setq T0 (getpoint "Укажите базовую точку :"))
(setq KX (getreal "Коэффициент масштаба по оси ОХ <1>: "))
(if (not KX)
(setq KX 1)
)
(setq KY (getreal "Коэффициент масштаба по оси ОY <1>: "))
(if (not KY)
(setq KY 1)
)

(command "_-BLOCK" "$$$TEMP$$$" T0 NAB "")
(command "_-INSERT" "$$$TEMP$$$" T0 KX KY 0)
(command "_EXPLODE" (entlast))
(command "_-PURGE" "_B" "$$$TEMP$$$" "_N")
)
стал требовать точку вставки какого то блока, в чём ошибка не пойму, работал на всех акадах с 2006 до 2012, а теперь не стала работать

[gomer]

[sasha_lif]

Nikolays,

(setq T0 (getpoint "Укажите базовую точку :"))

Ну , так как он тебя раньше не спрашивал?

[Nikolays]

всё я выполняю, указываю базовую точку, потом масштаб по оси Х, далее по оси У, после указания масштаба по оси У, происходит запрос на вставку блока и предлагается два варианта Да или Нет

[VVA]

Nikolays, А так работает?

Код:

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

 (defun C:NSCALE (/ KX KY NAB T0 blname i)
(setvar "CMDECHO" 0)
(setvar "EXPERT" 5)
(setq i 0 blname "$$$TEMP$$$")  
(setq NAB (ssget))
(setq T0 (getpoint "\nУкажите базовую точку :"))
(initget 6) ;_Запрет ввода 0 и отрицательных чисел
(or
  (setq KX (getreal "\nКоэффициент масштаба по оси ОХ <1>: "))
  (setq KX 1)
  )
(initget 6) ;_Запрет ввода 0 и отрицательных чисел  
(or (setq KY (getreal "\nКоэффициент масштаба по оси ОY <1>: "))
    (setq KY 1)
)
(while (tblsearch "block"  blname)
(setq blname (strcat blname "_" (itoa (setq i (1+ i))))))
(command "_-BLOCK" blname "_non" T0 NAB "")
(command "_-INSERT" blname T0 KX KY 0)
(command "_EXPLODE" (entlast))
(command "_-PURGE" "_B" blname "_N")
(princ)
)

[Nikolays]

всё равно не работает, выдаёт сообщение: Блок "$$$TEMP$$$" ссылается сам на себя
*Неверно*, а при масштабировании растра, растр превращает в блок, раньше такого не было

[gomer]

(tblsearch "BLOCK" "$$$TEMP$$$") что возвращает?

[Лиспер]

Я бы сначала пропургенил файл. А еще лучше - использовать более замороченный, но и более устойчивый код

Код:

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

 (vl-load-com)

(defun c:nuscale (/                *error*          lst-getboundingbox
                  fun_conv-selset-to-ename       adoc
                  blk_def          blk_ref          k_x
                  k_y              midp             explmode
                  )

  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun lst-getboundingbox (lst)
;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=44&TID=22552
    (if (and lst (listp lst))
      ((lambda (x)
         (list
           (apply
             (function mapcar)
             (cons (function min) (mapcar (function car) x))
             ) ;_  apply
           (apply
             (function mapcar)
             (cons (function max) (mapcar (function cadr) x))
             ) ;_  apply
           ) ;_  list
         ) ;_  lambda
        (mapcar
          (function
            (lambda (x / minp maxp)
              (vla-getboundingbox x 'minp 'maxp)
              (list
                (vlax-safearray->list minp)
                (vlax-safearray->list maxp)
                ) ;_  list
              ) ;_  lambda
            ) ;_  function
          (vl-remove-if
            (function
              (lambda (x)
                (or
                  (not (eq (type x) 'vla-object))
                  (eq (vla-get-objectname x) "AcDbRay")
                  (eq (vla-get-objectname x) "AcDbXline")
                  ) ;_  or
                ) ;_  lambda
              ) ;_  function
            lst
            ) ;_  vl-remove-if
          ) ;_  mapcar
        )
      ) ;_  if
    ) ;_ end of defun

  (defun fun_conv-selset-to-ename (selset / tab item)
                                     ;|
*    Преобразование набора, полученного через ssget, в список ename-представлени
* примитивов.
*    Параметры вызова:
	selset	набор примитивов
*    Примеры вызова:
(fun_conv-selset-to-ename (ssget))
|;
    (cond
      ((not selset) nil)
      ((= (type selset) 'pickset)
       (repeat (setq tab  nil
                     item (sslength selset)
                     ) ;_ end setq
         (setq tab (cons (ssname selset (setq item (1- item))) tab))
         ) ;_ end repeat
       )
      ((listp selset) selset)
      ) ;_ end of cond
    ) ;_ end of defun

  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if
    (and (= (type (setq selset (vl-catch-all-apply
                                 (function
                                   (lambda ()
                                     (ssget "_:L")
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                 ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'pickset
            ) ;_ end of =
         (= (type (setq k_x (vl-catch-all-apply
                              (function
                                (lambda ()
                                  (cond
                                    ((getdist "\nКоэффициент по X <1> : "))
                                    (t 1.)
                                    ) ;_ end of cond
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'real
            ) ;_ end of =
         (= (type
              (setq k_y (vl-catch-all-apply
                          (function
                            (lambda ()
                              (cond
                                ((getdist (strcat "\nКоэффициент по Y <"
                                                  (vl-princ-to-string k_x)
                                                  "> : "
                                                  ) ;_ end of strcat
                                          ) ;_ end of getdist
                                 )
                                (t k_y)
                                ) ;_ end of cond
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                    ) ;_ end of setq
              ) ;_ end of type
            'real
            ) ;_ end of =
         ) ;_ end of and
     (progn
       (setq blk_def (vla-add (vla-get-blocks adoc)
                              (vlax-3d-point
                                (setq midp ((lambda (/ lst)
                                              (setq lst
                                                     (lst-getboundingbox
                                                       (setq selset
                                                              (mapcar
                                                                (function
                                                                  vlax-ename->vla-object
                                                                  ) ;_ end of function
                                                                (fun_conv-selset-to-ename
                                                                  selset
                                                                  ) ;_ end of fun_conv-selset-to-ename
                                                                ) ;_ end of mapcar
                                                             ) ;_ end of setq
                                                       ) ;_ end of lst-getboundingbox
                                                    ) ;_ end of setq
                                              (mapcar
                                                (function
                                                  (lambda (a b)
                                                    (* (+ a b) 0.5)
                                                    ) ;_ end of lambda
                                                  ) ;_ end of function
                                                (car lst)
                                                (cadr lst)
                                                ) ;_ end of mapcar
                                              ) ;_ end of lambda
                                            )
                                      ) ;_ end of setq
                                ) ;_ end of vlax-3d-point
                              "*U"
                              ) ;_ end of vla-add
             ) ;_ end of setq
       (vla-copyobjects
         adoc
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-vbobject
               (cons 0 (1- (length selset)))
               ) ;_ end of vlax-make-safearray
             selset
             ) ;_ end of vlax-safearray-fill
           ) ;_ end of vlax-make-variant
         blk_def
         ) ;_ end of vla-CopyObjects
       (if (setq blk_ref (vla-insertblock
                           (vla-objectidtoobject
                             adoc
                             (vla-get-ownerid (car selset))
                             ) ;_ end of vla-ObjectIDToObject
                           (vlax-3d-point midp)
                           (vla-get-name blk_def)
                           k_x
                           k_y
                           1.
                           0.
                           ) ;_ end of vla-InsertBlock
                 ) ;_ end of setq
         (progn
           (setq explmode (getvar "explmode"))
           (setvar "explmode" 1)
           (vl-cmdf "_.explode" (handent (vla-get-handle blk_ref)) "")
           (setvar "explmode" explmode)
           ) ;_ end of progn
         ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

И где-то в Download была программа от Дениса Флюстикова как раз по этому вопросу..

[VVA]

Сообщение от Nikolays всё равно не работает, выдаёт сообщение: Блок "$$$TEMP$$$" ссылается сам на себя

Изменил код в #5 пробуй снова

[gomer]

Сообщение от VVA Изменил код в #5 пробуй снова

1. Хотел бы заметить несовешенство тэга [lisp]
2. Можно попробовать команду в "пустом" чертеже...
3. У меня почему-то работает при любом, кажется, значении expert
4. Создавать нужно уникальный блок (vl-file-mktemp, например), а потом его удалять...

[Кулик Алексей aka kpblc]

Сообщение от gomer Хотел бы заметить несовешенство тэга [lisp]

В тему "Книга предложений" в разделе "Разное".

Сообщение от gomer Создавать нужно уникальный блок

Проанализируй код из #8

[gomer]

Сообщение от Кулик Алексей aka kpblc Проанализируй

Чет опера глюканула...
Ну или так... "*U" ... хотя командным способом вряд ли... но сдается мне что код в #8 делает тоже самое... что и в #5
Что резануло глаза - выбор всех объектов и фильтрация линий и лучей потом...