[Torero_80]

Есть функция SLE

Код:

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

  


    (defun c:SLE ()
    (command "-scalelistedit" "С" "Д" "В")
    (princ)
    ) ;_ end of defun

Подскажите как должен выглядеть следующий программный код, чтобы выполнялась функция SLE?

Код:

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

  
()

(if *vlr-cmd*
  (progn
    (setq *vlr-cmd* nil)
    (vlr-remove-all :vlr-command-reactor)
    ) ;_ end of progn
  ) ;_ end of if
(if (not *vlr-cmd*)
  (setq *vlr-cmd* (vlr-command-reactor
                    "cmd"
                    '(
                      (:vlr-commandwillstart . cmd-start)
                      )
                    ) ;_ end of VLR-Command-Reactor
        ) ;_ end of setq
  ) ;_ end of if

(defun cmd-start (react cmd / selset cmd_name adoc)
  (setq cmd_name (strcase (car cmd) t)
        adoc     (vla-get-activedocument (vlax-get-acad-object))
        ) ;_ end of setq
  (cond
    ((vl-string-search "copybase" cmd_name)
                              

      (SLE adoc)

          
     )
    ) ;_ end of cond
  ) ;_ end of defun

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

http://forum.dwg.ru/showpost.php?p=302360&postcount=75

[Torero_80]

СПАСИБО!

[Torero_80]

Интересная штука получается...

С командой copyclip - все ОК, если команду copyclip заменить на copybase - ничего не получается...

Код:

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

;====================== ФУНКЦИЯ сбрасывания масштабов видовых экранов перед командой copybase =================================================

(defun restore-scale-list ()
  (vl-load-com)
  (foreach sc (dictsearch (namedobjdict) "acad_scalelist")
    (if (and (= (car sc) 350)
             (not (member (cdr (assoc 300 (entget (cdr sc))))
                          '("1:1" "1:2" "1:10" "1:50" "1:100" "2:1") ;_Здесь перечисляем нужные масштабы
                  ) ;_ end of member
             ) ;_ end of not
        ) ;_ end of and
      (vl-catch-all-apply
        'vla-delete
        (list (vlax-ename->vla-object (cdr sc)))
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of if
  ) ;_ end of foreach
) ;_ end of defun


(if *vlr-cmd*
  (progn
    (setq *vlr-cmd* nil)
    (vlr-remove-all :vlr-command-reactor)
    ) ;_ end of progn
  ) ;_ end of if
(if (not *vlr-cmd*)
  (setq *vlr-cmd* (vlr-command-reactor
                    "cmd"
                    '(
                      (:vlr-commandwillstart . cmd-start)
                      )
                    ) ;_ end of VLR-Command-Reactor
        ) ;_ end of setq
  ) ;_ end of if

(defun cmd-start (react cmd / selset cmd_name adoc)
  (setq cmd_name (strcase (car cmd) t)
        adoc     (vla-get-activedocument (vlax-get-acad-object))
        ) ;_ end of setq
  (cond
    ((vl-string-search "copybase" cmd_name)
                              

      (restore-scale-list)
          
     )
    ) ;_ end of cond
  ) ;_ end of defun


;====================== ФУНКЦИЯ сбрасывания масштабов видовых экранов перед командой copyclip =================================================

(if *vlr-cmd*
  (progn
    (setq *vlr-cmd* nil)
    (vlr-remove-all :vlr-command-reactor)
    ) ;_ end of progn
  ) ;_ end of if
(if (not *vlr-cmd*)
  (setq *vlr-cmd* (vlr-command-reactor
                    "cmd"
                    '(
                      (:vlr-commandwillstart . cmd-start)
                      )
                    ) ;_ end of VLR-Command-Reactor
        ) ;_ end of setq
  ) ;_ end of if

(defun cmd-start (react cmd / selset cmd_name adoc)
  (setq cmd_name (strcase (car cmd) t)
        adoc     (vla-get-activedocument (vlax-get-acad-object))
        ) ;_ end of setq
  (cond
    ((vl-string-search "copyclip" cmd_name)
                              

      (restore-scale-list)
          
     )
    ) ;_ end of cond
  ) ;_ end of defun