Тема: DCL и COMMAND?

У меня есть DCL окно, в котором можно редактировать однострочный текст. И вопрос - как сделать мне при принажатии клавиши :button{label="<<"; key="b_height";}, чтобы DCL окно закрывалась, затем вызывалась фукция COMMAND, например (command "CHANGE").После того как COMMAND отработает вызвать опять DCL окно с измененными значениями TEXTа . Ниже представлен текст DCL и LSP файла.
еdit_text: dialog {label="Редактирование текста";
    :edit_box{label="Текст:"; edit_width=55; value=""; key="p_text"; edit_limit=50;}
    spacer_1;
    :row{
        :column{
            :text{label="Высота";}
            :text{label="Угол";}
            :text{label="Степень сжатия";}
        }
        :column{
            :edit_box{value=""; key="p_height"; edit_limit=3; width=40;}
            :edit_box{value=""; key="p_rotation"; edit_limit=3; width=40;}
            :edit_box{value=""; key="p_width_factor"; edit_limit=3; width=40;}
        }
        :column {
            :button{label="<<"; key="b_height";}
            :button{label="<<"; key="b_rotation";}
        }
    }
  spacer_1;
  ok_cancel;
}
(defun change_height ()
  (command "CHANGE" "prim")
;  (edit_text)
);defun change_height
(defun edit_text (/ id)
  (if (<(setq dcl_id (load_dialog "D:\\primer\\edit_text.dcl")) 0) (exit))
  (if (not(new_dialog "еdit_text" dcl_id)) (exit))
  (set_tile "p_text" (cdr (assoc 1 (entget prim))))
  (set_tile "p_height" (rtos (cdr (assoc 40 (entget prim)))))
  (action_tile "b_height"
      (strcat
      "(done_dialog)"
;;      "(unload_dialog dcl_id)"
;;      "(princ)"
;;      "(change_height)"
      );strcat
  );action_tile "b_height"
  (set_tile "p_rotation" (rtos (/ (* (cdr (assoc 50 (entget prim))) 180) pi)))
  ;(action_tile "b_rotation" "(done_dialog)")
  (set_tile "p_width_factor" (rtos (cdr (assoc 41 (entget prim)))))
  ;(action_tile "b_width_factor" "(done_dialog)")
  (action_tile "accept"
      (strcat
          "(setq Ptext_izm (cons 1 (get_tile \"p_text\")))"
          "(setq list_prim (subst Ptext_izm (assoc 1 (entget prim)) (entget prim)))"
      "(entmod list_prim)"
      "(setq Pheight_izm (cons 40 (atof (get_tile \"p_height\"))))"
          "(setq list_prim (subst Pheight_izm (assoc 40 (entget prim)) (entget prim)))"
          "(entmod list_prim)"
      "(setq P_rotation_izm (atof (get_tile \"p_rotation\")))"
      "(setq P_rotation_izm (cons 50 (/ (* P_rotation_izm  pi) 180)))"
          "(setq  list_prim (subst P_rotation_izm (assoc 50 (entget prim)) (entget prim)))"
          "(entmod list_prim)"
      "(setq Pwidth_factor_izm (cons 41 (atof (get_tile \"p_width_factor\"))))"
          "(setq list_prim (subst Pwidth_factor_izm (assoc 41 (entget prim)) (entget prim)))"
          "(entmod list_prim)"
   
      "(done_dialog)"
      );strcat
  );action_tile "accept"
  (start_dialog)
  (unload_dialog dcl_id)
  (princ)
);defun edit_text

Re: DCL и COMMAND?

(defun txtedit (ent                  /
                _kpblc-dir-get-root-temp
                _kpblc-dir-path-and-splash
                _kpblc-ent-modify-autoregen               dcl_id
                dcl_file_name        dcl_file_handle      ent_lst
                res                  adoc                 txt_string
                txt_height           txt_rot              txt_width
                )
  (defun _kpblc-ent-modify-autoregen (ent        bit        value
                                      ext_regen  /          ent_list
                                      old_dxf    new_dxf    layer_dxf70
                                      )
                                     ;|
*    Функция модификации указанного бита примитива
*    Параметры вызова:
*    entity    - примитив, полученный через (entsel), (entlast) etc
*    bit    - dxf-код, значение которого надо установить
*    value    - новое значение
*    regen    - выполнять или нет регенерацию примитива сразу. t/ nil
*    Примеры вызова:
(_kpblc-ent-modify (entlast) 8 "0" t)    ; перенести последний примитив на слой 0
(_kpblc-ent-modify (entsel) 62 10 nil)    ; установить выбранному примитиву цвет 10
*    Возвращаемое значение:
*    примитив с модифицированным dxf-списком. Примитив перерисовывается в
* зависимости от значения ключа ext_regen
|;
    (setq ent (_kpblc-conv-ent-to-ename ent))
    (if (not
          (and
            (or
              (= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
              (= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
              (= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
              ) ;_ end of or
            (= bit 100)
            ) ;_ end of and
          ) ;_ end of not
      (progn
        (setq ent_list (entget ent)
              new_dxf  (cons bit
                             (if (and (= bit 62) (= (type value) 'str))
                               (if (= (strcase value) "BYLAYER")
                                 256
                                 0
                                 ) ;_ end of if
                               value
                               ) ;_ end of if
                             ) ;_ end of cons
              ) ;_ end of setq
        (if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
          (progn
            (entmod (if old_dxf
                      (subst new_dxf old_dxf ent_list)
                      (append ent_list (list new_dxf))
                      ) ;_ end of if
                    ) ;_ end of entmod
            (if ent_regen
              (entupd ent)
              (redraw ent)
              ) ;_ end of if
            ) ;_ end of progn
          ) ;_ end of if
        ) ;_ end of progn
      ) ;_ end of if
    ent
    ) ;_ end of defun
  (defun _kpblc-dir-path-and-splash (path)
                                    ;|
*    Возвращает путь со слешем в конце
*    Параметры вызова:
*    path    - обрабатываемый путь
*    Примеры вызова:
(_kpblc-dir-path-and-splash "c:\\kpblc-cad")    ; "c:\\kpblc-cad\\"
|;
    (strcat (vl-string-right-trim "\\" path) "\\")
    ) ;_ end of defun
  (defun _kpblc-dir-get-root-temp ()
                                  ;|
*    Возвращает путь временных файлов AutoCAD
|;
    (_kpblc-dir-path-and-splash
      (vla-get-tempfilepath
        (vla-get-files (vla-get-preferences (vlax-get-acad-object)))
        ) ;_ end of vla-get-tempfilepath
      ) ;_ end of _kpblc-dir-path-and-splash
    ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (or ent
        (and
          (not
            (vl-catch-all-error-p
              (vl-catch-all-apply
                '(lambda ()
                   (setq ent (entsel "\nУкажите однострочный текст <Отмена> : "))
                   ) ;_ end of LAMBDA
                ) ;_ end of VL-CATCH-ALL-APPLY
              ) ;_ end of VL-CATCH-ALL-ERROR-P
            ) ;_ end of not
          (setq ent (car ent))
          (= (cdr (assoc 0 (entget ent))) "TEXT")
          ) ;_ end of and
        ) ;_ end of or
     (progn
       (setq ent_lst (entget ent)
             dcl_file_handle
              (open
                (setq dcl_file_name
                       (strcat (_kpblc-dir-get-root-temp)
                               "textedit.dcl"
                               ) ;_ end of strcat
                      ) ;_ end of setq
                "w"
                ) ;_ end of open
             ) ;_ end of setq
       (foreach item
                '("еdit_text: dialog {label=\"Редактирование текста\";"
                  ":edit_box{label=\"Текст:\"; edit_width=55; value=\"\"; key=\"p_text\"; edit_limit=50;}"
                  "spacer_1;"
                  ":row{"
                  ":column{"
                  ":text{label=\"Высота\";}"
                  ":text{label=\"Угол\";}"
                  "spacer_1;"
                  ":text{label=\"Степень сжатия\";}"
                  "}"
                  ":column{"
                  ":edit_box{value=\"\"; key=\"p_height\"; edit_limit=3; width=40;}"
                  ":edit_box{value=\"\"; key=\"p_rot\"; edit_limit=3; width=40;}"
                  ":edit_box{value=\"\"; key=\"p_width_factor\"; edit_limit=3; width=40;}"
                  "}"
                  ":column {"
                  ":button{label=\"<<\"; key=\"b_height\";}"
                  ":button{label=\"<<\"; key=\"b_rotation\";}"
                  "spacer_1;"
                  "}"
                  "}"
                  "spacer_1;"
                  "ok_cancel;"
                  "}"
                  )
         (write-line item dcl_file_handle)
         ) ;_ end of foreach
       (close dcl_file_handle)
       (if (and (setq dcl_id (load_dialog dcl_file_name))
                (> dcl_id 0)
                ) ;_ end of and
         (progn
           (new_dialog "еdit_text" dcl_id)
           (set_tile "p_text" (cdr (assoc 1 ent_lst)))
           (set_tile "p_height" (rtos (cdr (assoc 40 ent_lst)) 2))
           (set_tile "p_rot"
                     (rtos (/ (* (cdr (assoc 50 ent_lst)) 180.) pi) 2)
                     ) ;_ end of set_tile
           (set_tile "p_width_factor" (rtos (cdr (assoc 41 ent_lst)) 2))
           (action_tile
             "b_height"
             "(setq txt_height (get_tile \"p_height\")) (DONE_DIALOG 1)"
             ) ;_ end of action_tile
           (action_tile
             "b_rotation"
             "(setq txt_rot (get_tile \"p_rot\")) (DONE_DIALOG 2)"
             ) ;_ end of action_tile
           (action_tile
             "accept"
             (strcat
               "(setq txt_string (get_tile \"p_text\") "
               " txt_height (get_tile \"p_height\")"
               " txt_rot (get_tile \"p_rot\"))"
               " txt_width (get_tile \"p_width_factor\")"
               "(DONE_DIALOG 3)"
               ) ;_ end of strcat
 ;_ end of strcat
             ) ;_ end of action_tile
           (setq res (start_dialog))
           (mapcar
             '(lambda (x)
                (_kpblc-ent-modify-autoregen ent (car x) (cdr x) t)
                ) ;_ end of lambda
             ((lambda (/ tmp)
                (setq tmp (list
                            (cons 1
                                  (cond
                                    (txt_string)
                                    (t (cdr (assoc 1 ent_lst)))
                                    ) ;_ end of cond
                                  ) ;_ end of cons
                            (cons 40
                                  (atof (cond
                                          (txt_height)
                                          (t (rtos (cdr (assoc 40 ent_lst)) 2))
                                          ) ;_ end of cond
                                        ) ;_ end of atof
                                  ) ;_ end of cons
                            (cons 50
                                  (* (/ (atof (cond
                                                (txt_rot)
                                                (t (rtos (cdr (assoc 50 ent_lst)) 2))
                                                ) ;_ end of cond
                                              ) ;_ end of atof
                                        180.
                                        ) ;_ end of /
                                     pi
                                     ) ;_ end of *
                                  ) ;_ end of cons
                            (cons 41
                                  (atof (cond
                                          (txt_width)
                                          (t (rtos (cdr (assoc 41 ent_lst))))
                                          ) ;_ end of cond
                                        ) ;_ end of atof
                                  ) ;_ end of cons
                            ) ;_ end of list
                      tmp (cond
                            ((= res 1)
                             (vl-remove-if-not '(lambda (x) (= (car x) 40)) tmp)
                             )
                            ((= res 2)
                             (vl-remove-if-not '(lambda (x) (= (car x) 50)) tmp)
                             )
                            ((= res 3) tmp)
                            (t nil)
                            ) ;_ end of cond
                      ) ;_ end of setq
                ) ;_ end of lambda
              )
             ) ;_ end of mapcar
           (unload_dialog dcl_id)
           (command "_.regen")
           (if (member res '(1 2))
             (txtedit ent)
             ) ;_ end of if
           ) ;_ end of progn
         ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Re: DCL и COMMAND?

А надо это - создание DCL "на лету" + рекурсия?
Человеку ведь помощь нужна...

Re: DCL и COMMAND?

> Пастух
Не знаю :) Но в первом посте сказано:

при принажатии клавиши :button{label="<<"; key="b_height";}, чтобы DCL окно закрывалась, затем вызывалась фукция COMMAND, например (command "CHANGE").После того как COMMAND отработает вызвать опять DCL окно с измененными значениями TEXTа .

Этот кусок сделан. Может быть, кривовато, но сделан (ЯТД).