Справочник типа .chm по функциям LISP

Kostinok · 01.08.2008, 11:35

Если у кого нибудь есть подобная, очень нужная, на русском языке ВЕЩЬ!!!! Пожалуйста скиньте.
В интернете сидеть дорого, хотелось бы пользоваться и в offline.
Заранее благодарен!

Кулик Алексей aka kpblc · 01.08.2008, 11:53

На русском языке такого не встречал. Только в бумажном виде (любая книга Н.Н.Полещука по LISP'у). Ну и плюс справка )

VVA · 01.08.2008, 12:43

Кое что есть здесь А кто мешает сохранить с интернета странички на машину и просматривать потом автономно?

Kostinok · 04.08.2008, 10:42

VVA, Спасибо! На самом деле нужен был аналог к HELPу но на русском. Там не все(((
Програмировать сам пока еще не умею. Но вот поучиться надо. Стал разбирать Вашу программу SumT.lsp Но ничего не понял, или понял, что ничего не понял)
Вы могли бы посмотреть на мои комментарии к Вашей программе и написать свои, подробно. Что бы мог разобраться?
Вот ваш текст, не весь:

Код:

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

;;;http://dwg.ru/f/showthread.php?t=16987&page=3
;|
  Назначение:  Суммирование Тектса,Мтекста, Размеров указанием или рамкой.
               Угловые размеры игнорируются
  Особенности: Безразлична к разделителям точка или запятая. 
               Ввиду особенности работы atof стоки вида "22.3мама" 
               будут учтены как число 22.3
 
               При выводе результата число округляется в соответствии 
               с значением переменной num.
|;
;;;what - операция + или *
;;;newtext - t - новый текст, nil - указать текст
;;; num - количество знаков после запятой, nil - переменная LUPREC
(defun operate_text ( what newtext num / res selset ins_pt txt_height blk obj ed *error*)
  (defun *error* (msg)
    (setvar "NOMUTT" 0)  ;_ Восстанавливаем NOMUTT, Что плохого в NOMUTT?
    (princ msg)
    )
 (vl-load-com)(if (eq what '*)(setq res 1.)(setq res 0.)); Здесь все понятно)
  (if (null num)(setq num (getvar "LUPREC")))
 (princ "\nВыберите тексты или размеры: ")
  (setvar "NOMUTT" 1)  ;_ Отключаем NOMUTT
  (setq selset (ssget '((0 . "TEXT,MTEXT,*DIMENSION"))))
  (setvar "NOMUTT" 0)  ;_ Восстанавливаем NOMUTT
 (if  selset
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)));;; если что то выбрали, то поочередно|
    								      ;;; каждый !!!!элемент!!!! превратить в vla объект записать
      								      ;;; в набор obj
      								      ;;; Но не каждый элемент а иена типа <Entity name: 756a89f8>
     (setq obj (vlax-ename->vla-object ent); теперь это не <Entity name: 756a89f8>... а что то типа #<VLA-OBJECT IAcadMText2 1a5c0c04>
           ed (entget ent);;; а здесь список с характеристиками примитивов
           ) 
     (if (and (wcmatch (cdr(assoc 0 ed)) "*DIMENSION")
              (or
                (member '(100 . "AcDbAlignedDimension") ed)  ;_Параллельный или линейный
                (member '(100 . "AcDbDiametricDimension") ed);_Диаметр
                (member '(100 . "AcDbRadialDimension") ed)   ;_Радиус
                (member '(100 . "AcDbArcDimension") ed)      ;_Дуговой
                )
              );;; если выбраны размеры, то->
       (progn
         (setq blk
             (vla-item (vla-get-blocks
                         (vla-get-activedocument (vlax-get-acad-object))
                       ) ;_ end of vla-get-Blocks, запоминает все блоки в документе
                       (cdr (assoc 2 ed));;; Из всех блоков извлекает имя (тег) атрибута и записивыет списком в blk
             ) ;_ end of vla-item
      ) ;_ end of setq
      (vlax-for item blk
        (if (= (vla-get-objectname item) "AcDbMText");;; Не понял
          (setq obj item)
          )
         )
       )
       );;;Отсюда вообще ничего не понял(((
     (if (vlax-property-available-p obj 'Textstring)
       (progn
     (setq str (str-str-lst (vla-get-textstring obj) "\\P")
     str (mapcar '(lambda(x)(mip_mtext_unformat x)) str)
      str (mapcar '(lambda(x)(vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t"   x))) str)
      str (mapcar '(lambda(x)(vl-string-trim  "%UuoOcC \t"   x)) str)
     res ((eval what) res (apply what (mapcar 'atof str))))
     )
       )
      ) ;_ end of foreach 
    ) ;_ end of if 
  (princ "\nРезультат=")(princ (rtos res 2 num))
  
  (if (not (equal res 0. 1e-3))
    (if newtext
    (progn 
      (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0) ;_ end of =
        (progn ;; нулевая высота текста
   (if (not (setq txt_height (getreal "\nВведите высоту текста <250> : ")))(setq txt_height 250.)) 
(vl-cmdf "_-MTEXT" "_non" "0,0" "_J" "_BC" "_H" txt_height "_W" 0 (rtos res 2 num)  "")) ;_ end of progn
        (progn ;; фиксированнная высота
          (vl-cmdf "_.TEXT" "0,0" 0 txt (rtos res 2 num))) ;_ end of progn
         )
      (command "_.copybase" "0,0" (entlast) "" "_.erase" (entlast) "" "_.pasteclip" pause) 
      ) ;_ end of progn
     (progn
       (TTC_Paste (rtos res 2 num) nil)
       )
    ) ;_ end of if
    )
   (princ) 
  )

VVA · 04.08.2008, 17:53

Код:

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

;;;http://dwg.ru/f/showthread.php?t=16987&page=3
;|
  Назначение:  Суммирование Тектса,Мтекста, Размеров указанием или рамкой.
               Угловые размеры игнорируются
  Особенности: Безразлична к разделителям точка или запятая. 
               Ввиду особенности работы atof стоки вида "22.3мама" 
               будут учтены как число 22.3
 
               При выводе результата число округляется в соответствии 
               с значением переменной num.
|;
;;;what - операция + или *
;;;newtext - t - новый текст, nil - указать текст
;;; num - количество знаков после запятой, nil - переменная LUPREC
(defun operate_text ( what newtext num / res selset ins_pt txt_height blk obj ed *error*)
  (defun *error* (msg)
    (setvar "NOMUTT" 0)  ;_ Восстанавливаем NOMUTT, Что плохого в NOMUTT?
    (princ msg)
    )
 (vl-load-com)(if (eq what '*)(setq res 1.)(setq res 0.)); Здесь все понятно)
  (if (null num)(setq num (getvar "LUPREC")))
 (princ "\nВыберите тексты или размеры: ")
  (setvar "NOMUTT" 1)  ;_ Отключаем NOMUTT
  (setq selset (ssget '((0 . "TEXT,MTEXT,*DIMENSION"))))
  (setvar "NOMUTT" 0)  ;_ Восстанавливаем NOMUTT
 (if  selset
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)));;; если что то выбрали, то поочередно|
    								      ;;; каждый !!!!элемент!!!! превратить в vla объект записать
      								      ;;; в набор obj
      								      ;;; Но не каждый элемент а иена типа <Entity name: 756a89f8>
     (setq obj (vlax-ename->vla-object ent); теперь это не <Entity name: 756a89f8>... а что то типа #<VLA-OBJECT IAcadMText2 1a5c0c04>
           ed (entget ent);;; а здесь список с характеристиками примитивов
           ) 
     (if (and (wcmatch (cdr(assoc 0 ed)) "*DIMENSION")
              (or
                (member '(100 . "AcDbAlignedDimension") ed)  ;_Параллельный или линейный
                (member '(100 . "AcDbDiametricDimension") ed);_Диаметр
                (member '(100 . "AcDbRadialDimension") ed)   ;_Радиус
                (member '(100 . "AcDbArcDimension") ed)      ;_Дуговой
                )
              );;; если выбраны размеры, то->
               ;;;->VVA Размеры представляют собой анонимные блоки
               
       (progn
         (setq blk ;;;->VVAБерем описание этого блока в таблице Блоков
             (vla-item (vla-get-blocks
                         (vla-get-activedocument (vlax-get-acad-object))
                       ) ;_ end of vla-get-Blocks, запоминает все блоки в документе
                       (cdr (assoc 2 ed));;; Из всех блоков извлекает имя (тег) атрибута и записивыет списком в blk
             ) ;_ end of vla-item
      ) ;_ end of setq
      (vlax-for item blk ;;;->VVA Перебираем состав блока в поисках Мтекста
        (if (= (vla-get-objectname item) "AcDbMText");;;->VVA Если Мтекст
          (setq obj item) ;;;->VVA Запоминаем в obj
          )
         )
       )
       );;;Отсюда вообще ничего не понял(((
     (if (vlax-property-available-p obj 'Textstring) ;;;->VVA Если в объетке obj есть свойсво Textstring (значение текста)
       (progn
     (setq str (str-str-lst (vla-get-textstring obj) "\\P") ;;;->VVA Запоминаем в список с разбивкой на абзацы
     str (mapcar '(lambda(x)(mip_mtext_unformat x)) str)    ;;;->VVA Убираем форматирование
      str (mapcar '(lambda(x)(vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t"   x))) str) ;;;->VVA Заменяем запятую на точку
      str (mapcar '(lambda(x)(vl-string-trim  "%UuoOcC \t"   x)) str) ;;;->VVA Убираем последовательностьи %%u %%c
     res ((eval what) res (apply what (mapcar 'atof str)))) ;;;->VVA Выполняем опеоацию ( в what содержится или + или *
     )
       )
      ) ;_ end of foreach 
    ) ;_ end of if 
  (princ "\nРезультат=")(princ (rtos res 2 num)) ;;;->VVA Печатаем
  
  (if (not (equal res 0. 1e-3))  ;;;->VVA Если результат не 0 то в зависимости от флага newtext
    (if newtext
    (progn   ;;;->VVA Заносим результат в новый текст
      (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0) ;_ end of =
        (progn ;; нулевая высота текста
   (if (not (setq txt_height (getreal "\nВведите высоту текста <250> : ")))(setq txt_height 250.)) 
(vl-cmdf "_-MTEXT" "_non" "0,0" "_J" "_BC" "_H" txt_height "_W" 0 (rtos res 2 num)  "")) ;_ end of progn
        (progn ;; фиксированнная высота
          (vl-cmdf "_.TEXT" "0,0" 0 txt (rtos res 2 num))) ;_ end of progn
         )
      (command "_.copybase" "0,0" (entlast) "" "_.erase" (entlast) "" "_.pasteclip" pause) 
      ) ;_ end of progn
     (progn ;;;->VVA Или копируем в существующий
       (TTC_Paste (rtos res 2 num) nil)
       )
    ) ;_ end of if
    )
   (princ) 
  )

Kostinok · 05.08.2008, 09:47

VVA,
Спасибо!
Посмотрите пожалуйста еще один Lisp.
Задача все выбранные мтексты на рисунке сделать высотой 250, с выравниванием middle center и шириной 0. Нарисовать относительно точки привязки текста circle радиусом 250.

Код:

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

(defun c:rcl ( / selset ent ed *error*)
  (defun *error* (msg)
    (setvar "NOMUTT" 0)  ;_ Восстанавливаем NOMUTT, Что плохого в NOMUTT?
    (princ msg)
    )
 (vl-load-com)
 (princ "\nВыберите Mтексты: ")
    (setq selset (ssget '((0 . "MTEXT"))))
   (if  selset
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
      (setq ed (entget ent))
      (setq ed (subst (cons 41 0) (assoc 41 ed) ed))
      (setq ed (subst (cons 71 5) (assoc 71 ed) ed))
      (setq ed (subst (cons 40 250.) (assoc 40 ed) ed))
      (entmod ed)
      (entmake '((0 . "CIRCLE") (assoc 10 ed) (40 . 300.)))
))
(princ)
  )

Подскажите пожалуйста что не верно!

Забыл: Еще что бы создавал на слое Osi с типом линии Continious и цветом By Layer

CB · 05.08.2008, 14:25

Код:

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

(defun c:rcl (/ selset ent ed *error*)
  (defun *error* (msg)
    (setvar "NOMUTT" 0) ;_ Восстанавливаем NOMUTT, Что плохого в NOMUTT?
    (princ msg)
  ) ;_ end of defun
  (vl-load-com)
  (princ "\nВыберите Mтексты: ")
  (setq selset (ssget '((0 . "MTEXT"))))
  (if selset
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
      (setq ed (entget ent))
      (setq ed (subst (cons 41 0) (assoc 41 ed) ed))
      (setq ed (subst (cons 71 5) (assoc 71 ed) ed))
      (setq ed (subst (cons 40 250.) (assoc 40 ed) ed))
      (entmod ed)
      (entmakex	(list
		  '(0 . "CIRCLE")
		  (assoc 10 ed)
		  '(40 . 300.)
		  '(6 . "Continuous")
		  '(62 . 256)
		  '(8 . "Osi")
		) ;_ end of list
      ) ;_ end of entmake
    ) ;_ end of foreach
    (princ)
  ) ;_ end of if
) ;_ end of defun

Kostinok · 05.08.2008, 14:56

CB,
Спасибо, понял пичиму не вышло у меня.

01.08.2008, 11:35		#1
Справочник типа .chm по функциям LISP Kostinok Инженер-электрик Калининград Регистрация: 13.10.2007 Сообщений: 151 Если у кого нибудь есть подобная, очень нужная, на русском языке ВЕЩЬ!!!! Пожалуйста скиньте. В интернете сидеть дорого, хотелось бы пользоваться и в offline. Заранее благодарен! __________________ Можно сопротивляться вторжению армий, вторжению идей сопротивляться невозможно. /В. Гюго/
Просмотров: 5446

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Создание нового типа линий	Apelsinov	AutoCAD	915	08.07.2022 12:36
lisp : проверка наличия типа линии в файле	Кулик Алексей aka kpblc	LISP	4	21.06.2005 08:04
ГОСТ на ванты и оттяжки ???	зщцук?	Поиск литературы, чертежей, моделей и прочих материалов	1	17.05.2005 06:53