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

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

В лиспе "Координаты точки" сделать разделителем запятую

Ответ
Перейти к новому Перейти к новому  
Поиск в этой теме
Непрочитано 11.05.2014, 20:53 #1
В лиспе "Координаты точки" сделать разделителем запятую
olga87
 
Регистрация: 28.05.2007
Сообщений: 208
Здравствуйте Уважаемые программисты!
Подскажите пожалуйста как подправить лисп ниже, чтобы разделителем была запятая (а не точка)?
Спасибо!

Код:

Код:
[Выделить все] 
 (defun C:NE ( / p1 p2)
;;На основе _kpblc-draw-leader
(defun _addleader (up-string low-string   start-point end-point /   lead_obj ann_obj point-list)
  ;; Прежде всего преобразовываем low-string в строковый вид:
  (if (not low-string)(setq low-string "")) ;_ end of if
  (setq point-list (apply 'append (list start-point end-point)))
  ;; Теперь собственно выполнение выноски.
  (setq   ann_obj    (vla-addmtext
         (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
           (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object)))))
    (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
         (vlax-3d-point end-point)
         0         ; устанавливается ширина именно 0, для нормального получения полки
         (if (/= low-string "")(strcat up-string "\\P" low-string) up-string)))
  (vla-put-Rotation ann_obj (angle '(0 0 0)(getvar "UCSXDIR")))
  (if (vlax-property-available-p ann_obj 'BackgroundFill)
  (vla-put-BackgroundFill ann_obj :vlax-true))
  (setq lead_obj (vla-addleader
        (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
           (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object)))))
    (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
        (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble
             (cons 0 (1- (length point-list)))) point-list)) ann_obj  acLineNoArrow) ;_ end of vla-AddLeader
   ) ;_ end of setq
  ;; Меняем настройки будущей аннотации:
 ; (vla-put-height ann_obj (* 1 (getvar "dimscale")))
  (vla-put-attachmentpoint ann_obj
    ;; Назначая точку выравнивания, будем использовать числовые значения:
    ;; acAttachmentPointBottomLeft   ->   7
    ;; acAttachmentPointBottomRight   ->   9
    ;; acAttachmentPointMiddleLeft   ->   4
    ;; acAttachmentPointMiddleRight   ->   6
    (+ 4 (if (> (car end-point) (car start-point)) ; выноска вправо, точка — влево
       0  2) ;_ end of if
       (if (/= low-string "")      ; нижняя строка есть, выр. — по  центру
           0 3) ;_ end of if
       ) ;_ end of +
    ) ;_ end of vla-put-AttachmentPoint
  (vla-put-insertionpoint ann_obj (vlax-3d-point end-point))
  ;; Теперь модицифируем собственно выноску
  (vla-put-verticaltextposition lead_obj acOutside)
  (vla-put-ArrowheadSize lead_obj 0.5)
  ;; В принципе, строка ниже не требуется — так, для страховки.
  (vla-put-coordinate lead_obj 1 (vlax-3d-point end-point)) lead_obj)
  (vl-load-com)
  (initget 1)
  (setq p1 (getpoint "\nТочка: "))
  (initget 1)
  (setq p2 (getpoint p1 "\nНаправление выноски: "))
;;;  (setq p1 (trans p1 1 0)           ;<- Здесь переводим p1 в МСК
;;;  p2 (trans p2 1 0))                ;<- Здесь переводим p2 в МСК
  (_addleader
    (strcat "X=" (rtos (nth 1 p1) 2 2))
    (strcat "Y=" (rtos (nth 0 p1) 2 2))
    (trans p1 1 0)(trans p2 1 0))(princ))
(princ "\nНаберите в командной строке NE")
Последний раз редактировалось Кулик Алексей aka kpblc, 11.05.2014 в 21:00.
Просмотров: 2702
 
Непрочитано 11.05.2014, 21:00
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,833

См. тему http://forum.dwg.ru/showthread.php?t...E0%EC%E5%ED%E0
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 11.05.2014, 21:52
#3
VVA

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

Тестируй
Код:
[Выделить все] 
 (defun C:NE ( / p1 p2)
;;На основе _kpblc-draw-leader
(defun _addleader (up-string low-string   start-point end-point /   lead_obj ann_obj point-list)
  ;; Прежде всего преобразовываем low-string в строковый вид:
  (if (not low-string)(setq low-string "")) ;_ end of if
  (setq point-list (apply 'append (list start-point end-point)))
  ;; Теперь собственно выполнение выноски.
  (setq   ann_obj    (vla-addmtext
         (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
           (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object)))))
    (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
         (vlax-3d-point end-point)
         0         ; устанавливается ширина именно 0, для нормального получения полки
         (if (/= low-string "")(strcat up-string "\\P" low-string) up-string)))
  (vla-put-Rotation ann_obj (angle '(0 0 0)(getvar "UCSXDIR")))
  (if (vlax-property-available-p ann_obj 'BackgroundFill)
  (vla-put-BackgroundFill ann_obj :vlax-true))
  (setq lead_obj (vla-addleader
        (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
           (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object)))))
    (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
        (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble
             (cons 0 (1- (length point-list)))) point-list)) ann_obj  acLineNoArrow) ;_ end of vla-AddLeader
   ) ;_ end of setq
  ;; Меняем настройки будущей аннотации:
 ; (vla-put-height ann_obj (* 1 (getvar "dimscale")))
  (vla-put-attachmentpoint ann_obj
    ;; Назначая точку выравнивания, будем использовать числовые значения:
    ;; acAttachmentPointBottomLeft   ->   7
    ;; acAttachmentPointBottomRight   ->   9
    ;; acAttachmentPointMiddleLeft   ->   4
    ;; acAttachmentPointMiddleRight   ->   6
    (+ 4 (if (> (car end-point) (car start-point)) ; выноска вправо, точка — влево
       0  2) ;_ end of if
       (if (/= low-string "")      ; нижняя строка есть, выр. — по  центру
           0 3) ;_ end of if
       ) ;_ end of +
    ) ;_ end of vla-put-AttachmentPoint
  (vla-put-insertionpoint ann_obj (vlax-3d-point end-point))
  ;; Теперь модифицируем собственно выноску
  (vla-put-verticaltextposition lead_obj acOutside)
  (vla-put-ArrowheadSize lead_obj 0.5)
  ;; В принципе, строка ниже не требуется — так, для страховки.
  (vla-put-coordinate lead_obj 1 (vlax-3d-point end-point)) lead_obj)
  (vl-load-com)
  (initget 1)
  (setq p1 (getpoint "\nТочка: "))
  (initget 1)
  (setq p2 (getpoint p1 "\nНаправление выноски: "))
;;;  (setq p1 (trans p1 1 0)           ;<- Здесь переводим p1 в МСК
;;;  p2 (trans p2 1 0))                ;<- Здесь переводим p2 в МСК
  (_addleader
    (strcat "X=" (vl-string-translate "." "," (rtos (nth 1 p1) 2 2))) ;_меняем точку (.) на запятую (,)
    (strcat "Y=" (vl-string-translate "." "," (rtos (nth 0 p1) 2 2))) ;_меняем точку (.) на запятую (,)
    (trans p1 1 0)(trans p2 1 0))(princ))
(princ "\nНаберите в командной строке NE")
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 13.05.2014, 11:29
#4
olga87


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

Спасибо!
olga87 вне форума  
 
Непрочитано 13.07.2020, 15:57
#5
neverbash


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

Здравствуйте, тот же самый вопрос, в лиспе полный ноль.
Код:
[Выделить все] 
 (defun c:test (/     sys-var  selset       action
        value     precision_value       str
        precision_str   rec-pat
       )
  (defun rec-pat (str / rec-pat)
    (defun rec-pat (temp str pat n /)
      (cond ((= str "") (list temp))
     ((if (minusp n)
        (not (member (substr str 1 1) pat))
        (member (substr str 1 1) pat)
      ) ;_ end of if
      (if (/= temp "")
        (cons temp (rec-pat "" str pat (- n)))
        (rec-pat "" str pat (- n))
      ) ;_ end of if
     )
     (t
      (rec-pat (strcat temp (substr str 1 1))
        (substr str 2)
        pat
        n
      ) ;_ end of trim_gap
     )
      ) ;_ end of cond
    ) ;_ end of defun
    (rec-pat ""
      str
      '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ".")
      1
    ) ;_ end of rec-pat
  ) ;_ end of defun
  (setq sys-var (getvar 'dimzin))
  (setvar 'dimzin 0)
  (if
    (and
      (setq selset (ssget "_:L" '((0 . "*TEXT"))))
      (not
 (vl-catch-all-error-p
   (vl-catch-all-apply
     '(lambda ()
        (setq action
        (progn
   (initget "+ - * /")
   (cadr
     (assoc (getkword
       "Действие [+ - * /] :<+> "
     ) ;_ end of getkword
     '(("+" +) ("-" -) ("*" *) ("/" /) (nil +))
     ) ;_ end of assoc
   ) ;_ end of cadr
        ) ;_ end of progn
        ) ;_ end of setq
        (setq value (getreal "\nЧисло <Esc> : "))
        (setq
   precision_value
    ((lambda (x)
       (if (equal x 0.0)
         0
         (- (length
       (vl-string->list
         (vl-princ-to-string
    x
         ) ;_ end of vl-princ-to-string
       ) ;_ end of vl-string->list
     ) ;_ end of length
     2
         ) ;_ end of -
       ) ;_ end of if
     ) ;_ end of lambda
      (rem value 1.)
    )
        ) ;_ end of setq
      ) ;_ end of lambda
   ) ;_ end of vl-catch-all-apply
 ) ;_ end of vl-catch-all-error-p
      ) ;_ end of not
    ) ;_ end of and
     (foreach ent
       (mapcar
  'vlax-ename->vla-object
  (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
       ) ;_ end of mapcar
       (setq str (vla-get-textstring ent))
       (vla-put-textstring
  ent
  (apply 'strcat
  (mapcar
    '(lambda (str)
       (setq precision_str
       (length
         (cdr (member 46 (vl-string->list str)))
       ) ;_ end of length
       ) ;_ end of setq
       (if (equal (rtos (atof str) 2 precision_str) str)
         (rtos
    ((eval action) (atof str) value)
    2
    (apply 'max (list precision_value precision_str))
         ) ;_ end of rtos
         str
       ) ;_ end of if
     ) ;_ end of lambda
    (rec-pat str)
  ) ;_ end of mapcar
  ) ;_ end of apply
       ) ;_ end of vla-put-textstring
       (vla-put-color ent 3)
     ) ;_ end of foreach
  ) ;_ end of if
  (setvar 'dimzin sys-var)
  (princ)
) ;_ end of defun
neverbash вне форума  
 
Непрочитано 13.07.2020, 23:26
#6
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653

neverbash,
Код:
[Выделить все] 
  (defun c:test (/     sys-var  selset       action
        value     precision_value       str
        precision_str   rec-pat
       )
  (defun rec-pat (str / rec-pat)
    (defun rec-pat (temp str pat n /)
      (cond ((= str "") (list temp))
     ((if (minusp n)
        (not (member (substr str 1 1) pat))
        (member (substr str 1 1) pat)
      ) ;_ end of if
      (if (/= temp "")
        (cons temp (rec-pat "" str pat (- n)))
        (rec-pat "" str pat (- n))
      ) ;_ end of if
     )
     (t
      (rec-pat (strcat temp (substr str 1 1))
        (substr str 2)
        pat
        n
      ) ;_ end of trim_gap
     )
      ) ;_ end of cond
    ) ;_ end of defun
    (rec-pat ""
      str
      '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ".")
      1
    ) ;_ end of rec-pat
  ) ;_ end of defun
  (setq sys-var (getvar 'dimzin))
  (setvar 'dimzin 0)
  (if
    (and
      (setq selset (ssget "_:L" '((0 . "*TEXT"))))
      (not
 (vl-catch-all-error-p
   (vl-catch-all-apply
     '(lambda ()
        (setq action
        (progn
   (initget "+ - * /")
   (cadr
     (assoc (getkword
       "Действие [+ - * /] :<+> "
     ) ;_ end of getkword
     '(("+" +) ("-" -) ("*" *) ("/" /) (nil +))
     ) ;_ end of assoc
   ) ;_ end of cadr
        ) ;_ end of progn
        ) ;_ end of setq
        (setq value (getreal "\nЧисло <Esc> : "))
        (setq
   precision_value
    ((lambda (x)
       (if (equal x 0.0)
         0
         (- (length
       (vl-string->list
         (vl-princ-to-string
    x
         ) ;_ end of vl-princ-to-string
       ) ;_ end of vl-string->list
     ) ;_ end of length
     2
         ) ;_ end of -
       ) ;_ end of if
     ) ;_ end of lambda
      (rem value 1.)
    )
        ) ;_ end of setq
      ) ;_ end of lambda
   ) ;_ end of vl-catch-all-apply
 ) ;_ end of vl-catch-all-error-p
      ) ;_ end of not
    ) ;_ end of and
     (foreach ent
       (mapcar
  'vlax-ename->vla-object
  (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
       ) ;_ end of mapcar
       (setq str (vla-get-textstring ent))
       (vla-put-textstring
  ent
  (vl-string-subst "," "."
  (apply 'strcat
  (mapcar
    '(lambda (str)
       (setq precision_str
       (length
         (cdr (member 46 (vl-string->list str)))
       ) ;_ end of length
       ) ;_ end of setq
       (if (equal (rtos (atof str) 2 precision_str) str)
         (rtos
    ((eval action) (atof str) value)
    2
    (apply 'max (list precision_value precision_str))
         ) ;_ end of rtos
         str
       ) ;_ end of if
     ) ;_ end of lambda
    (rec-pat str)
  ) ;_ end of mapcar
  ) ;_ end of apply
  ) ;_ end of vl-string-subst
       ) ;_ end of vla-put-textstring
       (vla-put-color ent 3)
     ) ;_ end of foreach
  ) ;_ end of if
  (setvar 'dimzin sys-var)
  (princ)
) ;_ end of defun
Добавлены строки 86 и 107
skkkk вне форума  
 
Непрочитано 14.07.2020, 09:13
#7
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,679

ну уж тогда и строку 46 нужно заменить на
Код:
[Выделить все] 
 (getkword "Действие [+/-/*//] :<+> ")
а то выходит ограниченный функционал)
koMon вне форума  
 
Непрочитано 14.07.2020, 10:35
#8
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653

koMon, согласен. Код я не запускал, просто нашел в нем строку (которая line) с формированием строки (которая string) и вписал замену точки на запятую. А этот косячок не углядел. Видимо, задумка автора была таковой, чтоб нужно было именно вводить с клавы (хотя и с твоим исправлением этот ввод доступен также), потому что, например, не пользуется он динамическим вводом. Вроде, не похоже, что код написан совсем уж джуном, и он не знал про эти слэши.
skkkk вне форума  
 
Непрочитано 14.07.2020, 10:45
#9
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,679

ну так квадратные скобки как раз для дин. ввода и используются. по стилю похоже на Алексея. копипаст скорее всего.
koMon вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > В лиспе "Координаты точки" сделать разделителем запятую

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Разработка ПОС, искусство проектирования Tyhig Технология и организация строительства 117 25.11.2021 17:38

Обратная связь - Вверх