[Red Nova]

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (Visual foxpro) программку типа суммирования столбцов списал у соседа (это уже в университете).
Не смотря на эте намерен научится писать программы для Автокада на лиспе, скачал книгу Хювенена, несколько примеров создания программ, но после получасового “смотрения” таких книг мое мышление явно притормаживает.
Решил пойти другим путем.
Нашел самый короткий лисп из моей коллекции, и прошу программистов с этого форума пошагово объяснить какой символ что означает. Надеюсь на вашу помощь.

Код:

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

(defun c:make-blocks-explodeable (/ adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (and (equal (vla-get-isxref blk_def) :vlax-false)
             (equal (vla-get-islayout blk_def) :vlax-false)
             ) ;_ end of and
      (vl-catch-all-apply '(lambda () (vla-put-explodable blk_def :vlax-true)))
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

_____________________________________________________________________________________________________________

Прошло много лет и топик теперь представляет из себя площадку для обучения азов программирования для многих начинающих.
Так что начинающие лиспогрызы приветствуются .

[Дима_]

block - это описание блока (то что ты открываешь в редакторе блоков), а insert это вставка описания

[Do$]

Сообщение от Frigate А что же тогда значат DXF коды самого объекта “BLOCK”

Я об объекте "BLOCK" впервые слышу.

Сообщение от Frigate Причем там есть интересный такой код, под кодом 3 - тоже "Block name", как и код 2. Что это?

Код:

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

((-1 . <Entity name: 7eea9098>) (0 . "INSERT") (330 
. <Entity name: 7ee4acf8>) (5 . "46883") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "НОВЫЕ") (100 . "AcDbBlockReference") (2 . "зигзаг") (10 -19468.9 
-34548.6 0.0) (41 . 0.5) (42 . 0.5) (43 . 0.75) (50 . 3.14159) (70 . 0) (71 . 
0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))

Типичный entget-список для вхождения блока - нет тут 3-й группы.

Сообщение от Frigate Я пока переменную, которой присвоет набор, приравниваю сначала к "0", а затем к nil (сразу nil не присваивается).

Такого быть не должно!

[Disney]

Сообщение от Do$ Типичный entget-список для вхождения блока - нет тут 3-й группы.

У Insert нету, а вот у block есть, только зачем два "Block name"

[Do$]

Я почему-то думал, что в таблице блоков описания тоже как INSERT хранятся - забыл уже, давно не трогал

[alex8888]

Помогите, пожалуйста разобраться со свойством Alignment для объекта текст. Как мне получить, точнее задать дополнительную точку для выравнивания текста, а то как и положено, текст ускакивает в точку 0,0

Текст добавляю методом Vla-AddText, хотелось бы, что бы он попадал в заданную точку именно своим центром (аттрибут 4 - acAlignmentMiddle), а не левым нижним углом.

[ShaggyDoc]

Сообщение от alex8888 Помогите, пожалуйста разобраться со свойством Alignment для объекта текст. Как мне получить, точнее задать дополнительную точку для выравнивания текста, а то как и положено, текст ускакивает в точку 0,0 Текст добавляю методом Vla-AddText, хотелось бы, что бы он попадал в заданную точку именно своим центром (аттрибут 4 - acAlignmentMiddle), а не левым нижним углом.

Смотри как сделано в функции. Текст сначала добавляется, а потом у него устанавливаются требуемые свойства. Это обычный прием при работе с объектами:

Код:

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

(defun ru-text-add (txt pnt height rotation justification / obj)
;;;
  ;|
ВНИМАНИЕ! для выравнивания A или F передается не точка текста, а список из двух точек!!

 0 acAlignmentLeft 
 1 acAlignmentCenter 
 2 acAlignmentRight 
 3 acAlignmentAligned 
 4 acAlignmentMiddle 
 5 acAlignmentFit 
 6 acAlignmentTopLeft 
 7 acAlignmentTopCenter 
 8 acAlignmentTopRight 
 9 acAlignmentMiddleLeft 
10 acAlignmentMiddleCenter 
11 acAlignmentMiddleRight 
12 acAlignmentBottomLeft 
13 acAlignmentBottomCenter 
14 acAlignmentBottomRight
|;
  (if (null justification)
    (setq justification acalignmentleft)
  ) ;_ end of if
  (ru-error-catch
    (function
      (lambda ()
        (setq
          obj
           (vla-addtext
             (ru-obj-active-space)
             txt
             (if
               (or (= justification acalignmentaligned)
                   (= justification acalignmentfit)
               ) ;_ end of or
                (vlax-3d-point (car pnt))
                (vlax-3d-point pnt)
             ) ;_ end of if
             height
           ) ;_ end of vla-AddText
        ) ;_ end of setq
        (ru-lw-set-for-obj obj (ru-lw-calc-for-text height))
        (cond
          ((= justification acalignmentleft)
           (vla-put-rotation obj rotation)
          )
          ((or (= justification acalignmentaligned)
               (= justification acalignmentfit)
           ) ;_ end of or
           (vla-put-alignment obj justification)
           (vla-put-textalignmentpoint
             obj
             (vlax-3d-point (cadr pnt))
           ) ;_ end of vla-put-textalignmentpoint
          )
          (t
           (vla-put-alignment obj justification)
           (vla-put-textalignmentpoint obj (vlax-3d-point pnt))
           (vla-put-rotation obj rotation)
          )
        ) ;_ end of cond
        (vla-update obj)
        obj
      ) ;_ end of lambda
    ) ;_ end of cond
    (function (lambda (x) (princ (strcat "\nОШИБКА RU-TEXT-ADD: " x)) nil))
  ) ;_ end of ru-error-catch
) ;_ end of defun

[alex8888]

ShaggyDoc, я вроде бы так и делал, только упрощенно

Все, понял, надо ввести точку вот таким макаром:
(vla-put-alignment insert_text acAlignmentMiddle)
(vla-put-textalignmentpoint insert_text insert_point)

Спасибо!

[alex8888]

ShaggyDoc, объясни, пожалуйста, как работает твоя конструкция:

Код:

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

(if (null justification)
    (setq justification acalignmentleft)
  ) ;_ end of if

Если опускаю аргумент justification при задании функции - пишет ошибка-мало параметров. Я как понимаю это необязательный параметр и если он не задан, то принимается значение по умолчанию.
Пробовал поэкспериментировать таким образом и со своей программой, результат тот же - мало параметров. Есть возможность как то обойти такую неприятность?

[ShaggyDoc]

Сообщение от alex8888 ShaggyDoc, объясни, пожалуйста, как работает твоя конструкция: Код: [Выделить все] (if (null justification) (setq justification acalignmentleft) ) ;_ end of if Если опускаю аргумент justification при задании функции - пишет ошибка-мало параметров. Я как понимаю это необязательный параметр и если он не задан, то принимается значение по умолчанию. Пробовал поэкспериментировать таким образом и со своей программой, результат тот же - мало параметров. Есть возможность как то обойти такую неприятность?

Количество аргументов в LISP-функциях должно быть именно таким, как указано в объявлениях функции!

Когда требуется заведомо переменное количество каких-то аргументв, их можно передать списком. Список будет одним аргументом для функции, его надо анализировать внутри.

В разбираемой функции вместо аргумента justification можно передать NIL в качестве аргумента, тогда внутри функции аргументу будет присвоено значение по умолчанию acalignmentleft. Но опускать аргумент нельзя.

[alex8888]

Ага, теперь понял

Ну вот, опять

Код:

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

_$ (setq a "120")
"120"
_$ (type a)
STR
_$ (if (= (type a) STR)(setq b (atof a)))
nil
_$ b
nil
_$

Кто может подсказать, что не нравится функции IF?

[ShaggyDoc]

Кто может подсказать, что не нравится функции IF?

То, что ты неправильно написал Сравниваешь "зеленое с квадратным". Догадайся сам, лучше запомнится. Выполни (type a) и (type STR) и увидишь разницу. Или (print STR), т.е. посмотри, что с чем сравниваешь.

Ну, ладно, надо писать (= (type a) 'STR)

[alex8888]

ShaggyDoc,
ну вот голову сломал, а теперь дошло, ведь получается, я как бы переменную STR задаю, а не тип. Вот ведь идиот
Спасибо за помощь, сам бы еще вечность думал бы.

[Frigate]

ПОдскажите, пожалуйста, в таком вопросе:

поняв, что EffectiveName менять нельзя, поменял для всех блоков Name (в том числе и для блоков с "*Ux").
То есть теперь в программах можно обращаться к Name, я верно понимаю?
Проверил еще раз - все блоки отлично переименовываются.

Нет ли здесь каких подводных камней?

[alex8888]

ShaggyDoc, не будешь против, если я твои функции буду у себя в программах использовать?

Если нет, то можешь посмотреть у меня в коде, правильность использования "ru-error-catch", да и вообще сам код? Это моя "почти" первая попытка в ООП.

Код:

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

;|****************************************************************************
*                                                                            *
*            Модуль вставки текста                                           *
*                                                                            *
*   Пример вызова:                                                           *
*         (at_text (list ptm "сам текст" "schrift" 30 nil 4))                *
*                 где ptm - точка вставки текста, обязательный параметр      *
*                     "сам текст" - текст сообщения, обязательный параметр   *
*                     "schrift" - слой для текста,  nil = "schrift"          *
*                     30 - высота текста, nil = 30                           *
*                     nil  - угол поворота текста в градусах, nil = 0        *
*                     4  - выравнивание, nil = acAlignmentMiddle             *
*                                                                            *
*      Составлен 20.07.2010  Автор:        alex8888                          *
*      Изменения    20.09.2010-23.09.2010                                    *
*                                                                            *
******************************************************************************|;

(defun at_text (text_list	/		insert_point
		insert_text	text_layer	text_hoehe
		text_winkel	text_alignment	text_obj
	       )

;-------------------- Загрузка расширений -----------------------------------

  (vl-load-com)
  (begin_activex)
  (at_create_layer)
  
;-------------------- Разбор входящего списка -------------------------------
  
  (setq	insert_point   (nth 0 text_list)
	insert_text    (nth 1 text_list)
	text_layer     (nth 2 text_list)
	text_hoehe     (nth 3 text_list)
	text_winkel    (nth 4 text_list)
	text_alignment (nth 5 text_list)
  )					;setq

;--------- Анализ входящих и получение значений по умолчанию ----------------

  (if (= insert_point nil)
    (progn
      (alert "\nERROR: Nicht angegeben Punkt ")
      (exit)
    )					;progn
  )					;if

  (if (= insert_text nil)
    (progn
      (alert "\nERROR: Keine Text gefunden ")
      (exit)
    )					;progn
  )					;if

(if (or (= text_layer nil)
    	(null (tblsearch "layer" text_layer))
     );or
    	(setq text_layer "schrift")
);if

  (if (= text_hoehe nil)
    (setq text_hoehe 30)
  )
  (if (= text_winkel nil)
    (setq text_winkel 0)
  )
  (if (= text_alignment nil)
    (setq text_alignment 4)
  )
  
  (if (= (type text_winkel) 'STR)
    (setq text_winkel (atof text_winkel))
  )					;if
  (if (= (type text_hoehe) 'STR)
    (setq text_hoehe (atof text_hoehe))
  )					;if
  (if (= (type insert_point) 'LIST)
    (setq insert_point (vlax-3d-point insert_point))
  )					;if

;-------------------- Тело функции ---------------------------------------
  
  (ru-error-catch
    (function
      (lambda ()
	(setq text_winkel (degrees_to_radians text_winkel)
	      text_obj	  (vla-addtext
			    model_space
			    insert_text
			    insert_point
			    text_hoehe
			  );vla-addtext
	);setq
	(vla-put-alignment text_obj text_alignment) ;см. Выравнивание
	(vla-put-textalignmentpoint text_obj insert_point)
	(vla-put-layer text_obj text_layer)
	(vla-put-color text_obj 256)
	(vla-put-Rotation text_obj text_winkel)
	(vla-update text_obj)
      )	;lambda
    );function
    (function
      (lambda (x)
	(princ (strcat "\nFunktion at_text ERROR: " x))
	nil
      );lambda
    );function
  );ru-error-catch

  (princ)
);defun

;----------------------- Памятка ---------------------------------------

;Выравнивание:
; 0 acAlignmentLeft 
; 1 acAlignmentCenter 
; 2 acAlignmentRight 
; 3 acAlignmentAligned 
; 4 acAlignmentMiddle 
; 5 acAlignmentFit 
; 6 acAlignmentTopLeft 
; 7 acAlignmentTopCenter 
; 8 acAlignmentTopRight 
; 9 acAlignmentMiddleLeft 
; 10 acAlignmentMiddleCenter 
; 11 acAlignmentMiddleRight 
; 12 acAlignmentBottomLeft 
; 13 acAlignmentBottomCenter 
; 14 acAlignmentBottomRight

[Frigate]

Сообщение от alex8888 ПОдскажите, пожалуйста, в таком вопросе: поняв, что EffectiveName менять нельзя, поменял для всех блоков Name (в том числе и для блоков с "*Ux"). То есть теперь в программах можно обращаться к Name, я верно понимаю? Проверил еще раз - все блоки отлично переименовываются. Нет ли здесь каких подводных камней?

и еще 3 вопроса появилось у меня :-) (аппетит приходит во время еды)

1. vla-explode взрывает выбранный блок, но странно как-то – выбранный блок остается, но поверх него мы получаем взорванный блок??? Это так и должно быть???

2. На этом форуме (или схожих) видел чертеж, где были очень интересные блоки. При попытке открыть их редактором пишет :

«Блок содержит объекты-заместители. Не может быть открыт редактором.». Что это за блок такой? Как создать такой блок?

3. Словари в чертежах. Можете дать ссылку на описание, что это такое? Как они хранятся в чертеже? Насколько это надежный источник для хранения пользовательских данных?

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

1. Да, так и должно быть. ОБъект блока надо удалять программно.
2. Наверняка прокси-объекты и отсутствует соответствующий ObjectEnabler
3. Достаточно надежный. Без определенной квалификации добраться до них невозможно (хотя зачастую вопрос "как снести" решается на ура)

[VVA]

Сообщение от Frigate 3. Словари в чертежах. Можете дать ссылку на описание, что это такое? Как они хранятся в чертеже?

Спроси у гугла про vlax-ldada-*
Некоторые примеры есть здесь с поста #27
Еще подборка (требуется регистрация)

[ShaggyDoc]

ShaggyDoc, не будешь против, если я твои функции буду у себя в программах использовать?

Если я их публикую, значит не против "по умолчанию".

В дополнение к #1016.

Надежность хранения данных в словарях такая же, как и всего остального.

А вот надежность создания, изменения, удаления данных из словарей зависти от используемых функций. Штатных недостаточно, необходим примерно десяток дополнительных - чтобы было удобно работать.

Как именно словари хранятся - фирменный секрет. Впрочем, как и всё остальное в DWG. Формат официально закрыт, все сведения получаются "разведывательными" методами. Конечного программиста не должно волновать, "как они хранятся". Важно другое - "как с ними работать".

[Frigate]

Благодарю за ответы.

До пратики со словарями я еще не дошел, но уже много инфы отсортировал, в том числе и разных программ от местных гуру :-)

Сегодня разюирался с тем, как наиболее безболезненно вешать код программ на кнопки. В итоге, методом проб и ошибок, понял кое-что. Прошу подтвердить или опровергнуть мои выводы.

Итак, понял, что для сохранности код от "очумелых ручек" на данном этапе внедрения своих программок в наш отдел, буду пользоваться vlx скомпилированным файлом всех вункций и программ. ПРоверил на 2-х программах. После первого вызова файла, все функции сразу становятся доступными. Теперь понимаю, как можно организовать общую библиотеку, о чем, кстати, в форуме читал дебатов немало.

НАсколько верные выводы?

[gomer]

Сообщение от Frigate на данном этапе внедрения своих программок в наш отдел, буду пользоваться vlx скомпилированным файлом всех вункций и программ

Не спешите компилировать ради собственно компиляции или чтоб собрать все в кучу... наверняка вас попросят что-нибудь подредактировать... с другой стороны... для любопытных... если что-то перестало работать... переустановка лисп-библиотек плевое дело...

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

Я вообще-то говорил про то, что при некоторых операциях, таких, как _.wblock, можно запросто "потерять" свои словари.
P.S. Скорость выполнения компилированного кода может в разы превышать скорость выполнения некомпилированного...

[gomer]

Сообщение от Кулик Алексей aka kpblc Скорость выполнения компилированного кода может в разы превышать скорость выполнения некомпилированного...

Это понятно... Но сколько не умножай условный ноль на разы все равно ноль и получится, но одна лишь функция ssget или другие подобные, может уменьшить скорость в сотни раз... те человеческий фактор сильно влияет на производительность...
Еще непродуманный диалоговый интерфейс...

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

gomer, ну ты еще сюда и время на включение компьютера добавь, а еще и установку с запуском и настройкой AutoCAD'a... Совсем все медленно получится.

[Frigate]

Можно еще вопрос?

Про такой свойство объектов, как password. Что этот пароль дает? Если его поставить на чертеж, то чертеж уже нельзя будет изменять? Или вообще просматривать? А если поставить пароль на блок, то что это даст? :-)

[gomer]

А почитать справку? Ни у документа, ни у блока нет такого свойства, как password

Сообщение от Кулик Алексей aka kpblc сюда и время на включение компьютера добавь, а еще и установку с запуском и настройкой AutoCAD'a... Совсем все медленно получится.

Интересно.... если загрузить все и сразу... как это скажется на производительности...

[Frigate]

а это что тогда?

Код:

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

Sub Example_Password()    ' This example opens a password-protected file, closes it, and then opens another
    ' password-protected file.
 
    ThisDrawing.Application.Documents.Open "C:\MyDrawing.dwg", , "MYPASSWORD"
    'AutoCAD converts all passwords to uppercase before applying them
 
    ThisDrawing.Close
 
    ThisDrawing.Application.Documents.Open "C:\MyDrawing2.dwg", , "MYSECONDPASSWORD"
 
End Sub

ну, с блоками эт я погорячился просто )))

А реально есть ли какой способ защитить блоки от редактирования??? Чтобы можно было снять только программно.

Подскажите, пожалуйста, по функции из ru_CAD, приведенной на сайте ru_CADа:

Код:

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

;;; Листинг 10.43. Функция ru-list-massoc
(defun ru-list-massoc (key alist)
;;; Пример:(ru-list-massoc 10 (entget (car (entsel))))
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist))
) ;_ end of defun

а дальше идет описание, что делает функция lambda и уже приводится такой код

Код:

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

(lambda (x) (if (= key (car x)) x))

мне кажется он верный, а не тот, что в функции:

Код:

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

(lambda (x) (= key (car x))))

Я прав? Может просто опечатка?

И еще вопрос - для чего именно нужна функция function - только для компиляции и оптимизацией кода? Ведь и без function все должно работать в лисп-файле. ИЛи я не так понял? Тогда прошу объяснить.

[Do$]

Все понятно: и из названия, и пример использования есть. Что подсказать то?

Код:

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

;;; Листинг 10.43. Функция ru-list-massoc
(defun ru-list-massoc (key alist)
;;; Пример:(ru-list-massoc 10 (entget (car (entsel))))
  (mapcar 'cdr
	  (vl-remove-if-not
	    (function (lambda (x) (= key (car x))))
	    alist
	  ) ;_ end of vl-remove-if-not
  ) ;_ end of mapcar
) ;_ end of defun

[Frigate]

посмотрите, пожалуйста, еще раз - я просто не сразу свои вопросы описал - есть добавление в мой предыдущий пост

[Disney]

Сообщение от Frigate И еще вопрос - для чего именно нужна функция function - только для компиляции и оптимизацией кода?

Скорее всего, да. Разница между ‘ и function
Но мне лень писать слово function, и в надежде, что у меня программки маленькие и лёгкие, я пишу

Код:

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

;;; Листинг 10.43. Функция ru-list-massoc
(defun ru-list-massoc (key alist)
;;; Пример:(ru-list-massoc 10 (entget (car (entsel))))
  (mapcar 'cdr
	  (vl-remove-if-not
	    '(lambda (x) (= key (car x)))
	    alist
	  ) ;_ end of vl-remove-if-not
  ) ;_ end of mapcar
) ;_ end of defun

[Frigate]

Disney

спасибо за ссылку, теперь я понял, что именно для оптимизации кода и нужна function



Подумал тут... эти 2 кода равнозначны, что ли

(lambda (x) (if (= key (car x)) x))

и

(lambda (x) (= key (car x))))

???

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

Не совсем. Первый вариант вернет в случае успеха значение х, второй же - всего лишь t.

[Do$]

Правильнее использовать второй вариант, и быстрее работать будет.
Кстати, они не всегда nil одновременно возвращают:

Код:

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

_$ (setq key nil x nil)
nil
_$ (if (= key (car x)) x)
nil
_$ (= key (car x))
T
_$

[Frigate]

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

спасибо, Алексей, а то неверно код расшифровывал, вот и была сумятица в голове... в общем это ошибка на сайте ru_CAD.


Можете подсказать что делает функция logior. Справку читал - не помогло ) Слишком все коротко и смутно:

Returns the result of the logical bitwise inclusive OR of a list of integers

что делает функция - разобрался, но вот ее назначение в коде для меня пока туман...

Что конктерно эта функция делает в этом коде, подскажите, пожалуйста

Код:

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

Листинг 10.4. Создание полилинии объектными методами
(defun example ()
  (vla-put-closed
    (vla-addlightweightpolyline
      (vla-get-modelspace
 (vla-get-activedocument (vlax-get-acad-object))
      ) ;_ end of vla-get-ModelSpace
      (vlax-make-variant
 (vlax-safearray-fill
   (vlax-make-safearray vlax-vbdouble '(0 . 7))
   (list 0.0 0.0 100.0 0.0 100.0 -50.0 0.0 -50.0)
 ) ;_ end of vlax-safearray-fill
 (logior vlax-vbarray vlax-vbdouble)
      ) ;_ end of vlax-make-variant
    ) ;_ end of vla-addlightweightpolyline
    :vlax-true
  ) ;_ end of vla-put-closed
) ;_ end of defun

[Do$]

Сообщение от Frigate Что конктерно эта функция делает в этом коде, подскажите, пожалуйста

Чистой воды "понт"
Можно смело заменить на функцию +
P.S. Смотри функцию vlax-make-variant и константы, обозначающие типы вариантов.

[Frigate]

т.е. я могу здсь просто поставить

(+vlax-vbDouble vlax-vbArray)

?

Кстати в справке почему-то в примере присваивания variant массива не используется аргумент "тип"... Может и так будет работать? Попробую ща все варианты...

[ShaggyDoc]

Чистой воды "понт"

Это "Чтоб никто не догадался" (С).
Можно и "смело заменить". Но потом когда-то и наткнуться на последствия.

Подумал тут... эти 2 кода равнозначны, что ли (lambda (x) (if (= key (car x)) x)) и (lambda (x) (= key (car x))))

Конечно, не равнозначны. Не забываем также, что такие функции могут использоваться и внутри других функций.

По поводу function правильно объяснено по ссылке у Алексея
Но главное - компиляция. Да ещё раньше был другой вид компиляции в файлы формата BI2 и BI4. Вот там применение function было вообще обязательным. А в ruCAD многие функции еще от версии R10 остаются.

[Frigate]

ShaggyDoc ,

объясните пожалуйста нам, неучам, что ж за хитрость зарыта в этой строке и чем может грозить пропуск ее?

Еще раз повторю, что согласно примеру справке в АКАДе, вообще не используют тип в функции vlax-make-variant, предоставляя, судя по всему, функции выбирать самой тип данных.
Это тоже, наверное, может грозить сбоем в самый неожиданный момент...

Сидим и ждем умных разъяснений :-)

Просто хочется понять, где ж написано было, что именно таком образом надо "складывать" типы переменных. В справке? Можно ткнуть носом в раздел? Вообще в источник? :-)


Дополнение - еще раз перечитал справку... по умолчанию (без указания типа данных) vlax-make-variant для safearray поставит тип данных vbArray. Судя по логике, если вставлять такое выражение

Код:

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

logior vlax-vbarray vlax-vbdouble)

то мы предусматриваем возможность, что тип variant будет или Double или Array. А зачем так делать? Поделитесь, пожалуйста, сокровенными знаниями, доступными лишь гуру?

Что-то уже больше часа бь.сь и никак не могу присвоить верхней границе массива переменную...

вот

Код:

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

 
(setq tst1 12)
(setq tst1 (vlax-make-variant tst1 vlax-vbInteger))
(setq array (vlax-make-safearray vlax-vbDouble '(0 . tst1)))

в ответ получаю в комстроке

; ошибка: неверный тип аргумента: fixnump: TST1

Что делать?

Когда вводишь вместо верхней границы просто число, то все ок, а так... Какой эе тип данных должен быть, если не Integer???

[Do$]

Сообщение от Frigate то мы предусматриваем возможность, что тип variant будет или Double или Array

Незачет. Тип варианта будет: массив (array) из вещественных чисел двойной точности (double).

Код:

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

(setq tst1 12)
(setq array (vlax-make-safearray vlax-vbDouble (cons 0 tst1)))

[ShaggyDoc]

Поделитесь, пожалуйста, сокровенными знаниями, доступными лишь гуру?

А зачем это мне? Уж разберись сам в разнице между арифметическим сложением и действием побитового включающего ИЛИ над списком чисел. Мне-то все равно не поверишь.

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

Как сказать
Да, кстати! ShaggyDoc, прошу поправить меня, если я ошибаюсь (достаточно будет просто сказать, что я неправ):
logior -> операция поразрядного ИЛИ. Работает только над целыми числами. Результат - целое число.
Например:

Код:

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

(logior 10 12 1)

преобразовывается в

Код:

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

logior
1010
1100
0001

В результате получаем:

Код:

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

1111

то есть 15.
Аналогично с logand:

Код:

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

(logand 10 12 1) ; ->
1010
1100
0001

Выполняя логическое И (то есть все три раза в каждом разряде должно быть по 1), получаем на выходе 0000, то есть 0. Так?

[ShaggyDoc]

ShaggyDoc, прошу поправить меня, если я ошибаюсь

Алексей, ну ты слишком умный. С тобой неинтересно Ты по битам начал раскладывать.... Как настоящий программист. А обычному инженеру таких деталей можно и не знать, но понимать "физический" смысл подобных функций.

Вот про "понты". Есть формула площади прямоугольника A*B. Допустим, A и B равны 2. Зная, что 2*2=4 и 2+2=4 некоторые могут сделать вывод, что в формулу можно поставить сложение. Для частного случая результат будет правильный, но методически - неверно.

Что делает logior если объяснять "по-крестьянски"?
Эта функция формирует из переданных целых чисел (назовем их битами) некое число (флаг), анализируя которое можно узнать, какие биты в него входят. Биты должны быть из ряда 0 1 2 4 8 16 ....

Пример

Код:

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

(setq человек? 1
      мужик? 2
      умный? 4
      богатый? 8
)      

(setq некто_1 (logior человек? мужик? умный? богатый?)) ;; > 15
(setq некто_2 (logior человек? мужик?  богатый?))  ;; > 11
(setq некто_3 (logior умный?))  ;; > 4
(setq некто_4 (logior человек? умный?))  ;; > 5

Мы занесли характеристики каких-то "биообъектов". Теперь мы можем узнать их характеристики хоть списком, хоть по отдельности. Для удобства нарисуем пару высокоуровневых функций для работы с "битовой арифметикой"

Код:

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

(defun ru-match-is-bit-in-flag (bit flag)
  ;; проверяет, есть ли bit в числе flag
    (= (logand bit flag) flag)
)

(defun ru-match-bit-list (int_number / i result)
    ;; возвращает список битовых значений целого числа  
    (setq i 1)
    (while (>= int_number i)
	(if (= i (logand i int_number))
	    (setq result (cons i result))
	) ;_ end of if
	(setq i (lsh i 1))
    ) ;_ end of while
    result
) ;_ end of defun

Применим их (сначала получая список, а потом проверяя отдельные значения):

Код:

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

(setq bit_list_1 (ru-match-bit-list некто_1)) ;; (8 4 2 1)
(setq bit_list_2 (ru-match-bit-list некто_2)) ;; (8 2 1)  
(setq bit_list_3 (ru-match-bit-list некто_3)) ;; (4)
(setq bit_list_4 (ru-match-bit-list некто_4)) ;;  (4 1)

(ru-match-is-bit-in-flag мужик? некто_1) ;; >t
(ru-match-is-bit-in-flag умный? некто_1) ;; >t
(ru-match-is-bit-in-flag умный? некто_2) ;; nil
(ru-match-is-bit-in-flag мужик? некто_4) ;; nil
(ru-match-is-bit-in-flag умный? некто_4) ;; T
(ru-match-is-bit-in-flag богатый? некто_4) ;; nil

Написав еще штук 5 подобных функций, мы спрячем все необходимые действия (добавление, изменение битов и т.п.) за понятными названиями и можем применять их многократно. Забыв про "страшные" logior, logand, lzh.

[Do$]

Сообщение от ShaggyDoc Есть формула площади прямоугольника A*B. Допустим, A и B равны 2. Зная, что 2*2=4 и 2+2=4 некоторые могут сделать вывод, что в формулу можно поставить сложение. Для частного случая результат будет правильный, но методически - неверно.

Это ответ на мой "понт"? Чтож, заслужил - не надо было так грубо выражаться
Но я останусь при своем мнении - тип данных для массива варианта задается как сумма битового флага массива и битового флага типа элемента массива, каждый из них по отдельности не может включать другой бит (по определению). Поэтому, я считаю, что применение logior именно в этом случае не оправдано.

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

Offtop: ShaggyDoc, ну надо же было закошмарить ситуацию, чтобы получить внятные и ясные объяснения

[Frigate]

Прошу прощения, но про побитовое ИЛИ я то как раз понимаю, Не стоит считать инженеров "недопрограммистами".

Мой вопрос был в другом - почему надо именно так складывать значения констант типов, если в самой справке, к примеру, при присвоении VARIANT безопасного массива из doubles, это вообще пропускается?
Если пропустить, то, в случае преобразования списка точек в координаты для полилинии, все работает безукоризненно. Тогда, как я понимаю, логическое ИЛИ может применяться в других ситуациях при работе с константами Автокада.

Подумал, посчитал... В общем, соглашаюсь с гуру

Вот почему: скажем, нам нужен массив из длинных целых чисел. У Array константа 9, у Long Integer - 3. Если просто суммируем - получим 12. А вот если побитово сложим, то

1001
OR
0011

1011

получим 11 :-)

Для моего случая, когда нужен массив из Doubles

Если складываем: 9+5=14

А побитово

1001
OR
0101

1101 , т.е. 9 OR 5 = 13

Теперь уже и сам убедился.

Копаем дальше.

Если общий флаг типа данных - 1101, то это может быть и 9+5 и 9+4, т.е. либо Double, либо Single... А что и з этого следует? В таком массиве точность станет какой? Как АвтоКАД определит тогда тип данных? Может он все-таки здесь работает не по-битово, а с целыми числами, как с константами? Или, скажем, берет тип данных массив и тип данных его членов (Doubles)?

В общем, вопросов появляется больше, чем ответов.




МОжет потому и нет в справке при создании Variant составного типа массива и Doubles? ;-)

И когда я сам пропускаю этот (logior ...) и этот (+...) в своей функции, то все замечательно считается.

[Do$]

Сообщение от Frigate В общем, не ясно, в какой ситуации (на примере АвтоКАДа!!!) побитовое ИЛИ отличается от сложения?

Есть, к примеру, такая системная переменная - osmode. В ней суммой битов устанавливаются опции привязки (подробнее - в справке). Допустим, текущее значение osmode=9071. Предположим, понадобилось, чтобы была обязательно включена привязка "перпендикуляр" (бит 128) и "середина" (бит 4), при этом не затрагивая остальные привязки.
Нужно определить, содержит ли 9071 значения 128 и 4, и если нет - добавить. Именно это и можно сделать с помощью logior:

Код:

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

(setvar "osmode" (logior (+ 4 128) (getvar "osmode")))

Результат: 9199.
9199-9071=128. То есть, бит 4 присутствовал изначально, а бит 128 добавился.
Здесь сложением logior заменять нельзя.

[Frigate]

Do$

благодарю, про привязки понял.

Посмотри пожалуйста, на мое дополнение к пред. моему сообщению (точнее, я полностью почти изменил сообщение). Там я вопрос задал, и уже не первый раз, про справку автокада. Там не используются в примере общие коды (сумма или logior). И без них кстати полилиния замечательно так создается.

А по поводу привязок все хотел спросить - нужно ли их отключать перед тем, как программно строить полилинию? Если да, то почему? Точнее, какая именно ситуация может вызвать неправильную прорисовку полилинии? Ведь она задается массивом координат. Как же тогда привязки могут на нее повлиять?

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

vlax-make-variant создает тип variant, насколько я понимаю. На основе стандартных типов данных (vbInteger, vbDouble, vbString и т.д.). Не, можно, конечно, из variant сделать еще один variant и так до бесконечности (у попа была собака) - но смысл?
Для преобразования списка координат вида '((0. 0.) (10. 0.) (20. 10.)) в значение, понимаемое vla-addlightweightpolyline, делаем следующее:

Код:

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

(vl-load-com)

(defun test (/ coords len)
  (setq coords '((0. 0.) (10. 0.) (20. 10.)) ;1
        len    (length (apply (function append) coords)) ;2
        ) ;_ end of setq                                 ;3
  (vla-addlightweightpolyline
    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
    (vlax-make-variant
      (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (1- len)))
                           (apply (function append) coords)
                           ) ;_ end of vlax-safearray-fill
      ) ;_ end of vlax-make-variant
    ) ;_ end of vla-addlightweightpolyline
  ) ;_ end of defun

Разбираем последовательно строки, и разбираем по-лисповски

1. Первые три строки не буду разбирать - они и так очевидны.
2. Сначала через vlax-make-safearray создаем массив, задавая его нижнюю и верхнюю границы. Во избежание разных некрасивостей нижнюю границу назначаем в полном соответствии с VBA-подходом, равной 0, а верхнюю - на единицу меньше, чем длина списка.
3. После этого, используя vlax-safearray-fill, заполняем массив
4. И преобразовываем его в variant (vlax-make-variant)
5. Подставляем в vla-addlightweightpolyline и наслаждаемся результатом

---
Пока по рабочим делам бегал, много воды утекло... Может, уже и не надо никому

[Елпанов Евгений]

Сообщение от Frigate А по поводу привязок все хотел спросить - нужно ли их отключать перед тем, как программно строить полилинию? Если да, то почему? Точнее, какая именно ситуация может вызвать неправильную прорисовку полилинии? Ведь она задается массивом координат. Как же тогда привязки могут на нее повлиять?

при полностью программном создании полилинии - не нужно отключать привязки. Например:

Код:

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

(entmakex '((0 . "LWPOLYLINE")
            (100 . "AcDbEntity")
            (100 . "AcDbPolyline")
            (90 . 4)
            (70 . 0)
            (10 0. 0.)
            (10 10. 0.)
            (10 10. 10.)
            (10 0. 10.)
           )
)
(vla-AddLightWeightPolyline
 (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 7))
                                         '(0. 0. 10. 0. 10. 10. 0. 10.)
                    )
 )
)

При использовании командной строки, привязки отключать обязательно!

[Frigate]

Елпанов Евгений,

кратко и емко

Кулик Алексей aka kpblc ,

Алексей,

код-то я как раз уже понимаю и написал его для своей программы. Вопрос в другом :-)
Наверное, я не точно все описал.

Впрочем ясно, что вообще можно не указывать сумму констант типов массив и Double при задании vlax-make-variant.

Вот, кстати, из справки цитата:

Determines the data type of a variant (vlax-variant-type var) Arguments var A variable whose value is a variant. Return Values If var contains a variant, one of the following integers is returned: 0 Uninitialized (vlax-vbEmpty) 1 Contains no valid data (vlax-vbNull) 2 Integer (vlax-vbInteger) 3 Long integer (vlax-vbLong) 4 Single-precision floating-point number (vlax-vbSingle) 5 Double-precision floating-point number (vlax-vbDouble) 8 String (vlax-vbString) 9 Object (vlax-vbObject) 11 Boolean (vlax-vbBoolean) 8192 + n Safearray (vlax-vbArray) of some data type. For example, an array of doubles (vlax-vbDouble) returns 8197 (8192 + 5).

[ShaggyDoc]

При использовании командной строки, привязки отключать обязательно!

Я бы сказал так - при использовании функций command и vl-cmdf. Потому что "использование командной строки" не очень с программированием вяжется. И восстанавливать всегда в прежнее состояние.

Заодно учитывать, что при использовании функций command и vl-cmdf координаты всегда должны быть в текущей ПСК.

При использовании entxxx и объектных методов - всегда в МСК.

Учитывать, что getpoint возвращает координаты в текущей ПСК.

[Дима_]

Сообщение от ShaggyDoc Эта функция формирует из переданных целых чисел (назовем их битами) некое число (флаг), анализируя которое можно узнать, какие биты в него входят.

Безусловно так, но хотелось-бы добавить, что такое применение оправдано, ну скажем в ассемблере (в общем оно там на каждом шагу), гораздо более интересные вещи при помощи логических операций делаются применительно к проверке условий (не спроста они созвучны с or и and) - при правильном подходе (да еще и с применением lsh) - количество проверок сокращается в разы, но это тема для отдельного большого обсуждения.

[gomer]

сложением logior заменять нельзя.

Если складываем: 9+5=14 А побитово 1001 OR 0101 1101 , т.е. 9 OR 5 = 13

я вот так это понимаю...

Код:

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

;;; повторяющийся бит удаляется
(logior 9 5) = (+ (+ 1 8) (+ 1 4))

А чтоб жену выбрать и умную и красивую нужно logand использовать

[Дима_]

что-то с циатами - я такого не писал

[gomer]

Сообщение от Дима_ что-то с циатами - я такого не писал

прошу прощения... не вы...
зы давно уже...

[Frigate]

gomer,

да, я тоже пришел к такому выводу

Задам еще корифеям вопрос:

Если можно, посоветуйте, как сделать:

надо вставлятьТЕКСТ или МТЕКСТ в рамку размером 5 на 10 мм. Чтобы, если он не будет влезать в рамку, коэф-т сжатия текста уменьшился до нужных размеров. Как это реализовать? на лисп?

[VVA]

1. проверяй габаритную рамку vla-GetBoundingBox и сравнивай со своей.
2. Для текста textbox
Хотя мтекст да еще с форматированием та еще штучка.
Почитай эти (особенно последнюю) темы
Как получить координаты рамки text?
Автоматический подбор высоты текста
Еще дельные ссылки:
http://forums.autodesk.com/t5/AutoCA...ps/m-p/2076942 (там выложен ShrinkwrapMText v2a.zip)
MText - Set Limits Box to minimum (смотреть коды T Willey и fx.lsp выложенный C Witt)

[Frigate]

VVA

наверное лучше это при помощи ТЕКСТа реализовать, да? К тому же у Express есть функция, которую можно "позаимствовать" (выравнивание текста по границам)


Спасибо за ссылки, Владимир

[ShaggyDoc]

наверное лучше это при помощи ТЕКСТа реализовать, да?

Такие тексты с рамками постоянного размера лучше всего делать блоком из рамки и атрибута. Никаких вычислений - только вставка блока и установка значения атрибута. Выравнивание - в свойствах атрибута.

[Frigate]

Сообщение от ShaggyDoc Такие тексты с рамками постоянного размера лучше всего делать блоком из рамки и атрибута. Никаких вычислений - только вставка блока и установка значения атрибута. Выравнивание - в свойствах атрибута.

большущее спасибо

Сильное упрощение процесса )))

Век живи, век учись...

Есть напр. номера кабелей С1-1-1, с1-1-2 и тп, а есть С1-49-12... То есть автоматически при выравнивании слишком пестро смотрятся вставки. Придумал, что можно контролировать количество символов в строке кабеля. И если, напр., в строке, определяющей номер кабеля, меньше 10 символов, то добавляем по одному символу "пробел" слева и справа. Естественно, что "пробелы будут добавляться лишь к временным переменным (одной переменной), для придания "ляповатого вида"

Код завтра напишу, пора и спать )))

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

Надеюсь, не имелось в виду "сделать атрибут с выравниванием по ширине"?

[ShaggyDoc]

Сообщение от Кулик Алексей aka kpblc Надеюсь, не имелось в виду "сделать атрибут с выравниванием по ширине"?

Ну, это "на усмотрение". По конкретным условиям. Вообще-то для таких маленьких "этикеток", которых в чертежах бывает много (отметки на планах, категории и т.п.), целесообразно сделать выравнивание по центру. Там вносится достаточно постоянная по длине информация.

Если же действительно иногда вылезает за пределы бокса, то можно и по ширине сделать, с добавлением, как и догадался Frigate, в необходимых случаях пробелов для "ляповатого" вида. Это легко делать программно. А можно и со сжатием шрифта побаловаться, а выравнивание всегда по центру делать. Чуть больше сжатый шрифт атрибута в таких этикетках нормально смотрится.

Да и растяжение на мизерной длине в 10 мм не так уж плохо смотрится, если там несколько символов.

[Frigate]

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

именно это и имелось в виду, как я понял. И сделал - все работает очень даже хорошо

А чем, по-твоему, плох атрибут с выравниванием"по ширине", Алексей?

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

Сообщение от Frigate чем, по-твоему, плох атрибут с выравниванием"по ширине"

Все уже сказано:

Сообщение от ShaggyDoc растяжение на мизерной длине в 10 мм не так уж плохо смотрится, если там несколько символов

Если устанавливать выравнивание по ширине, то (по моим ощущениями) это будет нормально смотреться, если ширина текста укладывается в условие
Границы-10% <= ШиринаТекста <= Границы+30%
В противном случае текст становится трудночитаемым.

[Frigate]

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

ну да, я понял, о чем ты.
Я в блоке левую точку привязки текста расположил прямо на рамке 10 на 5, а правую точку расположил на 9.7 мм, т.е. на 0.3 мм левее правой стороны рамки - все очень даже нормально смотрится

[Profan]

Если вставлять пробелы, то лучше, видимо, использовать непропорциональный шрифт.

[Frigate]

Profan ,

шрифт может быть только один, принятый по СТП - GOST2.304. С определенной же высотой - 3 мм.

[Do$]

Offtop: Шрифт по ГОСТу, а высота - нет

[ShaggyDoc]

Сообщение от Frigate Profan , шрифт может быть только один, принятый по СТП - GOST2.304. С определенной же высотой - 3 мм.

Не употребляйте никто таких слов, а то придет Vova и....

[Frigate]

Подниму опять вопрос про Password, ибо опять наткнулся на такое свойство. Пароль не связан с блоком, но связан со вставкой блока.
Вот из справки:

RetVal = object.InsertBlock(InsertionPoint, Name, Xscale, Yscale, ZScale, Rotation [, Password]) Object ModelSpace, PaperSpace, Block The objects this method applies to. InsertionPoint Variant (three-element array of doubles); input-only The 3D WCS coordinates specifying the location in the drawing to insert the block. Name String; input-only The name of the AutoCAD drawing file or the name of the block to insert. If it is a file name, include the .dwg extension and any path information necessary for AutoCAD to find the file. Xscale Double; input-only; optional The default equals 1.0. Must be a positive number. Yscale Double; input-only; optional The default equals 1.0. Must be a positive number. Zscale Double; input-only; optional The default equals 1.0. Must be a positive number. Rotation Double; input-only; optional The default equals 0.0 radians. Password Variant; input-only; optional RetVal BlockRef object The placed block as a Block Reference object.

Кто-нибудь может знает, что это за пароль и для чего нужен?

[TararykovDG]

Frigate, про Password у меня такое предположение. Вообще-то свойство Password относиться не к блоку, а к объекту "SecurityParams", использование которго позволяет задать дополнительный атрибуты для чертежа. А так как для вставки блока может использоваться другой dwg чертеж, у которого есть пароль, то его, этот пароль и нужно будет указать в RetVal = object.InsertBlock(InsertionPoint, Name, Xscale, Yscale, ZScale, Rotation [, Password]).

[Frigate]

Нужна помощь. Что-то не получается сделать вставку блока никак

Блок "ДГК-1" сам создан и его можно вставить в чертеж обычными средствами.

Код:

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

(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq pt (ADV-CONVERTDATATYPE-3D_POINT-TO-2D_VARIANT (getpoint "Укажите точку вставки списка кабелей: ")))
(setq blk-name "ДГК-1")
(setq bl-name (vlax-make-variant blk-name vlax-vbString))
(vla-InsertBlock  mspace pt bl-name 1 1 1 0)

ошибку кажет

ошибка: Ошибка Automation. Ошибка файлера

наверное я что-то с типами данных понапутал. Помогите разобраться, плиз.

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

Код:

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

(defun test (/ adoc model blk_name ins_pt)
  (setq blk_name "ДГК-1"
        adoc     (vla-get-activedocument (vlax-get-acad-object))
        model    (vla-get-modelspace adoc)
        ) ;_ end of setq
  (vla-startundomark adoc)
  (if (and (= (type (setq ins_pt (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (getpoint "\nТочка вставки <Отмена> : ")
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           ins_pt
           ) ;_ end of and
    (vla-insertblock
      model
      blk_name
      (vlax-3d-point ins_pt)
      1.
      1.
      1.
      0.
      ) ;_ end of vla-InsertBlock
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Не проверял.

[Frigate]

Алексей,

твой код загрузил, ткнул точку вставки и получил

Код:

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

ошибка: lisp-значение не может быть приведено к 
данному типу ВАРИАНТА:  #<variant 8197 ...>

У меня мой изначальный код получился, там был глюк какой-то, видимо из-за того, что функцию преобразования точки в вариант скопировал с WORDа.

А не нужно ли, при вставке имени блока как переменной, использовать

Код:

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

 
(setq blk_name (vlax-make-variant "ДГК-1" vlax-vbString))

у меня вот так получилось:

Код:

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

 
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq pt (ADV-CONVERTDATATYPE-3D_POINT-TO-2D_VARIANT (getpoint "Укажите точку вставки списка кабелей: ")))
(setq blk-name "ДГК-1")
(setq bl-name (vlax-make-variant blk-name vlax-vbString))
(vla-InsertBlock  mspace pt bl-name 1 1 1 0)

возможно дело все в таком непонятном списке

Код:

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

'list

у тебя в программе, который нигде не определен?
Что там должно быть?

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

Поменяй местами строки (vlax-3d-point inx_pt) и blk_name:

Код:

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

(defun test (/ adoc model blk_name ins_pt)
  (setq blk_name "ДГК-1"
        adoc     (vla-get-activedocument (vlax-get-acad-object))
        model    (vla-get-modelspace adoc)
        ) ;_ end of setq
  (vla-startundomark adoc)
  (if (and (= (type (setq ins_pt (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (getpoint "\nТочка вставки <Отмена> : ")
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           ins_pt
           ) ;_ end of and
    (vla-insertblock
      model
      (vlax-3d-point ins_pt)
      blk_name
      1.
      1.
      1.
      0.
      ) ;_ end of vla-InsertBlock
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

А 'list - это проверка, действительно пользователь ткнул в точку или нажал Esc (пробел тоже отслеживается)

[ShaggyDoc]

Кстати, проверять введена ли именно точка, всегда надо. Лучше сделать отдельную функцию наподобие

Код:

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

(defun ru-is-point (point)
    ;;(ru-is-point (list 10.0 0.0 10)) T  
    ;;(ru-is-point (list 0.0 0.0))  T
    ;;(ru-is-point (list 0.0))  nil
    ;;(ru-is-point nil)  nil
    (and (listp point)
         (<= 2 (length point) 3)
         (apply (function and) (mapcar (function numberp) point))
    ) ;_ end of and
) ;_ end of defun

А то "листы" оне всякие бывают. Аналогично, когда надо, можно проверять введена ли 3D-точка

Код:

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

(defun ru-is-3d-point (point)
    ;;(ru-is-3d-point (list 10.0 0.0 10)) T  
    ;;(ru-is-3d-point (list 0.0 0.0)) nil  
    ;;(ru-is-3d-point (list 0.0))  nil
    ;;(ru-is-3d-point nil)  nil
    (and (listp point)
         (= 3 (length point))
         (apply (function and) (mapcar (function numberp) point))
    ) ;_ end of and
)

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

ShaggyDoc, я проверял через type вот почему:

Код:

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

_$ (listp '(0. 0. 0.))
T
_$ (listp nil)
T
_$ (listp '(nil))
T

[gomer]

Вставлю свои 5 копеек по поводу "точечности":

Код:

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

(defun IsPoint (pt)
  (not (vl-catch-all-error-p
	 (vl-catch-all-apply 'vlax-3d-point (list pt))
       )
  )
)

[ShaggyDoc]

Сообщение от gomer Вставлю свои 5 копеек по поводу "точечности": Код: [Выделить все] (defun IsPoint (pt) (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point (list pt)) ) ) )

Да, можно и как-то так. Но я стараюсь в мелких функциях, по возможности, не использовать особенностей последних версий VL. Иногда приходится делать "downgrade" программ... Вот даже версию для AutoCAD 14 в рабочем состоянии держу, а один очень уважаемый мною клиент до сих пор версию 10 (не 2010, а именно 10) использует. Так уж сложилось...

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

По поводу низкоуровневых функций с отловом ошибок... В некоторых случаях (особенно это касается вертикальных приложений предыдущих версий) "вложенность" vl-catch-* функций не может превышать некоторого значения (по-моему, 4). Абсолютно недокументированная особенность, в свое время немало мне подпортившая мне жизнь: код просто вылетал с сообщением о переполнении.

[ShaggyDoc]

"вложенность" vl-catch-* функций не может превышать некоторого значения (по-моему, 4)

И это тоже. vl-catch-* замечательные, я бы сказал революционные, функции, снявшие массу проблем. Для VL, конечно, в других системах давно имелись try...except...finally и подобные конструкции.

Но использовать их надо с умом, где действительно необходимо. А если можно сделать простую проверку, лучше обойтись ею.

Утрированный пример - всем известно, что на 0 делить нельзя. Не умеет делать никакой процессор. Можно "перебдеть" и обертывать в ловушку все операции деления. И я даже реально видел такой код. А можно просто проверять на "нолистость" на верхнем уровне, не проуская неверные числа.

Для ловушек много и человеческих аналогов. Не обязательно каждого заставлять креститься или выпивать горилки для проверки на "правильность". Или дубиной по голове бить, или еще что... Обычно есть более простые способы.

[alex8888]

Подскажите, пожалуйста, как обработать формулу (см. вложение) при нескольких значениях угла альфа. Список из необходимых углов альфа и величина R известны, но количество альф может быть различным. Требуется получить список из Lx или конкретные значения L0, L1, L2 ... и т.д.
Через обработку списка из альф посредством команды nth получаю значения L0, ....Ln, но сама запись очень громоздкая:

Код:

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

(setq 
spisok_sin (mapcar 'sin (list 0 (/ pi 8.0) (/ pi 4.0) (* 3.0 (/ pi 8.0)) (/ pi 2.0)))
L0 (sqrt (- (expt R 2.0) (* (expt (* R (nth 0 spisok_sin)) 2.0))))
L1 (sqrt (- (expt R 2.0) (* (expt (* R (nth 1 spisok_sin)) 2.0))))
L2 (sqrt (- (expt R 2.0) (* (expt (* R (nth 2 spisok_sin)) 2.0))))
L3 (sqrt (- (expt R 2.0) (* (expt (* R (nth 3 spisok_sin)) 2.0))))
L4 (sqrt (- (expt R 2.0) (* (expt (* R (nth 4 spisok_sin)) 2.0))))
)

Попытался организовать через функции foreach, mapcar и lambda, но положительного результата не достиг - зато мозги вскипели
Не получается подставлять в выражение значение из списка - требуют всегда число, а как без nth до него добраться?

[TararykovDG]

alex8888, попробуй так

Код:

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

; если R и spisok_sin заданы
(mapcar '(lambda (x) (sqrt (- (expt R 2.0) (* (expt (* R x) 2.0))))) spisok_sin)

[Frigate]

Здравствуйте,

прошу ответить, верно ли я понял, что ruCAD, который бесплатно выложен в сети для общего пользования, работает только с 2006 автокадом? 2009-ый стартер даже не замечает

[alex8888]

TararykovDG, спасибо, получилось. А то голову сломал, куда же lambda воткнуть - я ее пытался внутри формулы прописать, а нужно в начале.

Вопрос другой, у метода AddSpline в качестве аргументов нужно задавать начальную и конечную касательные. Как они будут выглядеть, если необходимо получить замкнутый сплайн, где начало и конец совпадают и дополнительные точки я не просчитывал?

[ShaggyDoc]

Сообщение от Frigate прошу ответить, верно ли я понял, что ruCAD, который бесплатно выложен в сети для общего пользования, работает только с 2006 автокадом? 2009-ый стартер даже не замечает

Это старая версия. Последняя версия ruCAD-2008 "замечает" и работает со всеми AutoCAD начиная с 2008 (R17.1) до R18.2 (если такая будет). Более ранние не поддерживаются.

[Frigate]

ShaggyDoc

я скачал с этого сайта в downloads ruCAD. Значит она старая? А где я могу скачать новую, или это невозможно?

[alex8888]

ShaggyDoc, а в 2011 каде получится запустить? И где скачать, если можно?

Как привести список типа ((x1 y1)(x2 y2)(x3 y3)...(xn yn)) к виду (x1 y1 x2 y2 x3 y3 .... xn yn) ?
Offtop: (Туплю чего то сегодня ) - не могу найти никак

[ShaggyDoc]

А где я могу скачать новую, или это невозможно?

Скачать нельзя нигде. Используется только достаточно узким кругом спонсоров и заказчиков системы.

ShaggyDoc, а в 2011 каде получится запустить?

Должно быть. Покупать 2011 ради ответа на на этот вопрос у меня нет возможностей. Пока все мои клиенты работают в 2008 и не намерены обновлять Автокады из-за "сбоку-бантик". А радикальных новых возможностей не появляется.

Ограничения младших версий вызваны тем, что выполнен полный переход на возможности 3D, аннотативность и прочее, появившееся в 2008. А старшие версии ограничены 18.2, да и то "от фонаря". Технических ограничений нет, так как не используется OA, в котором есть контроль версий.

[TararykovDG]

Сообщение от alex8888 Как привести список типа ((x1 y1)(x2 y2)(x3 y3)...(xn yn)) к виду (x1 y1 x2 y2 x3 y3 .... xn yn) ?

Код:

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

(setq lst (list (list 1 1) (list 2 2) (list 3 3)))
(apply 'append lst)

[Frigate]

ShaggyDoc
а есть возможность запустить руКАД, скачанный с этого сайта, под 2009 автокадом?

У меня программа стартер пишет - не вижу автокада.

[alex8888]

Можно ли сплайн, созданный методом vla-addSpline сконвертировать в полилинию без применения командного метода

Код:

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

(vl-cmdf "_splinedit" (entlast) "_p" "10")

?

[Frigate]

Интересная особенность VLISP редактора - если создавать мастером приложение и файлы .lsp лежат в папке создаваемого приложения, то длина имени таких .lsp файлов не может превышать 24 символа. Если файлы-исходники находятся в др. папках, то таких ограничений нет. Но добавлять больше чем по 5 файлов-исходников (.lsp) не получается. Может кто знает, как можно за одно выделение добавить все свои исходные .lsp файлы в состав приложения?

[ShaggyDoc]

Сообщение от Frigate Интересная особенность VLISP редактора - если создавать мастером приложение и файлы .lsp лежат в папке создаваемого приложения, то длина имени таких .lsp файлов не может превышать 24 символа. Если файлы-исходники находятся в др. папках, то таких ограничений нет. Но добавлять больше чем по 5 файлов-исходников (.lsp) не получается. Может кто знает, как можно за одно выделение добавить все свои исходные .lsp файлы в состав приложения?

Пользоваться штатными средствами ведения проекта очень неудобно. Гораздо лучше редактировать файл проекта обычным текстовым редактором и добавлять файлы в список вручную. Первоначально проект создать в IDE, а потом - руками редактировать список :OWN-LIST.

Файлы можно группировать, вставлять комментарии как в LISP за символами ";", располагать в подкаталогах. Запись файла в список надо делать с относительным путем от файла проекта.

Например

"3d/draw/pipe/support/erico/ru-3d-steel-erico-bracket-2-channel-draw"

Неудобство - после изменения проект надо заново загружать.

[Frigate]

Очень нужен совет опытных пользователей Автокада. Создал команду, подцепил ее на кнопку. Файл .lsp с командой разместил в папке, которую прописал в путях доступа к вспомогат. файлам. Теперь меняю код в .lsp файле, но подкачивается старый вариант файла. ВАообще удалил файл и папку. Все равно откуда-то подгружается файл )))

Прошу помощи ) Иначе придется просто менять название программсы и прописывать новое уже название на кнопке.

[hwd]

Сообщение от Frigate Очень нужен совет опытных пользователей Автокада. Создал команду, подцепил ее на кнопку. Файл .lsp с командой разместил в папке, которую прописал в путях доступа к вспомогат. файлам. Теперь меняю код в .lsp файле, но подкачивается старый вариант файла. ВАообще удалил файл и папку. Все равно откуда-то подгружается файл ))) Прошу помощи ) Иначе придется просто менять название программсы и прописывать новое уже название на кнопке.

Загрузку файла вы прописываете в коде кнопки (т.е. выполняется проверка вызова команды, если возвращается nil - выполняется загрузка файла) или он грузится автоматически?
Если автоматически, то возможно, что команда с таким именем уже существует в др. lisp-файле, который грузится после вашего.

п.с. я не силён в лиспе, это предположение.

[Frigate]

в общем щас более подробно опитшу ситуацию.
Программа (имя ее) - adv-programme-routing-cable-routing-create.
Сейчас такая ситуация-ни одного файла с таким названием нет. Открываю Автокад. Набираю в ком. строке название этой команды:

Команда: adv-programme-routing-cable-routing-create Неизвестная команда "ADV-PROGRAMME-ROUTING-CABLE-ROUTING-CREATE". Для вызова справки нажмите F1.

Далее пытаюсь подгрузить эту программу:

Команда: (load "adv-programme-routing-cable-routing-create") ; ошибка: сбой при выполнении LOAD: "adv-programme-routing-cable-routing-create"

Несмотря на сбой при загрузке, функция загрузилась (только неясно как и откуда???):

Команда: ADV-PROGRAMME-CABLE-ROUTINGS-CREATE-ONE Введите поправку (в процентах) на длину кабеля (целое число от 6 до 30) <20>:

Это уже идет выполнение моей программы-невидимки:

Введите поправку (в процентах) на длину кабеля (целое число от 6 до 30) <20>:

Как можно узнать путь подгрузки программы??? Может ли она каким-то образом уже прописана в путях автозагрузки? ТОлько я ничего такого не делал )))
Прошу помощи )

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

Попробуй указать загрузку так:

Код:

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

(load (findfile "adv-programme-routing-cable-routing-create.lsp"))

Или как там файл называется...

[gomer]

Сообщение от Frigate ТОлько я ничего такого не делал )))

Точно не делал?

ИМХО Вешать на кнопки загрузку файлов - моветон, для этого есть файлы *.mnl и *.cui

и не факт, что команда определена только в этом файле

[Frigate]

ответ автокада

Команда: (load (findfile "adv-programme-routing-cable-routing-create.lsp")) ; ошибка: неверный тип аргумента: stringp nil

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


Все нормально теперь, еще раз проверил - уже не находит эту программку.

Видимо, есть глюк у Акада какой-то, но сейчас он исчез (после переименования программы)


gomer,

а как сделать загрузку основного VLX файла через CUI?

[gomer]

Перезагрузи кад и попробуй снова
зы просто команда была уже загружена в документ и это не глюк

[Frigate]

если б так все просто я б не переживал даже ))) Уже жалею, что изменил название программы и макрос на запуск программы (что на кнопке)

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

[gomer]

Сообщение от Frigate а как сделать загрузку основного VLX файла через CUI?

Никак, но можно его загружать из лиспа прописанного в CUI
зы основной VLX файл? ИМХО одна задача - одна команда - один файл (приложение)...
Для загрузки приложений создается файл - центр загрузки, желательно с открытым кодом (mnl, lsp - не столь важно), в котором прописывается что необходимо подгрузить...
зызы посмотри, как организовано тут... Не идеал, но все же...

[Frigate]

gomer

в той программе используется диалоговое окно .dcl? Это в нем создано описание свойств проката, да?

что-то не распаковывается архив с той программкой, к сожалению.

Ну если объяснить на пальцах? У меня есть мой файл частичной адаптации. В нем мне подгрузить .lsp, который загружает VLX с функциями? Так сделал, но автоматом такой файл не лоадится (.lsp в CUI). В справке по адаптации написано, что автоматически подгружаются файлы с .mnl.
Попробовал - создал файл mnl с именем как у CUI. Туда просто вписал:

Код:

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

(vl-load-com)
(vl-load-all "ADV_FUNCTIONS_DB.VLX")

и все загружено, все работает мне понравилось

[gomer]

Я про это и говорил... Странно, почему лисп из КУИ не грузится
зы архив 9м 7zip-ом открывается

[Frigate]

gomer

автоматически не грузится.
Если что - у меня Автокад 2009 (рус.)

[gomer]

Ничего не знаю! грузится... А ты добавил его в cui? команда _cui- открываешь Файлы Lisp - Загрузить - Выбираешь в окошке нужный файл...
Или просто одноименный файл создал и ждешь пока загрузится?

[Frigate]

ааа... надо, чтобы он одноименным был?
Ну тогда ясно )))
Остальное то все делал

[gomer]

не обязательно одноименный, более того, можно несколько лиспов определить в куи и все должны загружаться...

[VVA]

Frigate, Почитай эту тему Игры с CUI Там было и про лисп и много чего еще интересного

[wetr]

ребят, подскажите, не могу дотумкать
В mnl файле прописал загрузку небезызвестных программ Александра Ривилиса

Код:

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

(if (not (member "DWGConvert2010x32.arx" (arx)))
(arxload "DWGConvert2010x32.arx")
)

так как в arx файле уже прописана автозагрузка, то его нужно загрузить 1 раз, поэтому такая проверка
Но недавно всплыла нужда в проверке на 64-битность. Для 64 битных систем нужен соответственно другой arx.
Слямзил с VetCAD_а идею:

Код:

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

(setq acadver_bit (getenv "PROCESSOR_ARCHITECTURE") acadver_bit (substr acadver_bit (1- (strlen acadver_bit))))
(if (= acadver_bit "64")
 	        (setq startfile "DWGConvert2010x64.arx")
 	        (setq startfile "DWGConvert2010x32.arx")

Но как совместить 2 проверки сразу, не могу въехать

[Red Nova]

Извините за флуд, не удержался от соблазна присвоить пост номер 1111 себе как аФтору

[Frigate]

Здравствуйте, подскажите, какой английский аналог команды ПОРЯДОК в русифицированном АКАДе?
А вообще, можно ли где-нибудь скачать справку для пользователя оригинальной (англ.) версии Автокада? А то неоткуда брать команды, а они иногда так нужны.

[Alan]

Сообщение от wetr Но как совместить 2 проверки сразу, не могу въехать

Что-типа так

Код:

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

(setq acadver_bit
       (getenv "PROCESSOR_ARCHITECTURE")
      acadver_bit
       (substr acadver_bit (1- (strlen acadver_bit)))
      (if (= acadver_bit "64")
	(setq startfile "DWGConvert2010x64.arx")
	(setq startfile "DWGConvert2010x32.arx")
      ) ;_ конец if
) ;_ конец setq
(if (not (member startfile (arx)))
  (arxload startfile)
) ;_ конец if

[TararykovDG]

Сообщение от Frigate Здравствуйте, подскажите, какой английский аналог команды ПОРЯДОК в русифицированном АКАДе? А вообще, можно ли где-нибудь скачать справку для пользователя оригинальной (англ.) версии Автокада? А то неоткуда брать команды, а они иногда так нужны.

Frigate, можно ипользовать функцию getcname

Код:

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

_$ (getcname "ОТРЕЗОК")
"_LINE"
_$ (getcname "_LINE")
"ОТРЕЗОК"
_$ (getcname "ПОРЯДОК")
"_DRAWORDER"
_$ (getcname "_DRAWORDER")
"ПОРЯДОК"

[VVA]

Сообщение от wetr Но недавно всплыла нужда в проверки на 64-битность. Для 64 битных систем нужен соответственно другой arx.

В общем случае на 64 битную Windows можно поставить 32 битный Автокад. Поэтому надо проверять не разрядность ОС, а разрядность Автокада
См. ф-цию Acad64Bit-version с поста #6

Код:

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

(if (Acad64Bit-version)
     (arxload "ExplodeProxy2010x64.arx")
     (arxload "ExplodeProxy2010x32.arx")
)

[wetr]

Всем спасибо!

Код:

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

(defun Acad64Bit-version ()
  (vl-load-com)
  (> (strlen (vl-prin1-to-string (vlax-get-acad-object))) 40)
)
      (if (Acad64Bit-version)
	(setq startfile "DWGConvert2010x64.arx"
	      startfile2 "ExplodeProxy2010x64.arx"
	      startfile3 "GeomProps2010x64.arx"
	      startfile4 "SelSim2010x64.arx"    
	       )
	(setq startfile "DWGConvert2010x32.arx"
	      startfile2 "ExplodeProxy2010x32.arx"
	      startfile3 "GeomProps2010x32.arx"
	      startfile4 "SelSim2010x32.arx"    
	       )
	  
	) ;_ конец if

(if (not (member startfile (arx)))
  (arxload startfile)
)

(if (not (member startfile2 (arx)))
(arxload startfile2)
)

(if (not (member startfile3 (arx)))
(arxload startfile3)
)

(if (not (member startfile4 (arx)))
(arxload startfile4)
)

Пока так сделал, только вот проверить толком не могу - при выгрузке arx-файла вылетает фатал еррор

[Frigate]

Здравстуйте, уважаемые ГУРУ форума.

Прошу помочь с функцией выделения рамкой ячеек в таблице:
SelectSubRegion (wpt1, wpt2, wvwVec, wvwxVec, seltype, bIncludeCurrentSelection, rowMin, rowMax, colMin, colMax)

wvwvec

Variant
3D vector in WCS specifying the view direction of the selection.

Берется из системной переменной
(vlax-3d-point (trans (getvar "VIEWDIR") 1 0)).

А вот где найти

wvwxvec

Variant
3D vector in WCS specifying the view orientation of the hit test.

???

Или может кто скинет примеры использования этой функции?

[acyxou]

нет, я не поклонник лиспа, но случайно встретил в интернете книженцию Land of Lisp: Learn to Program in Lisp, One Game at a Time!. Подумал, что возможно, кому-нибудь будет интересно почитать)

[Лиспер]

acyxou, я пока нашел только на языке оригинала. Интересно, а на русском есть?

[acyxou]

Переведешь - будет! А не переведешь - будешь ждать пока переведет кто-нибудь другой, пропустив всю информацию в книге через свое восприятие))

Имхо, программер, в первую очередь, должен знать английский (хотя бы технический), а потом уже браться за изучение программирования...

[Лиспер]

Блин, полентяйничать не дали

[VVA]

Сообщение от Frigate Здравстуйте, уважаемые ГУРУ форума. Прошу помочь с функцией выделения рамкой ячеек в таблице: SelectSubRegion (wpt1, wpt2, wvwVec, wvwxVec, seltype, bIncludeCurrentSelection, rowMin, rowMax, colMin, colMax) wvwvec Variant 3D vector in WCS specifying the view direction of the selection. Берется из системной переменной (vlax-3d-point (trans (getvar "VIEWDIR") 1 0)). А вот где найти wvwxvec Variant 3D vector in WCS specifying the view orientation of the hit test. ??? Или может кто скинет примеры использования этой функции?

Посмотри описание vla-hittest. И пример использования vla-hittest здесь

[Frigate]

VVA,

спасибо.

Я именно по одному из твоих примеров и разобрался с методом hittest.

Владимир (если не ошибаюсь),

можешь мне помочь мою проблему решить?

Мне нужно хранить VLA-object в атрибуте. Но даже если и запихнуть VLA-object в строку, то потом его вытащить никак не получается. Я правда с ENAME не пробовал еще такого проделать. Подскажи, плиз, что мне делать.

[TararykovDG]

Сообщение от Frigate Мне нужно хранить VLA-object в атрибуте. Но даже если и запихнуть VLA-object в строку, то потом его вытащить никак не получается. Я правда с ENAME не пробовал еще такого проделать. Подскажи, плиз, что мне делать.

Frigate, Запоминай в атрибуте ID VLA-object'а

Код:

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

_$ a_obj ; какой-то объект
#<VLA-OBJECT IAcadCircle 0205fa8c>
_$ (setq id (vla-get-ObjectID a_obj)) ; получили его ID (записали а атрибут)
2127807360
_$ (vla-ObjectIDToObject (vla-get-ActiveDocument (vlax-get-acad-object)) id) ; по ID получили наш исходный объект
#<VLA-OBJECT IAcadCircle 0205fa8c>

или с ename используй метки

Код:

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

_$ obj ; какой-то объект
<Имя объекта: 7ed3c380>
_$ (setq ed (entget obj))
((-1 . <Имя объекта: 7ed3c380>) (0 . "CIRCLE") (330 . <Èìÿ îáúåêòà: 7ed3acf8>) (5 . "1B0") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbCircle") (10 849.149 1061.53 0.0) (40 . 367.977) (210 0.0 0.0 1.0))
_$ (setq hnd (cdr (assoc 5 ed)))
"1B0" ; получили его метку (записали а атрибут)
_$ (handent hnd) ; по метку получили наш исходный объект
<Имя объекта: 7ed3c380>

[Eximius]

Уважаемые форумчане, пожалуйста объясните правила работы и зачем вообще нужны функции отлова ошибок (типо *error*). Можно ли это как-то применить к следующему:
в программе во время диалога с пользователем, автокад отправляет некоторые данные в лист екселя. Предположим, пользователь нажимает escape и прерывает программу. Тогда в памяти остаётся открытым объект екселя а в нём активная книга. Как сделать так, чтобы в случае ошибки книга закрывалась?

[gomer]

Сообщение от Eximius в программе во время диалога с пользователем, автокад отправляет некоторые данные в лист екселя. Предположим, пользователь нажимает escape и прерывает программу. Тогда в памяти остаётся открытым объект екселя а в нём активная книга. Как сделать так, чтобы в случае ошибки книга закрывалась?

Сначала поговорите с автрокадом, а потом с книгой работайте, тогда ничего оставаться не будет

[Eximius]

Не понял, что значит "поговорить с автокадом".

[gomer]

Сначала диалог с пользователем и накопление данных, потом отправление данных в лист екселя

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

TararykovDG, ID объекта хранится только в текущей сессии. Хэндлы более живучи.

[Eximius]

Спасибо.

[TararykovDG]

Сообщение от Кулик Алексей aka kpblc TararykovDG, ID объекта хранится только в текущей сессии. Хэндлы более живучи.

Да-да, Алексей, верно, совсем забыл про потерю ID в другой сессии. Ну метки должны работать, так что, Frigate, используй вариант с ename

[Лиспер]

Сообщение от TararykovDG вариант с ename

То есть?

[TararykovDG]

Сообщение от Лиспер То есть?

То есть 2-ой способ указанный мной в посте #1124 (слово "вариант" здесь это не тип данных)

[Лиспер]

То есть хендлы

[TararykovDG]

Сообщение от Лиспер То есть хендлы

Лиспер, я не пойму, Ты че прикалываешся? Или Тебе поговорить охото. Второй код из поста #1124, по-моему там все очевидно, во всяком случае для Тебя должно быть очевидно... То есть хендлы (а по-русски метки)

[Лиспер]

TararykovDG, если честно - просто хотелось определенности. Ладно, умолкаю.

[Frigate]

TararykovDG,

спасибо за советы, но они пока никак мне не помогут. Мне нужно хранить список в аргументе блока.
Напр., такой:

((<Имя объекта: 7ef085e8> 52.9463) (<Имя объекта: 7ef084a8> 54.0))

Или HANDLE вместо entity.

Но: чтобы запихнуть список в аргумент, его надо преобразовать в строку (vl-princ-to-string ... ).
А там все свойства теряются.

Что посоветуете? Желательно оставить вариант, что инфа хранится в атрибуте блока.
(на всякий слычай уточню - entity хранится совсе не этого блока).

[TararykovDG]

Сообщение от Frigate TararykovDG, спасибо за советы, но они пока никак мне не помогут. Мне нужно хранить список в аргументе блока. Напр., такой: ((<Имя объекта: 7ef085e8> 52.9463) (<Имя объекта: 7ef084a8> 54.0)) Или HANDLE вместо entity. Но: чтобы запихнуть список в аргумент, его надо преобразовать в строку (vl-princ-to-string ... ). А там все свойства теряются. Что посоветуете? Желательно оставить вариант, что инфа хранится в атрибуте блока. (на всякий слычай уточню - entity хранится совсе не этого блока).

Frigate, я что-то не совсем понял, но дам совет по тому как понял. Итак, если нужно в атрибуте блока хранить инфу о существующем на чертеже объекте (или объектах), то записывай в атрибут только метки (handle) этих объектов, они (метки) уже является строками и vl-princ-to-string не нужен. Т. е. для сохранения данных об одном объекте записывай в атрибут сроку типа "3CD" (это метка полученная (setq hnd (cdr (assoc 5 (entget obj)))), obj - ссылка на объект, инфу по которому нужно сохранить. Или, если нужно сохранить несколько объектов, то записывай строку "3CD 3CE 3D0" через пробелы. А потом, когда нужно считаешь из атрибута строку разложишь если есть пробелы на состовляющие и для каждого "XXX" прменишь (entget (handent "XXX")) и получишь инфу по объекту
)

[puma]

Многоуважаемый Кулик Алексей aka kpblc используя ваш lisp по созданию слоев и загрузки типов линий в вашем реакторе обнаружил, что если, например, чертится ось на слое с пунктирным типом линий, то при повторном вызове производится сброс на обычный тип. Хотя понимаю, что lisp только для создания слоев, а не для изменений их св-в, но очень уж удобный. Возможно ли вот такое корявое изменение (кириллица слетела, за что прошу прощения):

Код:

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

(defun _kpblc-layer-create (layer-list / vla_layer linetype-normal)
 (vl-load-com)
  (setq    vla_layer
     (vla-add
       (vla-get-layers *kpblc-activedoc*)
       (cdr (assoc "name" layer-list))
     ) ;_ end of vla-add
  ) ;_ end of setq
  (vla-put-color
    vla_layer
    (if    (cdr (assoc "color" layer-list))
      (cdr (assoc "color" layer-list))
      7
    ) ;_ end of if
  ) ;_ end of vla-put-color
  (vla-put-lineweight
    vla_layer
    (if    (cdr (assoc "lw" layer-list))
      (cdr (assoc "lw" layer-list))
      aclnwt025
    ) ;_ end of if
  ) ;_ end of vla-put-lineweight
  (if  (and (cdr (assoc "lt" layer-list))
       (setq linetype-normal (_kpblc-linetype-load
         (cdr (assoc "lt" layer-list))
         (cdr (assoc "ltfile" layer-list))
       ) ;_ end of _kpblc-linetype-load
      ) ;_ end of and
        )
         (vla-put-linetype vla_layer linetype-normal)
    (vla-put-linetype vla_layer "Continuous")
  ) ;_ end of if
  (vla-put-plottable
    vla_layer
    (if    (= (cdr (assoc "plot" layer-list)) "n")
      :vlax-false
      :vlax-true
    ) ;_ end of if
  ) ;_ end of vla-put-Plottable
  (vla-put-lock vla_layer :vlax-false)
  (vla-put-layeron vla_layer :vlax-true)
  (if (not (equal (vla-get-activelayer *kpblc-activedoc*)
          vla_layer
       ) ;_ end of equal
      ) ;_ end of not
    (vla-put-freeze vla_layer :vlax-false)
  ) ;_ end of if
  vla_layer
) ;_ end of defun

(defun _kpblc-linetype-load
       (ltype-name ltype-file / ltype_normal ltype_list result)
  (vl-load-com)
  (setq    ltype_list '(("center" . "осевая")
             ("center2" . "осевая2")
             ("hidden" . "скрытая")
             ("hidden2" . "скрытая2")
            ("psk_weld_01_p" . "psk_weld_01_p")
            ("psk_weld_19" . "psk_weld_19") )
    ltype-name (strcase ltype-name t)
  ) ;_ end of setq
  (if (not ltype-file)
    (setq ltype-file "acadiso.lin")
  ) ;_ end of if
  (if (vl-string-search "419" (vlax-product-key))

    (setq ltype_normal (cdr (assoc ltype-name ltype_list)))
    (setq ltype_normal ltype-name)
  ) ;_ end of if
  (if (not (tblsearch "ltype" ltype_normal))

    (setq result
       (not    (vl-catch-all-error-p
          (vl-catch-all-apply
            'vla-load
            (list
              (vlax-get-property
            (vla-get-activedocument (vlax-get-acad-object))
            'linetypes
              ) ;_ end of vlax-get-property
              ltype_normal
              ltype-file
            ) ;_ end of list
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of vl-catch-all-error-p
       ) ;_ end of not
    ) ;_ end of setq
  ) ;_ end of if

(if  (tblsearch "ltype" ltype_normal)
  (setq result "T"))
  (If (= result "T")
    ltype_normal
nil)
) ;_ end of defun

[Frigate]

TararykovDG,

вышел из ситуации по-другом - в переменную просто сохранял всю матрицу. Все равно значения ее лишь временно нужны. А те, что нужны и после матобработки, сохраняю в атрибутах.
За советы благодарю. Наверняка и они пригодятся потом.

[Li6-D]

В свое время обдумывал где и как хранить информацию о "контактных" точках блоков.
То есть точек блока, которые могут соединяться меж собой в схеме или графике каком...
В моем случае было достаточно 4 групп "контактных" точек по квадрантам - верх, низ, лево, право.
В итоге решил хранить в самих блоках, добавляя в них с помощью простейшего лиспа отрезки, которые:
1 имеют строго определенную длину, которая на несколько порядков меньше размеров блока;
2 содержат группу невидимости (60 . 1).
Другой лиспик извлекает список "контактных" точек при указании на вставленный в чертеж блок.
Примитивно, но это работает

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

puma, а можно полный код напомнить? Я просто подобных ошибок не ловил...
P.S. Проверить смогу только завтра вечером

[puma]

Полный код той версии реактора, что использую, (без изменений) со всеми доп.функциями. Если где затесались мои комментарии - сорри, пока разбирался - комментировал что где делается. Ошибка появляется при таком порядке:
Требуется создать объект на слое со штрихпунктирным типом линий (подгружаю из стороннего файла, не acadiso; наименование типа линий на русском - добавлял в список, и он находился). После создания первого - создаем второй объект. Слой при этом меняет тип линий на обычный.
Возможно я не то исправил, но, кажется, если тип линий загружен и снова происходит обращение к функции подгрузки типов линий - она выдает nil, что приводит к загрузке стандартной линии. Исправление по русскому/английскому наименованию делал почти наугад, так как после того как функцию подгрузки линии исправил, чтобы выдавала T - начала вылетать функция создания слоя с ошибкой. Хотя скорее всего у меня просто кривые руки. Спасибо за чудесный реактор, и заранее за ответ

Код:

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

(vl-load-com)
(if (not *kpblc-activedoc*)
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ end of if

(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)
              (:vlr-commandended . cmd-end)
              (:vlr-commandcancelled . cmd-cancel)
              (:vlr-commandfailed . cmd-fail)
              )
            ) ;_ end of VLR-Command-Reactor
    ) ;_ end of setq
  ) ;_ end of if
;; Функция подгрузки типа линии - на http://www.autocad.ru/cgi-bin/f1/board.cgi?t=22730iW

;|=============================================================================
*    Создание слоя с указанными параметрами.
*    Параметры вызова:
*   layer-list   список параметров слоя вида:
   '(("name" . "TestLayer")   ; имя слоя. Не может быть пропущено
   ("color" . 3)         ; номер цвета. nil -> 7
   ("lw" . 50)         ; вес линии слоя. nil -> 25
   ("lt" . "hidden")      ; тип линии слоя. nil -> Continuous
               ; Если описания типа линии в acadiso.lin
               ; нет, обязательно указывать следующий
               ; параметр
   ("ltfile" . "c:\\cad\\ltypes\\lt.lin")   ; полный путь к файлу с описанием
               ; типа линии. Если файл находится в путях
               ; поддержки, путь можно не указывать
   ("plot" . "y")         ; Печатать ("y") или нет ("n") слой.
               ; nil -> "y"
   )
*    Возвращает vla-указатель на созданный слой. Если слой существует, его
* настройки приводятся в соответствие с переданным списком.
*    Слой размораживается, разблокируется и включается. Не активируется.
|;
(defun _kpblc-layer-create (layer-list / vla_layer)
  (setq    vla_layer
     (vla-add
       (vla-get-layers *kpblc-activedoc*)
       (cdr (assoc "name" layer-list))
       ) ;_ end of vla-add
    ) ;_ end of setq
  (vla-put-color
    vla_layer
    (if    (cdr (assoc "color" layer-list))
      (cdr (assoc "color" layer-list))
      7
      ) ;_ end of if
    ) ;_ end of vla-put-color
  (vla-put-lineweight
    vla_layer
    (if    (cdr (assoc "lw" layer-list))
      (cdr (assoc "lw" layer-list))
      aclnwt025
      ) ;_ end of if
    ) ;_ end of vla-put-lineweight
  (if (and (cdr (assoc "lt" layer-list))
       (_kpblc-linetype-load
         (cdr (assoc "lt" layer-list))
         (cdr (assoc "ltfile" layer-list))
         ) ;_ end of _kpblc-linetype-load
       ) ;_ end of and
    (vla-put-linetype vla_layer (cdr (assoc "lt" layer-list)))
    (vla-put-linetype vla_layer "Continuous")
    ) ;_ end of if
  (vla-put-plottable
    vla_layer
    (if    (= (cdr (assoc "plot" layer-list)) "n")
      :vlax-false
      :vlax-true
      ) ;_ end of if
    ) ;_ end of vla-put-Plottable
  (vla-put-lock vla_layer :vlax-false)
  (vla-put-layeron vla_layer :vlax-true)
  (if (not (equal (vla-get-activelayer *kpblc-activedoc*)
          vla_layer
          ) ;_ end of equal
       ) ;_ end of not
    (vla-put-freeze vla_layer :vlax-false)
    ) ;_ end of if
  vla_layer
  ) ;_ end of defun

(defun cmd-start (react       cmd        /         selset   cmd_name ent
          svr       res        tag         text     index    _attreq_
          _attdia_
          )
  (setq cmd_name (strcase (car cmd) t))
  (cond
    ((vl-string-search "dim" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Размеры")
       ("color" . 5)
       ("lw" . 13)
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "qleader" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Позиции")
       ("color" . 114)
       ("lw" . 13)
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "leader" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Позиции")
       ("color" . 114)
       ("lw" . 13)
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "xline" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "ProjectionLines")
       ("color" . 100)
       ("lw" . 13)
               ("plot" . "n")
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "table" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Спецификация")
       ("color" . 7)
       ("lw" . 20)
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "vports" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "VPORTS")
       ("color" . 40)
       ("lw" . 13)
       ("plot" . "n")
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "hatch" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Штриховки")
       ("color" . 6)
       ("lw" . 13)
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ((vl-string-search "text" cmd_name)
     (setq *vlr-settings*
        (list (cons    "layer"
            (vla-get-activelayer *kpblc-activedoc*)
            ) ;_ end of cons
          (cons "color" (getvar "cecolor"))
          (cons "lw" (getvar "celweight"))
          (cons "lt" (getvar "celtype"))
          ) ;_ end of list
       ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
     '(("name" . "Тексты")
       ("color" . 194)
       ("lw" . 13)
       )
     ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         '("bylayer" -1 "bylayer")
         ) ;_ end of mapcar
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-end (react         cmd      /           list_obj
        selset         item      counter      leader_item
        cmd_name     leader_item_list           up_string
        low_string
        )
  (setq    cmd_name (strcase (car cmd) t)
    counter     0
    ) ;_ end of setq
  (cond
    ((or (vl-string-search "dim" cmd_name)
     (vl-string-search "qleader" cmd_name)
             (vl-string-search "leader" cmd_name)
     (vl-string-search "xline" cmd_name)
             (vl-string-search "table" cmd_name)
             (vl-string-search "vports" cmd_name)
     (vl-string-search "text" cmd_name)
     (vl-string-search "hatch" cmd_name)
     ) ;_ end of or
     (if *vlr-settings*
       (progn
     (vla-put-activelayer
       *kpblc-activedoc*
       (cdr (assoc "layer" *vlr-settings*))
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         (list (cdr (assoc "color" *vlr-settings*))
               (cdr (assoc "lw" *vlr-settings*))
               (cdr (assoc "lt" *vlr-settings*))
               ) ;_ end of list
         ) ;_ end of mapcar
     (setq *vlr-settings* nil)
     ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-cancel (react cmd / cmd_name)
  (setq cmd_name (strcase (car cmd) t))
  (cond
    ((or (vl-string-search "dim" cmd_name)
     (vl-string-search "qleader" cmd_name)
             (vl-string-search "leader" cmd_name)
             (vl-string-search "xline" cmd_name)
             (vl-string-search "table" cmd_name)
             (vl-string-search "vports" cmd_name)
     (vl-string-search "text" cmd_name)
     (vl-string-search "hatch" cmd_name)
     ) ;_ end of or
     (if *vlr-settings*
       (progn
     (vla-put-activelayer
       *kpblc-activedoc*
       (cdr (assoc "layer" *vlr-settings*))
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
         '("cecolor" "celweight" "celtype")
         (list (cdr (assoc "color" *vlr-settings*))
               (cdr (assoc "lw" *vlr-settings*))
               (cdr (assoc "lt" *vlr-settings*))
               ) ;_ end of list
         ) ;_ end of mapcar
     (setq *vlr-settings* nil)
     ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

;|=============================================================================
*    Функция подгрузки типа линии в текущий файл. Учитывает возможную
* локализацию системы.
*    Параметры вызова:
*  ltype-name  имя типа линии для английской версии
*  ltype-file  имя файла описания типа линии. nil -> "acadiso.lin"ю
*      Если файл с описанием типа линии не лежит по путям
*      поддержки када, надо указывать полный путь к нему.
*    Примеры вызова:
(_kpblc-linetype-load "center" nil)  ; для русской версии подгружает Осевая и возвращает
                                     ; t при успехе
***  Соответствие наименований линий обеспечивается огромным списком ltype_list
*** который можно и нужно дополнять :) Только надо либо все делать мелкими
*** буквами, либо жестко соблюдать регистр в моменты вызовов.
***  Тип линии "Continuous" обработке не подвергается — он есть во всех версиях
=============================================================================|;
(defun _kpblc-linetype-load
       (ltype-name ltype-file / ltype_normal ltype_list result)
  (vl-load-com)
  (setq    ltype_list '(("center" . "осевая")
             ("center2" . "осевая2")
             ("hidden" . "скрытая")
             ("hidden2" . "скрытая2")
             )
    ltype-name (strcase ltype-name t)
    ) ;_ end of setq
  (if (not ltype-file)
    (setq ltype-file "acadiso.lin")
    ) ;_ end of if
  (if (vl-string-search "419" (vlax-product-key))
    ;; Русская версия, меняем имя типа линии
    (setq ltype_normal (cdr (assoc ltype-name ltype_list)))
    (setq ltype_normal ltype-name)
    ) ;_ end of if
  (if (not (tblsearch "ltype" ltype_normal))
    ;; тип линии не найден, надо его загрузить. Тип линии должен быть
    ;; описан в файле
    (setq result (not (vl-catch-all-error-p
            (vl-catch-all-apply
              'vla-load
              (list
                (vlax-get-property
                  (vla-get-activedocument (vlax-get-acad-object))
                  'linetypes
                  ) ;_ end of vlax-get-property
                ltype_normal
                ltype-file
                ) ;_ end of list
              ) ;_ end of vl-catch-all-apply
            ) ;_ end of vl-catch-all-error-p
              ) ;_ end of not
      ) ;_ end of setq
    ) ;_ end of if
  result
  ) ;_ end of defun

[Frigate]

Li6-D,

не очень понятно, как эти отрезке в блоке помогают тебе и главное - когда именно? МОжно, ксати, ставить объект-точку.

Я бы хранил возможные точки подключения в расширенных данных. Или в словаре примитива - или это одно и то же? )))

Но вот как эти данные получать для записи? Откуда?

[Li6-D]

Frigate,
во вложенном чертеже приведен фрагмент графика Ганта, блоки которого содержат "контактные" точки, служащие для соединения блоков между собой.
Просмотреть список точек можно так: (label_block (car (entsel))), где label_block:

Код:

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

;;;Функция проверяет является ли примитив b блоком с "контактными" точками и
;;;возвращает список координат его "контактных" точек относительно точки вставки.
;;;Иначе возвращается nil.
(defun label_block (b / dl tol L LqN)
  (setq dl 1E-3        ;длина отрезка-метки
        tol 0.1        ;предельное относительное отклонение длины
        tol (* tol dl)
        b (entget b)
  )
  (if (= (cdr (assoc 0 b)) "INSERT")
    (progn
      (setq b (cdr (assoc -2 (tblsearch "BLOCK" (cdr (assoc 2 b))))))
      (while b
        (if (and
              (= (cdr (assoc 0 (setq b (entget b)))) "LINE")
              (= (cdr (assoc 60 b)) 1)
              (progn (setq L (list (cdr (assoc 10 b)) (cdr (assoc 11 b))))
                     (<= (abs (- (apply 'distance L) dl)) tol)
            ) )
          (setq LqN (cons (cons (rem (fix (+ (/ (apply 'angle L) pi 0.5) 0.5)) 4) (car L)) LqN))
        )
        (setq b (entnext (cdar b)))
  ) ) )
  LqN
)

Почему отрезки, а не точки? - чтобы добавить еще один код перед координатами точки (от 0 до 3).
Точки с кодом 0 соединяются только с 2, а 1 с 3.
При необходимости можно еще и тип линии загружать.

[Frigate]

Li6-D,

интересный вариант, спасибо.

А как у тебя так получилось, что отрезочки эти миниатюрные видны в редакторе, а в самом чертеже их не видно?

[Li6-D]

Frigate,
как я уже говорил, в dxf-коде отрезков содержится группа (60 . 1), делающая примитивы невидимыми. Добавь эту группу в любой примитив с помощью (entmod (cons '(60 . 1) (entget (car (entsel))))) и он станет невидимым, не будет захватываться рамкой. Но этот примитив никуда из чертежа не делся, его можно даже захватить опциями "_Last", "_All". Посмотреть dxf-список всех примитивов чертежа, включая невидимые объекты, можно так:

Код:

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

;;; Печать DXF-списков всех примитивов чертежа
(defun C:Print-Dwg-All ( / ss i)
  (repeat (if (setq ss (ssget "_X")) (setq i (sslength ss)) (progn (alert "Ничего нет") 0))
    (print (entget (ssname ss (setq i (1- i))))) (print))
  (textscr)
  (princ)
)

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

puma, я сейчас проверил код - ни команда создания отрезков, ни команда создания полилиний в реакторе не отслеживаются. Создание текста в слое с типом линии "не-Continuous" корректно вернуло все настройки обратно. Может, еще есть какие-то дополнительные приложения?

[puma]

Насчет полилиний и отрезков - извините, ввел вас в заблуждение, но при тексте также повторяется ошибка при том коде, что я выложил. Все дополнительные приложения временно были удалены. Autocad 2011. Скорее всего просто у вас в коде уже это исправлено. Извините за беспокойство как исправить более менее разобрался, тем более нашел на форуме ваш архив, который вы пересылали ShaggyDoc. Как я понял там как раз это уже исправлено (смысл исправлений, что и у меня, но гораздо элегантней - мне еще лет 10 учиться надо), но жутко завязано на базе данных. Жаль, что наиболее распространена на форуме старая версия. Еще раз спасибо за великолепные функции.

[Frigate]

Li6-D,

а ты DXF-код отрезков где менял? Программно, когда запущен редактор блоков? Или уже в чертеже?


Прошу знающих помочь со следующими 2 вопросами:

1. Как для блока задать цвет? Через TrueColor? А дальше как? Если можно - дайте пример.

2. Создание Группы ( в семействе блоков).
Имеется - список (list) VLA-указателей на блоки: obj_list. Всего в списке 17 блоков (указателей на блоки).
Надо сгруппировать эти блоки в единую группу, чтобы можно было их разом всех вместе выделять и перетаскивать.

ВОт так пытался сделать:

Код:

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

(setq safe_ar (vlax-make-safearray vlax-vbObject '(0 . 16)))
(vlax-safearray-fill safe_ar obj_list)
(vlax-safearray->list safe_ar)
(setq var_list (vlax-make-variant safe_ar (logior vlax-vbarray vlax-vbObject)))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq blocks_col (vla-get-blocks adoc))
(setq a (vlax-3d-point '(0.0 0.0 0.0)))
(vla-add blocks_col a "LabelsGroup1")
(vla-appenditems var_list)

В ответ получил вот что:

Команда: (vla-appenditems var_list) ; ошибка: неверный тип аргумента: VLA-OBJECT #<variant 8201 ...>

В чем именно я ошибся при создании варианта из массива объектов?

[TararykovDG]

Frigate, а не проще ли запихнуть нужные блоки в набор

Код:

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

(setq nbr_blocks (ssadd)) ; создали пустой набор
(foreach item obj_list (setq nbr_blocks (ssadd (vlax-vla-object->ename item) nbr_blocks))) ; запихнули в него блоки
...
(sssetfirst nil nbr_blocks) ; на экране подсветились объекты набора nbr_blocks (хошь копирую, хошь перетаскивай, хошь удаляй все разом)

[Frigate]

TararykovDG,

но этот набор сразу же исчезнет после любой операции, так ведь?
Тогда это не совсем то. Хотелось бы, чтоб пользователь мог легко перетащить весь набор в любой момент времени, да и скопировать, если что - не выбирая каждый блок.

Что посоветуешь - в чем моя ошибка в коде?

[Лиспер]

Сообщение от Frigate Как для блока задать цвет?

Для описания блока или для вхождения блока? В любом случае есть vla-put-color, который понимает индексированные цвета.

Сообщение от Frigate Создание Группы ( в семействе блоков).

Тут вообще ничего не понял. О создании групп объектов см., например, http://www.cadtutor.net/forum/showth...-about-groups&

[TararykovDG]

Frigate, а зачем Тебе объединять объекты в блок, только для того чтобы потом работать с ними всему сразу при копировании и др. операциях. В моем варианте я запихнул все нужные объекты в набор nbr_blocks и теперь (если конечно этот набор не переопределить) я могу в любой момент сделать (sssetfirst nil nbr_blocks). Подсветяться ручки наших объектов и делай с ними что надо.
Если хочешь посмотри еще такой вариант Повтор предыдущего выбора элементов

[Frigate]

Лиспер,

вот уж спасибо

а все-таки, ради интересе - что неверного в моем коде? Вроде все по описанию объектной модели делал...

TararykovDG

а после закрытия чертежа ведь этот набор исчезнет, так?
Или его можно как-то сохранить?

[Лиспер]

Ты создаешь блок, а не группу. Для создания группы можно использовать нечто типа

Код:

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

(vla-add (vla-get-groups adoc) name)

И в результат уже выполнять vla-appenditems

[TararykovDG]

Сообщение от Frigate TararykovDG а после закрытия чертежа ведь этот набор исчезнет, так? Или его можно как-то сохранить?

Ну можно сделать чтобы сохранялся и после закрытия чертежа. Способов сохранения информации много, но в данноч случая ИМХО лучше всего создать словарь и в него записать набор. Во-первых никаких доп. файлов, никаких заморечей с реестром и для каждого чертежа будет свой словарь в котором своя инфа именно с этого чертежа + при копировании /переносе/переименовании чертежа даже на разные компы вся инфа сохраняется вместе с самим чертежом

[Лиспер]

Решение тоже не ахти: в словарях придется хранить хендлы, которые могут повторяться при вставке этого чертежа как внешней ссылки. Я такое всего один раз встречал, но сам факт напрягает.

[Frigate]

Лиспер,
ну внешней сылкой я его вставлять не буду - это точно.

А просто группа будет перетаскиваться вся целиком если ее мышкой ухватить?

TararykovDG,

со словарями уже немного знаком - набил руку. Хорошо, наверное такой способ мне подойдет.

[E-degtyarev]

Подскажите, пожалуйста, как получить Lisp-ом координаты центра тяжести REGION -а? Сильно замучился я с этим делом.

[Лиспер]

Код:

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

(vl-load-com)

(defun test (/ ent center)
  (if (= (type (setq ent (vl-catch-all-apply
                           (function
                             (lambda ()
                               (vlax-ename->vla-object (ssname (ssget "_+.:S:E" '((0 . "REGION"))) 0))
                               ) ;_ end of lambda
                             ) ;_ end of function
                           ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of TYPE
         'vla-object
         ) ;_ end of =
    (setq center (vlax-safearray->list (vlax-variant-value (vla-get-centroid ent))))
    ) ;_ end of if
  center
  ) ;_ end of defun

[E-degtyarev]

Лиспер, Огромное спасибо!

[Frigate]

TararykovDG,

ты был прав. Я разобрался с sssetfirst. Очень полезная команда.

Подскажите пожалуйста, возможно ли при помощи ЛИСП выбрать папку, а не файл в папке (по getfiled или еще может какие команды есть) ?
Сейчас мне приходится выбирать любой файл в папке, чтобы "подхватить" из этого выбора путь папки. А хочется, чтобы только папки показывало окно выбора, без файлов.

[Лиспер]

http://forum.dwg.ru/showthread.php?t=16560 ?

[E-degtyarev]

Frigate, Попробуй такую функцию, может сгодится?

Код:

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

(defun GetFolder (/ Dir Item Path)
 (cond
  ((setq Dir (vlax-invoke (vlax-get-or-create-object "Shell.Application") 'browseforfolder 0 "Выберите папку с DWG файлами:" 1 ""))
   (cond
    ((not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke-method (list Dir 'Items))))
     (setq Item (vlax-invoke-method (vlax-invoke-method Dir 'Items) 'Item))
     (setq Path (vla-get-path Item))
     )
   );end cond
  )
 );end cond
 Path
);end GetFolder

[sanya V]

Доброго времени суток!
Вот такой вопрос:
почему такой код

(entmake (list '(0 . "TEXT")
'(10 216422.0 22222.09 0.0)
'(40 . 150.0)
'(1 . "X")
'(71 . 0)
'(72 . 0)
'(73 . 0)))

(entmake (list '(0 . "TEXT")
'(10 222422.0 22222.09 0.0)
'(40 . 150.0)
'(1 . "XY")
'(71 . 0)
'(72 . 1)
'(73 . 0)))

исполняется так:

"Х" отображается по координате (216422.0 22222.09 0.0), а
"XY" по координате (0.0 0.0 0.0), а не по (222422.0 22222.09 0.0)?

[Лиспер]

http://autolisp.ru/2010/04/06/text-and-attrib-entities/

[sanya V]

Пасибки!
засада, значит

[Лиспер]

Почему засада? Просто надо не только 10, но и 11 группу устанавливать - вот и все дела.

[sanya V]

Двойное "пасибки"!
Я не профи, только учусь (проектировщик)
Работает!!!

[Frigate]

E-degtyarev,

о, спасибо большое!!! ТО, чот нужно!

а есть возможность по браузеру выбирать и файлы? Чтобы у меня вид окон был одинаков для папок и для файлов.

Никак не могу еще один вопрос решить - тормозит автокад и все тут, даже виснет.

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

Пробовал вот такой код:

Код:

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

 
(defun C:test ()
(vl-load-com)
(setq ent   (vlax-ename->vla-object (car (entsel "\nВыбрать таблицу : "))) 
            ) ;_ end of setq 
(vla-setcellgridlineweight
 ent
        5 ;можно использовать переменную-счетчик рядов
        3 ;можно использовать переменную-счетчик колонок
        (+ acleftmask acrightmask)
        aclnwt040
        ) ;_ end of vla-SetCellGridLineWeight
)

С одной ячейкой вполне нормально работает.
Но если этот код применить в цикле и ко многим ячейкам, то автокад просто виснет... что-то не так делаю. Прошу поделиться ссылкой или код, как массово менять толщину границ ячеек
Заранее благодарен.

[TararykovDG]

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

Если вес линий нужно поменять для всех ячеек, а не для каких-то отдельных, то вместо vla-setcellgridlineweight в цикле для каждой ячейки попробуй использовать vla-SetGridLineWeight для всей таблицы.

[Frigate]

TararykovDG,

я немного неточно спросил. Мне нужно, чтобы вертикальные линии выбранного диапазона ячеек стали толстыми, а горизонтальные остались по умолчанию - тонкими.

И чтобы этот код не тормозил, как у меня происходило. В итоге пришлось просто создать шаблон таблицы. Но ведь хочется самому иметь возможность подправить таблицу - вернее, выбранный диапазон ячеек.

[TararykovDG]

Сообщение от Frigate Но если этот код применить в цикле и ко многим ячейкам, то автокад просто виснет...

Frigate, а какая размерность таблицы. Дело в том, что большая таблица сама по себе уже жрет много системных ресурсов, например при попытке создания таблицы 50х40 акад говорит что "В таблице больше 2000 ячеек..." ну и что мол будет тратиться много системных ресурсов

У меня для таблицы 30х30 при модификации ячеек с 1 по 20 по столбцам и с 1 по 25 по строкам затратилось примерно 17 секунд. Какие у Тебя результаты?

[Frigate]

TararykovDG,

я когда игрался с таблицами, задавал в цикле, чтобы вертик. границы 8 ячеек стали толстыми. Очень сильно тупил АКАд, пока не щалкнешь мышкой, он так и висит, а как щелкнешь - задумается и все-таки родит - сделает вертик. границы толстыми. Щас попробую-ка еще разок

Проверил. В общем в прошлый раз я что-то напутал в коде.
Таблица 30 на 30. Задавал вертик. границы первым 25 строкам, всем 30 столбцам. Примерно 20-25 секунд выполнялось.

ВОт код:

Код:

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

(tbl 1 1 25 30)

(defun tbl (1row 1col row col /  ent i j)
(setq ent   (vlax-ename->vla-object (car (entsel "\nВыбрать таблицу : ")))) ;_ end of setq 
(setq 	i (1- 1row) 
	j (1- 1col)
)
(repeat (1- col)
(repeat (1- row)
(vla-setcellgridlineweight
	ent
        i ;можно использовать переменную-счетчик рядов
        j ;можно использовать переменную-счетчик колонок
        (+ acleftmask acrightmask)
        aclnwt040
) ;_ end of vla-SetCellGridLineWeight
(setq i (1+ i))
);end repeat
(setq j (1+ j))
(setq i 0)
);end repeat
);_end of defun

[Nikolay 2]

Сообщение от Frigate Таблица 30 на 30. Задавал вертик. границы первым 25 строкам, всем 30 столбцам. Примерно 20-25 секунд выполнялось.

Аналогичная таблица, код отработал за 15 сек

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

Почему-то в AutoCAD 2011 Rus 64 bit отказывается обрабатывать последние две строки. Хотя должно...

Код:

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

(vl-load-com)

(defun test (/ tbl col_count row_count err)
  (if (= (type (setq tbl (vl-catch-all-apply
                           (function
                             (lambda ()
                               (vlax-ename->vla-object (ssname (ssget "_+.:S:E" '((0 . "ACAD_TABLE"))) 0))
                               ) ;_ end of lambda
                             ) ;_ end of function
                           ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'vla-object
         ) ;_ end of =
    (progn
      (vla-put-regeneratetablesuppressed tbl :vlax-true)
      (setq col_count 0
            row_count 0
            ) ;_ end of setq
      (repeat (vla-get-columns tbl)
        (repeat (+ (if (equal (vla-get-titlesuppressed tbl) :vlax-false)
                     1
                     0
                     ) ;_ end of if
                   (vla-get-rows tbl)
                   ) ;_ end of +
          (if (vl-catch-all-error-p
                (setq err (vl-catch-all-apply
                            (function
                              (lambda ()
                                (vla-setcellgridlineweight tbl col_count row_count (+ acleftmask acrightmask) aclnwt211)
                                ) ;_ end of lambda
                              ) ;_ end of function
                            ) ;_ end of vl-catch-all-apply
                      ) ;_ end of setq
                ) ;_ end of vl-catch-all-error-p
            (princ (strcat "\n Col: "
                           (itoa col_count)
                           " row: "
                           (itoa row_count)
                           "; err: "
                           (vl-catch-all-error-message err)
                           ) ;_ end of strcat
                   ) ;_ end of princ
            ) ;_ end of if
          (setq row_count (1+ row_count))
          ) ;_ end of repeat
        (setq row_count 0
              col_count (1+ col_count)
              ) ;_ end of setq
        ) ;_ end of repeat
      (vla-put-regeneratetablesuppressed tbl :vlax-false)
      (vla-update tbl)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

[Frigate]

Уважаемые гуру,

подскажите пожалуйста, как сделать такой вариант запроса:

"Укажите точку вставки перечня кабелей [1 - указать количество столбцов самому]:"

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

Типа как в автокадовскиъ командах, когда можно ввести следующую точку, но можно поменять настройки, ввести численно длину и тп.

[TararykovDG]

Код:

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

(initget 1 "0 1 2") ; запретили пустой ввод (Enter), можно указать точку или ввести один из разрешенных (0 1 2) символов
(getpoint "\n Укажите точку вставки перечня кабелей или [0 - Указать количество столбцов самому/1 - Попросить соседа/2 - Забить на все и идти пить пиво]: ") ; вернет точку вставки (если укажешь на экране) или один из символов "0", "1" или "2"

При запросе указываешь точку или вводишь разрешенный символ или правой кнопкой мыши и выбираешь из контексного меню.

[Frigate]

TararykovDG,

а как быть, если надо не просто указать точку, но и визуализировать движения курсора при помощи grread?

Я через grread щас домучал автокад и в итоге вот что получил:

Код:

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

(defun C:pnt ( / flag flag2 pt pt2 gr default_column_num)
(setq flag T)
(setq default_column_num 1)
(setq flag2 T)
(setq pt (getpoint "\nУкажите начальную точку:"))

(PRINC "\nУкажите точку вставки перечня кабелей или [1-указать количество столбцов]:")
(while flag
(setq gr (grread t 3))
(redraw)
(if (= (car gr) 5) (grdraw pt (cadr gr) 1 1) )
(COND
;===первое условие
	(
		(equal gr '(2 49))
(PROGN
(PRINC (vl-princ-to-string gr))
(setq flag2 T)
(while flag2
	(if   (not (setq column_num
  		 (getint    (strcat "\nУкажите число столбцов <" 
		(itoa default_column_num) ">: "))))
	(setq column_num default_column_num)
                  )

	(if (<= column_num 0 )
		(PRINC "\nНужно ввести целое число больше нуля!")
		(setq flag2 nil)
	)
)
(setq flag nil)
);_end PROGN 
	)
;===второе условие
	(
		(= (car gr) 3)
(PROGN
(setq pt2 (cadr gr))
(PRINC (vl-princ-to-string gr))
(setq flag nil)
);_end PROGN
	)
);_end COND
);_end while  

);_end defun

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

Код:

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

(defun get-point-or-columns (/ pt gr res)
  (if (= (type (setq pt (vl-catch-all-apply
                          (function
                            (lambda ()
                              (getpoint "\nБазовая точка <Отмена> : ")
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'list
         ) ;_ end of =
    (progn
      (initget "К _ R")
      (if
        (member (type
                  (setq
                    res (vl-catch-all-apply
                          (function
                            (lambda () (getpoint pt "\nТочка вставки перечня кабелей [Количество столбцов] <Отмена> : "))
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                    ) ;_ end of setq
                  ) ;_ end of type
                (list 'list 'str)
                ) ;_ end of member
         (cond
           ((= res "R")
            (if (/= (type (setq res (vl-catch-all-apply (function (lambda ()
                                                                    (initget 5)
                                                                    (getint "\nКоличество столбцов <Отмена> : ")
                                                                    ) ;_ end of lambda
                                                                  ) ;_ end of function
                                                        ) ;_ end of vl-catch-all-apply
                                ) ;_ end of setq
                          ) ;_ end of type
                    'int
                    ) ;_ end of /=
              (setq res nil)
              ) ;_ end of if
            )
           ) ;_ end of cond
         (setq res nil)
         ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  res
  ) ;_ end of defun

[Michael!]

Доброго времени суток!
Вот написал программку, суть которой скопировать объект на рассчитанное предварительно расстояние и после скопированному объекту надо сделать stretch с каждой стороны. делаю выделение, а он его (этот объект не видит).

Код:

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

(command "stretch" "Crossing" stretch_point_r_up stretch_point_r-down "" "10,10" umenshenye_right)
(command "stretch" "Crossing" stretch_point_l_up stretch_point_l-down "" "10,10" umenshenye_left)

Когда запускаю прогу повторно, предидущий объект становится видимым. (stretch выполняется)
Видимо "свежескопированный" объект не видим для stretch.
помогите, как сделать чтобы заработала прога

[Frigate]

Кулик Алексей aka kpblc,

Алексей, БРАВО :-)

Сразу видно мастера ЛИСПа. А то я тут через Камчатку в Москву всю видимо пытаюсь ехать

А можешь код модифицировать так, чтобы после указания количества столбцов пользователь уже выбрал точку вставки?

Только объясни мне, пожалуйста, какой кусок кода отвечает за прорисовку временной линии от первой точки до точки вставки перечня кабелей? Кстати, я не увидел в коде локальной переменной gr...

Добавлено:

Я понял, Алексей, как теперь сделать

Благодарю за просвещение :-)

А то я что-то плохо очень знал возможности getpoint. Зато полез в дебри grread
В общем вывод - изучать возможности основных функций АвтоЛиспа.

[Li6-D]

Сообщение от Michael! ....Видимо "свежескопированный" объект не видим для stretch. помогите, как сделать чтобы заработала прога

Наверное объект тоже создан командными методами (с помощью функций command или vl-cmdf). Предыдущая команда выполнена, а новый примитив не добавлен в БД чертежа (на подходе). Autolisp не проверяет завершение процесса и приступает к следующей команде stretch. Чтобы задуманная последовательность действий сохранялась, командные программисты между командами обычно вставляют "костыль" - запрос, который должен надолго озадачить пользователя, например (getstring "\nТы абсолютно уверен, что хочешь обрезать объект? ") В этом - минус командных методов. Полноценное решение задачи - с помощью технологии ActiveX.

[Michael!]

to Li6-D
да. да. именно так и происходит. я получаю этот объект посредством копирования пред идущего.
Подскажи, а как это реализовать через ActiveX ?
задача в общем-то такая: нужно выбранный объект скопировать, перетащить в другой слой и сделать уже перетащенному stretch с двух сторон на заданное расстояние. А потом тоже самое сделать с полученным после трима объектом.
Спасибо!

[Li6-D]

Michael!,
К сожалению помочь не смогу, так как сам такой и не знаю ActiveX.
А вообще данных сообщено маловато. Код скуп, копируемый объект неизвестен.

[Michael!]

А может есть какаянибудь команда на регенерацию и внесение в базу чертежа новых объектов?

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

Frigate, просто можно повторно запросить точку в случае выбора "Количество столбцов", это не сложно. Я-то полной задачи не знаю, потому такой код и нарисовал.
Michael!, я не очень понял. Есть исходный объект:
(setq ent (car (entsel)))
Потом он копируется:
(command "_.copy" ent "" pause pause)
А потом к нему выполняется _.stretch:
(command "_.stretch" (entlast) <...>)
Так?
Можно вариант переделать (пишу без проверок):

Код:

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

(if (and (setq ent (car (entsel)))
         (vl-cmdf "_.copy" ent "" pause pause)
         ) ;_ end of and
  (progn
    (if (not (vl-cmdf "_.stretch" (entlast) <...>))
      (command "_.undo")
      (if (not (vl-cmdf "_.stretch" (entlast) <...>))
        (command "_.undo")
        ) ;_ end of if
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if

Только вот проблема: если пользователь нажмет Esc или правую кнопку мыши, результат _.stretch может оказаться непредсказуемым. Я не помню точно, на какой версии я с этим обжегся, но сейчас я бы всерьез задумался о полностью программном изменении примитива. В результате дешевле выйдет.

[Michael!]

to Кулик Алексей aka kpblc
А поясните пожалуйста строки вашего кода.
entsel, я не пользовал ни разу.
задумка у меня такая:

Код:

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

(defun c:c1 ()

(command "setvar" "osmode" 675) ; snapon
(setq point_x1_y1 (getpoint "\n Lowest left point -->"))
(setq point_x2_y2 (getpoint "\n Highest right point -->"))
(setq um 15)
(command "setvar" "osmode" 17059) ;snapoff

(setq x1 (car point_x1_y1))
(setq y1 (cadr point_x1_y1))
(setq x2 (car point_x2_y2))
(setq y2 (cadr point_x2_y2))

(setq copy_point_r_up (strcat (rtos (+ x2 2) 2) "," (rtos (- y2 2) 2)))
(setq copy_point_l_down (strcat (rtos (- x1 2) 2) "," (rtos (+ y1 2) 2)))

(setq dista (+ (- x2 x1) 300))

(setq x2new (strcat (rtos (- x2 dista) 2) "," (rtos y2 2)))
(setq x1new (strcat (rtos (- x1 dista) 2) "," (rtos y2 2)))

(setq point_new_r_up (strcat (rtos (+ (- x2 dista) 2) 2) "," (rtos (- y2 2) 2)))
(setq point_new_l_down (strcat (rtos (- (- x1 dista) 2) 2) "," (rtos (+ y1 2) 2)))

(command "copy" "w" copy_point_r_up copy_point_l_down "" point_x2_y2 x2new)

;(command "_.change" "w" point_new_r_up point_new_l_down "" "p" "layer" "tm8" "")

(command "_.change" (ssget "_l") "" "p" "layer" "tm8" "")

(setq x1 (- x1 dista))
(setq x2 (- x2 dista))

(setq point_l (+(* (- x2 x1) 0.33333) x1))
(setq point_r (+(* (- x2 x1) 0.66666) x1))

(setq stretch_point_r_up (strcat (rtos (+ x2 2) 2) "," (rtos (- y2 2) 2)))
(setq stretch_point_r-down (strcat (rtos point_r 2) "," (rtos (+ y1 2) 2)))

(setq stretch_point_l_up (strcat (rtos point_l 2) "," (rtos (- y2 1) 2)))
(setq stretch_point_l-down (strcat (rtos (- x1 2) 2) "," (rtos (+ y1 2) 2)))

(setq umenshenye_right (strcat "@-" (rtos um) "," "0"))
(setq umenshenye_left (strcat "@" (rtos um) "," "0"))

(command "stretch" "Crossing" stretch_point_r_up stretch_point_r-down "" "10,10" umenshenye_right)
(command "stretch" "Crossing" stretch_point_l_up stretch_point_l-down "" "10,10" umenshenye_left)

(command "setvar" "osmode" 675) ; snapon

); end defun c:c1

выделить объект, скопировать его на заданное расстояние, переместить в другой слой, сделать ему стретч с двух сторон. потом с полученным объектом проделать тоже самое. Это в общем суть этой функции. А эта функция работает в цикле, в котором задается какое количество раз нужно проделать эти операции над объектом и насколько ему нужно делать stretch.

[Li6-D]

Michael!,
Много буков, а леса не видно. Опять фрактальные построения что ли? Наведу критику:
1) Не объявлены локальные переменные (хотя сойдет для отладки). Создана команда, а не функция.
Если она не вызывается юзером, а используется другой функцией, то незачем ее делать командой.
2) Почитай про функцию setvar.
3) Зачем строковое представление точек? Точки-списки нормально воспринимаются в command-функции.
4) Если нужно получить точку, смещенную на определенный вектор относительно исходной можно написать:
(setq Pt1 (mapcar '+ Pt0 '(-2 2 0))), где '(-2 2 0) - вектор смещения.
Если есть две точки Pt0, Pt и надо найти точку Pt1 на отрезке их соединяющем и
делящую этот отрезок в заданной пропорции. Варианты решения:
(setq Pt1 (polar Pt0 (angle Pt0 Pt) (/ (distance Pt0 Pt) 3)))
(setq Pt1 (mapcar '(lambda (x y) (/ (+ x x y) 3)) Pt0 Pt))
5) Ни одного примитива код не создает, какого рода объекты копируются?
Если примитивы простые, то может их проще создавать entmake, а не копировать.
6) Пиши так: (command "_.stretch" "_Crossing"... ) - у многих стоит локализованная версия.

[Michael!]

согласен.
1. они будут объявлены позже. пока она вызывается именно так. поэтому я и написал что С:
2. почитаю
3. так понятнее для меня было - исправлю.
4. не знал что так можно/нужно делать
5. копируются полилинии замкнутые
6. тут я для себя пишу. на моем компе и так работает.

так всетаки, как сделать смену слоя и stretch для полученного объекта?

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

Michael!, я так и не понял конечного смысла использования _.stretch (кстати, код не будет работать в русской версии). Что, надо переместить объект вправо-влево? Приложи dwg-файл, с которым работаешь. Точнее, интересны объекты, над которыми выполняются настолько непонятные операции.

[Michael!]

to Кулик Алексей aka kpblc
вот приложил файлик-пример. Объекты - это полилинии. Невсегда симметричные, разных размеров. Это контуры объектов.
Работаю я в 2004 autocad английской версии. Поэтому работоспособность для русских версий я не рассматриваю.

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

В качестве первого прикидочного варианта:

Код:

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

(vl-load-com)

(defun c:copy-and-modify (/ adoc ent layer coords new_coords new_point)

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (ssname (ssget "_+.:S:E" '((0 . "LWPOLYLINE") (90 . 4))) 0)
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (setq coords (vl-sort
                          (mapcar (function cdr)
                                  (vl-remove-if-not
                                    (function
                                      (lambda (x)
                                        (= (car x) 10)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    (entget ent)
                                    ) ;_ end of vl-remove-if-not
                                  ) ;_ end of mapcar
                          (function
                            (lambda (a b)
                              (< (car a) (car b))
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-sort
                 ) ;_ end of setq
           (= (type (setq new_point (vl-catch-all-apply
                                      (function
                                        (lambda ()
                                          (getpoint
                                            (car coords)
                                            "\nНовая точка вставки <Отмена> : "
                                            ) ;_ end of getpoint
                                          ) ;_ end of lambda
                                        ) ;_ end of function
                                      ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           new_point
           (= (type (setq step (vl-catch-all-apply
                                 (function
                                   (lambda ()
                                     (initget 3)
                                     (/ (getdist "\nВведите уменьшение <Отмена> : ") 2.)
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                 ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'real
              ) ;_ end of =
           (= (type (setq layer (vl-catch-all-apply
                                  (function
                                    (lambda (/ res)
                                      (cond
                                        ((= (setq res (getstring "\nНовое имя слоя <Текущий> : ")) "")
                                         (getvar "clayer")
                                         )
                                        (t res)
                                        ) ;_ end of cond
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'str
              ) ;_ end of =
           ) ;_ end of and
    (progn
      (setq new_coords (mapcar
                         (function
                           (lambda (x)
                             (list (+ (car x)
                                      (car new_point)
                                      (- (caar coords))
                                      (* step
                                         (if (< (vl-position x coords) (/ (length coords) 2))
                                           1
                                           -1
                                           ) ;_ end of if
                                         ) ;_ end of *
                                      ) ;_ end of +
                                   (+ (cadr x) (cadr new_point) (- (cadar coords)))
                                   ) ;_ end of list
                             ) ;_ end of lambda
                           ) ;_ end of function
                         coords
                         ) ;_ end of mapcar
            ) ;_ end of setq
      (entmakex (append
                  (vl-remove-if
                    (function
                      (lambda (x)
                        (member (car x) '(-1 5 330 300 10))
                        ) ;_ end of lambda
                      ) ;_ end of function
                    (subst (cons 8 layer) (assoc 8 (entget ent)) (entget ent))
                    ) ;_ end of vl-remove-if
                  (mapcar
                    (function
                      (lambda (x)
                        (cons 10 x)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    new_coords
                    ) ;_ end of mapcar
                  ) ;_ end of append
                ) ;_ end of entmakex
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[Michael!]

to Кулик Алексей aka kpblc
спасибо огромное!
А можно с пояснениями чуть чуть. Хочу разобраться всетаки что к чему. Не понял как она делает уменьшение.
Уменьшение происходит только с одной стороны. хотелось бы уменьшать на одинаковое расстояние с двух сторон. причем stretch делать с 1/3 длины объекта

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

А "треть длины" - это по какому направлению считать?
Offtop: Код сделан был только для того случая, который был представлен.

[Michael!]

вот в приложенном файле я обозначил области

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

А как изменять верхнюю часть?
Вообще-то я бы, наверное, сделал просто блок и его вставлял с разными масштабами по разным осям. Может, неэтично, зато дешево, надежно и практично
---
Добавлено:

1. Сначала формируем набор:
   
   Код:

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

   (ssget "_+.:S:E" '((0 . "LWPOLYLINE") (90 . 4)))

   Сразу указывается, что может быть выбран только один примитив, только внутри прицела, что этот примитив LWPOLYLINE и в нем 4 вершины. По идее можно добавить еще и флаг замкнутости, но это я делать поленился
2. Следом получаем из него первый (он же единственный) примитив:
   
   Код:

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

   (ssname (ssget "_+.:S:E" '((0 . "LWPOLYLINE") (90 . 4))) 0)

3. "Обертываем" все в отлов ошибок (ведь юзер может запросто нажать Esc):
   
   Код:

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

   (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (ssname (ssget "_+.:S:E" '((0 . "LWPOLYLINE") (90 . 4))) 0)
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply

4. Если тип возвращаемого этой конструкцией значения ename
   
   Код:

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

    (= (type (setq ent (vl-catch-all-apply <...>))) 'ename)

   То выбор был сделан и сделан корректно. Сразу после этого получаем координаты полилинии:
5. Код:

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

                    (mapcar (function cdr)
                                     (vl-remove-if-not
                                       (function
                                         (lambda (x)
                                           (= (car x) 10)
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                       (entget ent)
                                       ) ;_ end of vl-remove-if-not
                                     ) ;_ end of mapcar

   Получаем через entget DXF-представление примитива, убираем все точечные пары, у которых ключ не 10, и применяем к ним функцию cdr.
6. И сразу сортируем:
   
   Код:

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

              (setq coords (vl-sort
                             (mapcar (function cdr)
                                     (vl-remove-if-not
                                       (function
                                         (lambda (x)
                                           (= (car x) 10)
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                       (entget ent)
                                       ) ;_ end of vl-remove-if-not
                                     ) ;_ end of mapcar
                             (function
                               (lambda (a b)
                                 (< (car a) (car b))
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             ) ;_ end of vl-sort
                    ) ;_ end of setq

   по возрастанию значения X координаты.
7. После этого получаем новую точку, куда надо будет вставлять измененную копию примитива, оборачивая ее в vl-catch-all-apply:
   Код:

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

              (= (type (setq new_point (vl-catch-all-apply
                                         (function
                                           (lambda ()
                                             (getpoint
                                               (car coords)
                                               "\nНовая точка вставки <Отмена> : "
                                               ) ;_ end of getpoint
                                             ) ;_ end of lambda
                                           ) ;_ end of function
                                         ) ;_ end of vl-catch-all-apply
                             ) ;_ end of setq
                       ) ;_ end of type
                 'list
                 ) ;_ end of =

   Абсолютно аналогично первому шагу. По тому же алгоритму получаем уменьшение и имя слоя:
   Код:

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

              (= (type (setq step (vl-catch-all-apply
                                    (function
                                      (lambda ()
                                        (initget 3)
                                        (/ (getdist "\nВведите уменьшение <Отмена> : ") 2.)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    ) ;_ end of vl-catch-all-apply
                             ) ;_ end of setq
                       ) ;_ end of type
                 'real
                 ) ;_ end of =
              (= (type (setq layer (vl-catch-all-apply
                                     (function
                                       (lambda (/ res)
                                         (cond
                                           ((= (setq res (getstring "\nНовое имя слоя <Текущий> : ")) "")
                                            (getvar "clayer")
                                            )
                                           (t res)
                                           ) ;_ end of cond
                                         ) ;_ end of lambda
                                       ) ;_ end of function
                                     ) ;_ end of vl-catch-all-apply
                             ) ;_ end of setq
                       ) ;_ end of type
                 'str
                 ) ;_ end of =

8. И только в том случае, если все выбрано и указано верно, начинаем собственно работу. Для начала модифицируем координаты:
   
   Код:

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

         (setq new_coords (mapcar
                            (function
                              (lambda (x)
                                (list (+ (car x)
                                         (car new_point)
                                         (- (caar coords))
                                         (* step
                                            (if (< (vl-position x coords) (/ (length coords) 2))
                                              1
                                              -1
                                              ) ;_ end of if
                                            ) ;_ end of *
                                         ) ;_ end of +
                                      (+ (cadr x) (cadr new_point) (- (cadar coords)))
                                      ) ;_ end of list
                                ) ;_ end of lambda
                              ) ;_ end of function
                            coords
                            ) ;_ end of mapcar
               ) ;_ end of setq

9. И после этого создаем новый примитив, удаляя точечные пары с ключами 1, 5, 330 и заменяя группы 10.
10. После этого ставим метки начала и конца отмены и не забываем про (vl-load-com). Код готов

[Michael!]

круто! спасибо за разъяснения.
на счет вставки блока с разными масштабами по осям - интересная мысль.
а как копировать и вставлять блок. ведь после вставки вновь появившийся объект опять не будет виден программе.
потом, не хотелось бы трогать 2/3 середины, а уменьшать только по 1/3 с краев фигур. (кстати, формы бывают абсолютно разные. Не обязательно это многоугольник. это может быть совокупность дуг и отрезков.
пробовал свой код с "костылем" по методу Li6-D - не помогает. Всеравно после него объект не виден.

[ShaggyDoc]

вот приложил файлик-пример. Объекты - это полилинии. Невсегда симметричные, разных размеров. Это контуры объектов.

И зачем здесь STRETCH? Показаны всего лишь трапеции. Пусть несимметричные, пусть разных размеров, с разными углами наклонов и т.п.

Надо делать простейшую функцию рисования трапеции полилинией по заданным аргументам, которая еще тысячу раз пригодится.

Вот примеры:

Код:

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

(defun ru-draw-trapezium-by-side (start_pnt      ang
                                  len            start_left_len
                                  start_right_len
                                  end_left_len   end_right_len
                                  lineweight     /
                                  end_pnt
                                 )
  ;; трапеция по стороне
;;;(ru-draw-trapezium-by-side (getpoint "Начало патрубка:") 0 500 100.0 100.0 100.0 100.0 0)  
  (setq end_pnt (polar start_pnt ang len)) ;_ end of setq
  (ru-line-add-multi
    (list

          (polar end_pnt (ru-geom-go-left ang) end_left_len) 
          (polar end_pnt (ru-geom-go-right ang) end_right_len) 
          (polar start_pnt (ru-geom-go-right ang) start_right_len)
          (polar start_pnt (ru-geom-go-left ang) start_left_len)
    ) ;_ end of list
    t
    lineweight
    nil
  ) ;_ end of 
  (princ)
)

(defun ru-draw-trapezium-by-center (start_pnt      ang
                                    len            start_left_len
                                    start_right_len
                                    end_left_len   end_right_len
                                    lineweight     /
                                    end_pnt
                                   )
  ;; трапеция с заданным центром
;;;(ru-draw-trapezium-by-center (getpoint "Центр трапеции:") 0 500 100.0 200.0 150.0 250.0 50)  
  (ru-draw-trapezium-by-side
    (polar start_pnt (ru-geom-go-back ang) (/ len 2))
    ang
    len
    start_left_len
    start_right_len
    end_left_len
    end_right_len
    lineweight
  ) ;_ end of ru-draw-trapezium-by-side
  (princ)
)

Не привожу ru-line-add-multi - рисование кучи отрезков по списку точек (можно заменить командой). Ну и элементарные функции для определения углов (направлений) от заданного угла:

Код:

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

(defun ru-geom-go-back (u)
  (+ u pi)
)
(defun ru-geom-go-left (u)
  (+ u (/ pi 2))
)

(defun ru-geom-go-right (u)
  (- u (/ pi 2))
)

которые тоже тысячи раз применяются.

[Michael!]

то ShaggyDoc
спасибо за совет. Но, я писал выше что трапецию я просто для примера привел. в качесве контура могут быть любые фигуры симметричные-несимметричные, совокупности образованные и дугами и линиями вместе.
и уменьшать их надо по краям на одинаковое расстояние.

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

Michael!, отлично! В VLIDE выполни такой код:

Код:

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

'((0 . "LWPOLYLINE")
  (100 . "AcDbEntity")
  (100 . "AcDbPolyline")
  (90 . 56)
  (70 . 1)
  (10 1413.87 1100.07)
  (42 . -1.94714)
  (10 1392.33 1105.01)
  (42 . 0.0)
  (10 1081.39 830.394)
  (42 . 0.0)
  (10 1357.76 1139.79)
  (42 . -1.94714)
  (10 1352.94 1161.35)
  (42 . -1.39512)
  (10 1525.95 1355.04)
  (42 . -1.94714)
  (10 1547.91 1352.67)
  (42 . 0.0)
  (10 1633.72 1448.73)
  (42 . 0.626224)
  (10 1583.93 1569.89)
  (42 . 0.0)
  (10 1305.31 1618.09)
  (42 . 0.0)
  (10 1584.2 1667.9)
  (42 . 0.626224)
  (10 1634.67 1788.78)
  (42 . 0.0)
  (10 1549.41 1885.32)
  (42 . -1.94714)
  (10 1527.43 1883.08)
  (42 . -1.39512)
  (10 1355.51 2077.74)
  (42 . -1.94714)
  (10 1360.45 2099.27)
  (42 . 0.0)
  (10 1085.83 2410.21)
  (42 . 0.0)
  (10 1395.22 2133.85)
  (42 . -1.94714)
  (10 1416.78 2138.67)
  (42 . -1.39512)
  (10 1610.47 1965.66)
  (42 . -1.94714)
  (10 1608.11 1943.69)
  (42 . 0.0)
  (10 1704.17 1857.89)
  (42 . 0.626224)
  (10 1825.33 1907.68)
  (42 . 0.0)
  (10 1870.39 2183.17)
  (42 . 0.0)
  (10 1919.39 1907.55)
  (42 . 0.626224)
  (10 2040.41 1857.42)
  (42 . 0.0)
  (10 2136.71 1942.95)
  (42 . -1.94714)
  (10 2134.41 1964.92)
  (42 . -1.39512)
  (10 2328.58 2137.39)
  (42 . -1.94714)
  (10 2350.13 2132.51)
  (42 . 0.0)
  (10 2660.3 2408.0)
  (42 . 0.0)
  (10 2384.81 2097.83)
  (42 . -1.94714)
  (10 2389.68 2076.29)
  (42 . -1.39512)
  (10 2217.22 1882.11)
  (42 . -1.94714)
  (10 2195.25 1884.42)
  (42 . 0.0)
  (10 2109.71 1788.12)
  (42 . 0.626224)
  (10 2159.84 1667.1)
  (42 . 0.0)
  (10 2435.47 1618.09)
  (42 . 0.0)
  (10 2159.56 1567.47)
  (42 . 0.626224)
  (10 2108.76 1446.73)
  (42 . 0.0)
  (10 2193.75 1349.95)
  (42 . -1.94714)
  (10 2215.73 1352.13)
  (42 . -1.39512)
  (10 2387.1 1156.99)
  (42 . -1.94714)
  (10 2382.1 1135.47)
  (42 . 0.0)
  (10 2655.85 823.763)
  (42 . 0.0)
  (10 2347.23 1100.99)
  (42 . -1.94714)
  (10 2325.66 1096.23)
  (42 . -1.39512)
  (10 2132.46 1269.79)
  (42 . -1.94714)
  (10 2134.88 1291.75)
  (42 . 0.0)
  (10 2039.07 1377.82)
  (42 . 0.626224)
  (10 1917.77 1328.37)
  (42 . 0.0)
  (10 1870.39 1053.01)
  (42 . 0.0)
  (10 1823.7 1328.77)
  (42 . 0.626224)
  (10 1702.82 1379.23)
  (42 . 0.0)
  (10 1606.28 1293.97)
  (42 . -1.94714)
  (10 1608.52 1271.99)
  (42 . -1.39512)
  (210 0.0 0.0 1.0)
  )

и скажи, в какую сторону чего надо уменьшать. Ну так, мне просто интересно...

[nav3000]

Всем доброго времени суток

Собственно просьба у меня к знатокам LISP . Дело в том что я в LISP полный профан.
Но вот сегодня возникла необходимость в одной функции на LISP (на С# для меня это было бы делом 10 минут в самом прямом сысле) Попытался сделать но увы ничего не получилось. Суть в следующем функция должна заполнить список из двух линий и потом в цикле отрисовать эти линии при помощи grdraw. Линии имеют координаты (0,0)(5,5) и (0,0)(0,10)

Понимаю, что на любом языке это не займет больше 10 минут как уже упомянул – для того кто знает. Но отвечу честно – вникать в замысловатый синтаксис LISP просто нет времени. (хотя конечно учиться никогда не поздно) просто функция нужна сейчас. Поэтому зараннее благодарен за помошь тому кто откликнется

[Li6-D]

Как-то так:

Код:

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

((lambda (/ L LN)
   ;Цикл, составляющий список из любого числа линий
   (while  (and (setq L (getpoint "\nУкажите 1-ю точку: "))
                (cdr (setq L (cons L (getpoint L "\nУкажите 2-ю точку: "))))
           )
     (setq LN (cons L LN))
     (print) (print L)
   )
   ;Цикл рисующий красненькие линии из сохраненного списка
   (foreach L LN (grdraw (car L) (cdr L) 1))
   (princ)
))

[Michael!]

то Кулик Алексей aka kpblc
не запустился этот код в vlide - скорее всего я не знаю как это сделать.

[gomer]

функция должна заполнить список из двух линий и потом в цикле отрисовать эти линии при помощи grdraw.

Код:

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

(mapcar
 '(lambda (x)
   (grdraw (car x) (cadr x) 1)
  )
  (list '((0 0) (5  5))
        '((0 0) (0 10))
  )
)

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

Michael!, сорри, запарка...

Код:

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

(entmakex '((0 . "LWPOLYLINE")
  (100 . "AcDbEntity")
  (100 . "AcDbPolyline")
  (90 . 56)
  (70 . 1)
  (10 1413.87 1100.07)
  (42 . -1.94714)
  (10 1392.33 1105.01)
  (42 . 0.0)
  (10 1081.39 830.394)
  (42 . 0.0)
  (10 1357.76 1139.79)
  (42 . -1.94714)
  (10 1352.94 1161.35)
  (42 . -1.39512)
  (10 1525.95 1355.04)
  (42 . -1.94714)
  (10 1547.91 1352.67)
  (42 . 0.0)
  (10 1633.72 1448.73)
  (42 . 0.626224)
  (10 1583.93 1569.89)
  (42 . 0.0)
  (10 1305.31 1618.09)
  (42 . 0.0)
  (10 1584.2 1667.9)
  (42 . 0.626224)
  (10 1634.67 1788.78)
  (42 . 0.0)
  (10 1549.41 1885.32)
  (42 . -1.94714)
  (10 1527.43 1883.08)
  (42 . -1.39512)
  (10 1355.51 2077.74)
  (42 . -1.94714)
  (10 1360.45 2099.27)
  (42 . 0.0)
  (10 1085.83 2410.21)
  (42 . 0.0)
  (10 1395.22 2133.85)
  (42 . -1.94714)
  (10 1416.78 2138.67)
  (42 . -1.39512)
  (10 1610.47 1965.66)
  (42 . -1.94714)
  (10 1608.11 1943.69)
  (42 . 0.0)
  (10 1704.17 1857.89)
  (42 . 0.626224)
  (10 1825.33 1907.68)
  (42 . 0.0)
  (10 1870.39 2183.17)
  (42 . 0.0)
  (10 1919.39 1907.55)
  (42 . 0.626224)
  (10 2040.41 1857.42)
  (42 . 0.0)
  (10 2136.71 1942.95)
  (42 . -1.94714)
  (10 2134.41 1964.92)
  (42 . -1.39512)
  (10 2328.58 2137.39)
  (42 . -1.94714)
  (10 2350.13 2132.51)
  (42 . 0.0)
  (10 2660.3 2408.0)
  (42 . 0.0)
  (10 2384.81 2097.83)
  (42 . -1.94714)
  (10 2389.68 2076.29)
  (42 . -1.39512)
  (10 2217.22 1882.11)
  (42 . -1.94714)
  (10 2195.25 1884.42)
  (42 . 0.0)
  (10 2109.71 1788.12)
  (42 . 0.626224)
  (10 2159.84 1667.1)
  (42 . 0.0)
  (10 2435.47 1618.09)
  (42 . 0.0)
  (10 2159.56 1567.47)
  (42 . 0.626224)
  (10 2108.76 1446.73)
  (42 . 0.0)
  (10 2193.75 1349.95)
  (42 . -1.94714)
  (10 2215.73 1352.13)
  (42 . -1.39512)
  (10 2387.1 1156.99)
  (42 . -1.94714)
  (10 2382.1 1135.47)
  (42 . 0.0)
  (10 2655.85 823.763)
  (42 . 0.0)
  (10 2347.23 1100.99)
  (42 . -1.94714)
  (10 2325.66 1096.23)
  (42 . -1.39512)
  (10 2132.46 1269.79)
  (42 . -1.94714)
  (10 2134.88 1291.75)
  (42 . 0.0)
  (10 2039.07 1377.82)
  (42 . 0.626224)
  (10 1917.77 1328.37)
  (42 . 0.0)
  (10 1870.39 1053.01)
  (42 . 0.0)
  (10 1823.7 1328.77)
  (42 . 0.626224)
  (10 1702.82 1379.23)
  (42 . 0.0)
  (10 1606.28 1293.97)
  (42 . -1.94714)
  (10 1608.52 1271.99)
  (42 . -1.39512)
  (210 0.0 0.0 1.0)
  ))

А так?

[Michael!]

вот в приложенном файле я нарисовал как должно происходить уменьшение.
интересная фигура. показательная

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

Michael!, я не про это на самом деле говорил (кстати, обрати внимание на пост ShagyDoc - к мнению этого человека настоятельно рекомендую прислушиваться, он плохого не посоветует). Встречные вопросы: как вычисляется закон на рисунке выделения magenga-области? А что будет, если в область попадет дуга, которую придется "замыкать"? Встречных вопросов тьма...

[Michael!]

магента область - эта 1/4 или 1/3 (что не существенно важно, от 1/3 до 1/4 - для определенности можно взять 1/3) от всей длины детали. Используемые дуги всегда имеют радиус значительно больший длины детали, поэтому замыкаться они не будут/не смогут. Смещение в магента областях возможно максимум 30 мм. общие размеры деталей - от 300 мм до 2000 мм приблизительно по мин/макс.

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

Сообщение от Michael! от всей длины детали

По периметру? Или по указанному направлению?
Кстати, 157 447 / 374 = 41.3, но никак не 0.(3)
Я все же рекомендую сначала выполнять все вычисления (координат точек, углов и радиусов дуговых сегментов), и только потом строить полилинию. На команде _.stretch я уже в свое время обжегся, повторения не хочу.

[ShaggyDoc]

Команда STRETCH не для программирования! Это очень удобное (иногда незаменимое) средство для интерактивной работы, но не для программиста. Хотя формально, конечно, можно и её использовать.

STRECH изменяет координаты точек (вершин полилиний, точек ставок блоков и т.д.). Программист все эти координаты может вычислить и изменить. Тем более, если надо нарисовать новые объекты. Я приводил пример с трапециями, но даже если

в качесве контура могут быть любые фигуры симметричные-несимметричные, совокупности образованные и дугами и линиями вместе

то это также решается созданием контура по вычисляемым точкам. У меня за 20 лет программирования в LISP не нашлось ни одного случая, в котором нельзя было бы вычислить координаты точек.

[nav3000]

Li6-D

Как-то так: Код: ((lambda (/ L LN) ;Цикл, составляющий список из любого числа линий (while (and (setq L (getpoint "\nУкажите 1-ю точку: ")) (cdr (setq L (cons L (getpoint L "\nУкажите 2-ю точку: ")))) ) (setq LN (cons L LN)) (print) (print L) ) ;Цикл рисующий красненькие линии из сохраненного списка (foreach L LN (grdraw (car L) (cdr L) 1)) (princ) ))

Спасибо за помощь Вот попробовал ваш код переделать в то что мне нужно
(мне не нужно брать точки с экрана)
хотел нарисовать хотя бы одну линию но ничего не вышло

Код:

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

(defun a1(/ L vectors)
	
	(and (setq L (0 0 0)) (cdr (setq (cons (setq L (5 5 0)))))
	(setq vectors (cons L vectors))

	
	
	(foreach L vectors (grdraw (car L) (cdr L) 1))
)

[alex8888]

nav3000, перед (0 0 0) и (5 5 0) надо поставить апострофы: '(0 0 0) и '(5 5 0), тогда в переменной L будет сохранен список, в противном случае твоя прога при выполнении ищет функции 0 и 5, которых, естесственно нет.

[nav3000]

alex8888

перед (0 0 0) и (5 5 0) надо поставить апострофы: '(0 0 0) и '(5 5 0), тогда в переменной L будет сохранен список, в противном случае твоя прога при выполнении ищет функции 0 и 5, которых, естесственно нет.

Поставил и при загрузке файла поклучаю

malformed list on input at [READ] : File <C:/Dokumente und Einstellungen/Kasavchenko/Desktop/1.lsp>

[Do$]

Это азы!

Сообщение от nav3000 malformed list on input

вылезло такое - пересчитывай скобки.

[alex8888]

Скобки одной нет, а еще не понятно: (cdr (setq ???? (cons (setq L '(5 5 0))))), где переменная?

[gomer]

Сообщение от alex8888 File <C:/Dokumente und Einstellungen/Kasavchenko/Desktop/1.lsp>

Сообщение от alex8888 (cdr (setq ???? (cons (setq L '(5 5 0))))), где переменная?

Гы, гы... я молчу

[Li6-D]

Сообщение от nav3000 Поставил и при загрузке файла получаю Цитата: malformed list on input at [READ] : File <C:/Dokumente und Einstellungen/Kasavchenko/Desktop/1.lsp>

nav3000, вот еще вариант:

Код:

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

(foreach L
 '(((0 0 0) (5 5 0))  ;первый отрезок
   ((0 0 0) (0 10 0)) ;второй отрезок
   ;|Здесь список
    отрезков можно
    продолжать
    сколько угодно
    долго|;
  )
  (grdraw (car L) (cadr L) 1)
)

Проще не бывает:

Код:

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

(grvecs
 '(-1   ;|цвет временных отрезков (красный пунктир)
           до следующего переопределения цвета
           в списке отрезков ниже|;
   (0 0 0) (5 5 0)
   (0 0 0) (0 10 0)
   ;.................
) )

Другой вариант с mapcar и lambda в сообщении gomer #1206

[Michael!]

to ShaggyDoc

Сообщение от ShaggyDoc то это также решается созданием контура по вычисляемым точкам. У меня за 20 лет программирования в LISP не нашлось ни одного случая, в котором нельзя было бы вычислить координаты точек.

Ты прав. Но тогда возникает вопрос - как определить эти точки?
Я ведь этого не знаю. Покажите как это сделать - объясните.
команду стретч я взял потому, что я хотел написать программу по своим действиям. А как вычислить координаты точек, и при этом сохранить контур неразрывным после его уменьшения мне абсолютно непонятно.
Или ручками все передвигать как раньше и незаморачиваться с программой.

то Кулик Алексей aka kpblc
по длине детали - это по размеру по оси "Х"

[gomer]

Сообщение от Li6-D вот еще вариант:

В принципе тоже, что и мое, но меня вот посетила мысль, что mapcar более удобна для длинных списков и простых функций, foreach более удобна для "коротких" списков и "глубоких" функций...

[puma]

Не подскажете, каким самым простым способом через lisp можно изменить масштаб динамического блока относительно базовой точки, не трогая (так чтобы не менялись) определенные динамические характеристики? заранее спасибо

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

Michael!, я ж алгоритм показал. ShaggyDoc предоставил пример функции по созданию полилинии.
Все просто: формируется список координат, а потом уже строится новый объект.

Сообщение от Michael! Или ручками все передвигать как раньше и незаморачиваться с программой.

Или изменить мой вариант кода, заменив запрос step на вычисляемое выражение.

Сообщение от gomer но меня вот посетила мысль, что mapcar более удобна для длинных списков и простых функций, foreach более удобна для "коротких" списков и "глубоких" функций...

ИМХО неверно. mapcar возвращает список, foreach - nil. Разница однако.

Сообщение от puma изменить масштаб динамического блока относительно базовой точки, не трогая (так чтобы не менялись) определенные динамические характеристики

Если через ActiveX, то vla-put-scale. А "определенные динамические характеристики" - это какие?

[puma]

например, есть динамический блок разреза, после увеличения он сбивается, что не очень хорошо, чтобы вернуть все назад надо полярному параметру вернуть все обратно. Единственное, что приходит в голову - чтение сначала необходимых значений и после увеличения - снова их установить, просто может есть более простой путь? про vla-put-scale - спасибо, никак не могу в activeX влезть, слишком много там всяких команд

[wetr]

Сообщение от puma например, есть динамический блок разреза, после увеличения он сбивается

актуальная проблема

[Лиспер]

Лично мне лениво пытаться создать блок, его масштабировать, чего-то там еще делать. Может, puma, будет проще приложить 2 файла - один "что получается", второй - "что должно получиться"?

[puma]

мой косяк, что сразу не выложил.

[Лиспер]

По идее должно было сработать, но не срабатывает до конца: атрибуты "пляшут".

Код:

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

(vl-load-com)

(defun c:scale-dyn-blocks (/ conv-vla-to-list doc selset scale pt lst)

  (defun conv-vla-to-list (value / res)
    (cond
      ((listp value)
       (mapcar 'conv-vla-to-list value)
       )
      ((= (type value) 'variant)
       (conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun


  (vla-startundomark
    (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (= (type (setq selset (vl-catch-all-apply
                              (function
                                (lambda ()
                                  (ssget "_:L" '((0 . "INSERT")))
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      (= (type (setq pt
                      (vl-catch-all-apply
                        (function
                          (lambda () (getpoint "\nБазовая точка <Отмена> : "))
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'list
         ) ;_ end of =
      (= (type
           (setq
             scale (vl-catch-all-apply
                     (function
                       (lambda () (getdist pt "\nМасштаб <Отмена> : "))
                       ) ;_ end of function
                     ) ;_ end of vl-catch-all-apply
             ) ;_ end of setq
           ) ;_ end of type
         'real
         ) ;_ end of =
      ) ;_ end of and
     (progn
       (foreach ent
                (mapcar
                  (function vlax-ename->vla-object)
                  ((lambda (/ tab item)
                     (repeat (setq tab  nil
                                   item (sslength selset)
                                   ) ;_ end setq
                       (setq
                         tab (cons (ssname selset (setq item (1- item)))
                                   tab
                                   ) ;_ end of cons
                         ) ;_ end of setq
                       ) ;_ end of repeat
                     ) ;_ end of lambda
                   )
                  ) ;_ end of mapcar
         (setq
           lst (mapcar
                 (function
                   (lambda (x)
                     (cons (vla-get-propertyname x) (vla-get-value x))
                     ) ;_ end of LAMBDA
                   ) ;_ end of function
                 (conv-vla-to-list
                   (vla-getdynamicblockproperties ent)
                   ) ;_ end of conv-vla-to-list
                 ) ;_ end of mapcar
           ) ;_ end of setq
         (vla-scaleentity ent (vlax-3d-point pt) scale)
         (foreach prop (conv-vla-to-list
                         (vla-getdynamicblockproperties ent)
                         ) ;_ end of conv-vla-to-list
           (vl-catch-all-apply
             (function
               (lambda ()
                 (vla-put-value
                   prop
                   (cdr (assoc (vla-get-propertyname prop) lst))
                   ) ;_ end of vla-put-value
                 ) ;_ end of lambda
               ) ;_ end of function
             ) ;_ end of vl-catch-all-apply
           ) ;_ end of foreach
         ) ;_ end of foreach
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark doc)
  (princ)
  ) ;_ end of defun

[Frigate]

Подскажите, пожалуйста - может у кого была похожая проблема:

в блоке есть атрибут. После вставки программно меняю этому атрибуту выравнивание с "По ширине" на "по центру", и степень растяжения соответственно тоже меняю. И дома и на работе стоит русифицированный АКАД 2009. Если такой модифицированный блок копирую, то при вставке у аргумента выравнивание восстанавливается ("по ширине"), т.е. текст и местоположение атриблута сползают. В АКАДе дома такого не происходит. В чем может быть причина?

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

Во-первых, меня пугает слово "русифицированный". Во-вторых, читалось ли http://autolisp.ru/2010/04/06/text-and-attrib-entities/ ? В-третьих, как выполняется копирование?

[superkot007]

Нужна помощь...
Есть чертеж, в котором куча блоков. Блоки выполнены в "неправильных" слоях (при вставке такого блока он не будет изменяться, даже если вставлен в другой слой с другим цветом). Это очень затрудняет проверку чертежа на регламентируемые слои... А если чертежей не один и не два, то вообще труба...

Так вот, как перевести выбранные на чертеже блоки в слой "0" со всеми настройками "по слою"???

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

http://forum.dwg.ru/showthread.php?t=21492

[superkot007]

Сообщение от Кулик Алексей aka kpblc http://forum.dwg.ru/showthread.php?t=21492

Почти то, что нужно... А можно попросить "подправить" код, чтобы был выбор корректируемых блоков (лучше всего - мышкой)? Просто не все блоки в чертеже требуют такого радикального подхода...

Еще просьба... Есть lisp для вставки блоков

Код:

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

(defun block-insert (/ p p1 p4 p5 x1 x2 x3 y3 y4)
  ;ВСТАВКА БЛОКА ДЛИНОЙ 5мм
  (setq p2 (getpoint "\n \n \nВведите центр блока:"))
  (setq p1 (osnap p2 "_nea"))  
  (initget 1 "1 2")
  (setq w (getkword "\n \n \nНаправление отрезка 1 <ГОРИЗ>, 2 <ВЕРТ>:"))
  (if (= w "2")
   (progn
      (setq y3 (- (cadr p1) 2.5))
      (setq p4 (list (car p1) y3))
      (setq y4 (+ (cadr p1) 2.5))
      (setq p5 (list (car p1) y4))
      (command "_break" p4 p5)
      (command "_insert" b p1 "" "" "90")))
  (if (= w "1")
   (progn
      (setq x2 (+ (car p1) 2.5))
      (setq p4 (list x2 (cadr p1)))
      (setq x3 (- (car p1) 2.5))
      (setq p5 (list x3 (cadr p1)))
      (command "_break" p4 p5)
      (command "_insert" b p1 "" "" "")))
)

Как сделать его "проще" по алгоритму:
1. Выбор примитива (так понимаю - функция entsel?)
2. Если примитив является отрезком - точка выбора становится точкой вставки блока (по привязке). Если нет - сообщение о неправильном выборе
3. Если отрезок горизонтальный (координаты Y одинаковые) - вставка без поворота, если вертикальный (координаты X одинаковые) - поворот на 90 градусов.

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

Код:

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

(vl-load-com)

(defun insert-block-by-point (block-name / adoc ent pt)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (tblobjname "block" block-name)
           (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (entsel "\nУкажите отрезок <Отмена> : ")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           (setq pt (vlax-curve-getclosestpointto (vlax-ename->vla-object (car ent)) (cadr ent)))
           (= (cdr (assoc 0 (entget (setq ent (car ent))))) "LINE")
           ) ;_ end of and
    (vla-insertblock (vla-objectidtoobject adoc (vla-get-ownerid (vlax-ename->vla-object ent)))
                     (vlax-3d-point pt)
                     block-name
                     1
                     1
                     1
                     (cond
                       ((equal (cadr (assoc 10 (entget ent)))
                               (cadr (assoc 11 (entget ent)))
                               1e-6
                               ) ;_ end of equal
                        (/ pi 2.)
                        )
                       ((equal (caddr (assoc 10 (entget ent)))
                               (caddr (assoc 11 (entget ent)))
                               1e-6
                               ) ;_ end of equal
                        0.
                        )
                       (t (angle (cdr (assoc 10 (entget ent))) (cdr (assoc 11 (entget ent)))))
                       ) ;_ end of cond
                     ) ;_ end of vla-InsertBlock
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[Frigate]

Кулик Алексей aka kpblc,

1. просто русский Автокад 2009.
2. да, Алексей, это я читал. Именно вычислением я и менял координты точки вставки.
3. КОпирование при помощи обычных Ctrl+C Ctrl+V. На домашнем компе при копировании блоков с измененным выравниванием атрибута все копируется как надо. Т.е. вырвнивание копированной вставки блока не становится изначальным для блока (по ширине). На рабочем компе выравнивание меняется на "по ширине". Но если копировать при помощи команды "кп", то все копируется нормально, без изменений.
Завтра еще раз поэкспериментирую на своем рабочем омпе и на других компах.

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

Offtop: Frigate, ну ты хоть указывай примерную область поиска вопроса
Update на 2009 установлен? Если да, то на оба компа или как?

[Frigate]

Кулик Алексей aka kpblc,

кажется нет особого глюка. Такой глюк проявился только в одном файле, в других не проявляется - никаким путем не смог этого добиться в других файлах. Завтра скину сам файл, может ты, Алексей, и сможешь выяснить, что там не так.

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

В таком случае я начинаю подозревать, что либо в блоке есть атрибуты с одинаковыми тэгами, либо определения блоков разнятся. Либо автоматом после вставки выполняется команда _.attsync (или ее аналог)

[superkot007]

Большая просьба - подправить lisp из архива:
- вместо слайдов - файлы dwg
- вставить в чертеж выбираемый элемент...

Да, и что-то я не понял, как его вообще запустить в AutoCAD...

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

А чем не устраивает DesignCenter / _.insert / _.xref ?

[superkot007]

- DC - не практикуется у нас (удобно, но для многих проблемно, я же не только себе хочу...)
- Просто "_.insert" - нет наглядности (по названию блока можно и не понять, что вставляется)...
- через Инструментальные палитры - мелкие изображения; с мозаичным меню тоже мелко...

А тут случайно в книге Полещука наткнулся... Можно что-нибудь "сваять"?

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

Вообще-то в окне _.insert можно и предварительный просмотр получить. И там же, нажимая кнопку Обзор, увидеть (в зависимости от настроек проводника) сохраненный вид чертежа.
Палитры инструментов (точнее, размер значков) настраиваются примерно за 3..5 секунд.

[superkot007]

Сообщение от Кулик Алексей aka kpblc Вообще-то в окне _.insert можно и предварительный просмотр получить. И там же, нажимая кнопку Обзор, увидеть (в зависимости от настроек проводника) сохраненный вид чертежа.

Согласись, что если блоков несколько десятков и раскиданы они в разных папках, простое "Вставка - блок" (ну или _insert) не очень ускоряет процесс создания схем. Это самый последний вариант

Сообщение от Кулик Алексей aka kpblc Палитры инструментов (точнее, размер значков) настраиваются примерно за 3..5 секунд.

Ну "Параметры отображения" все равно имеют предел , которого может и не хватить для определения, "то вставлять, или другое"...

Ну так что, моя просьба найдет понимание?

Offtop: А то, по-моему оффтопить начинаем... Многим это на мыло идет,...

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

superkot007, лично я ни разу не сталкивался с тем, чтобы программно делать sld из стороннего файла. Из текущего еще как-то можно попробовать, но это решение - на полраза (ИМХО).

Сообщение от superkot007 если блоков несколько десятков и раскиданы они в разных папках

Значит их надо объединять. Или в одну папку, или в один dwg-файл. И вставлять уже блоками оттуда. И потом, схемы схемами, а название и пояснение к ним никто не мешает сделать информативными...

[ShaggyDoc]

Ну так что, моя просьба найдет понимание?

Просьба по облегчению вставки блоков (да и вообще рисования чего угодно) из меню с иллюстрациями и дополнительными описаниями давно нашла понимание (см. прилагаемый рисунок).

Здесь нет никаких слайдов, иллюстрации делаются на лету, прямо с экрана.

Код же, который просишь "подправить" всего лишь учебный пример. Как делать диалог с отображением слайдов.

Сами слайды и библиотеки слайдов давно устарели. Когда ничего не было иного - возились с ними. А теперь-то зачем? Не облегчат и не ускорят они работу по сравнению со штатными средствами.

Если же надо лучше, чем через Design Center - см. рисунок. Как сделать - описано в книге "САПР на базе AutoCAD - как это делается".

[superkot007]

Сообщение от Кулик Алексей aka kpblc superkot007, лично я ни разу не сталкивался с тем, чтобы программно делать sld из стороннего файла. Из текущего еще как-то можно попробовать, но это решение - на полраза (ИМХО).

Я, наверное, неправильно сформулировал... Мне слайды не нужны (архив - полный пример из книги, не более), хотел бы, чтобы таким же образом можно было выбрать нужный dwg-файл и вставить в схему...
Пожалуйста...

[Frigate]

Сообщение от Кулик Алексей aka kpblc В таком случае я начинаю подозревать, что либо в блоке есть атрибуты с одинаковыми тэгами, либо определения блоков разнятся. Либо автоматом после вставки выполняется команда _.attsync (или ее аналог)

Алексей, в продолжение темы (опять выплыл глючные блок):

Изначально в одном чертеже получился отчего-то такой глючный блок, который при копировании (Copy Paste) возвращает атрибуту выравнивание, установленное в самом определении блока.
Если вставлять блок через панель инструментов (не через копирование) - то все нормально, можно самому менять выравнивание и степень растяжения атрибута.
Вроде в других файлах этот же блок нормально работает. Но все-таки хочется докопаться до истины - что не так с этим блоком.

Может ты сможешь разобраться?


Прикрепляю файл, где есть такой глючный блок и нормальный блок. Они абсолютно идентичны (в описании). В чем дело - так и не понимаю.

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

Во-первых: что в файле делают следы ПО от CSoft?
Во-вторых: AutoCAD 2011 Eng 64 bit, AutoCAD 2011 Rus 64 bit - ситуацию после

Код:

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

Command: _-purge
Enter type of unused objects to purge 
[Blocks/Dimstyles/LAyers/LTypes/MAterials/MUltileaderstyles/Plotstyles/SHapes/textSTyles/Mlinestyles/Tablestyles/Visualstyles/Regapps/Zero-length geometry/Empty text objects/All]: _a
Enter name(s) to purge <*>:
Verify each name to be purged? [Yes/No] <Y>: _n
Command: _-purge
Enter type of unused objects to purge 
[Blocks/Dimstyles/LAyers/LTypes/MAterials/MUltileaderstyles/Plotstyles/SHapes/textSTyles/Mlinestyles/Tablestyles/Visualstyles/Regapps/Zero-length geometry/Empty text objects/All]: _r
Enter name(s) to purge <*>:
Verify each name to be purged? [Yes/No] <Y>: _n
Command: _audit
Fix any errors detected? [Yes/No] <N>: _y

повторить не удалось. Блок нормально копируется через буфер обмена.
У тебя в самом определении блока (насколько я понял) уже установлено для атрибута выравнивание Fit, так что еще вопрос - какое вхождение корректно Вот копирование блока со значением атрибута "1" как раз и вызывает восстановление исходного состояния выравнивания атрибута...
ИМХО - можно заносить в список багов

[Frigate]

Кулик Алексей aka kpblc,

1. Не знаю, брал чистый чертеж, просто копируя туда глючный и нормальный блок. Хотя на компе утсановлена СПДС Графикс.
2. У меня после этого PURGE на АКАД 2009 РУС ничего не устраняется. Ну ты это и так понял.
3. А вхождения должны быть такими, какими я их устанавливаю при размещении (insert). Если в номере кабеля больше 7 символов - то "по ширине" остается. Если меньше 7 символов, то программно выравнивание ставится "по центру" + сдвигаю точку вставки.
Но заметь, Алексей, что неглючный блок всегда копирует правильно - в т.ч. и через буфер обмена.
Так что скорее всего это глюк автокада. Только жаль, что я не могу уже повторить этот баг - т.е. сделать глючный блок из нормального, для локализации проблемы.
Итог - использовать автокад 2011

Кстати, 2011 в каком формате сохраняет чертежжи по умолчанию?
В 2007м или уже в другом?

[alex8888]

Кстати, 2011 в каком формате сохраняет чертежжи по умолчанию? В 2007м или уже в другом?

в 2010-м (AC1024), у 2007-го был AC1021

[Frigate]

Здравствуйте, уважаемые Гуру форума.

Опять у меня траблы с таблицами, созданными программным методом.

Итак:

написал прогу, которая у указываемой таблицы проставляет все границы ячеек 0.4 мм.
Работает прога вполне нормально, но такая проблема:

если после работы проги (делает толстыми все границы таблицы) сделать стандартное Undo (нажать кнопку на панели инструментов), то при повторной попытке сделать все границы той же таблицы толстыми - акад вешается. Уже на 3 секунды работает моя прога, а минуты 2-3.

Прошу помочь советом. Или это баг Автокада?

[VVA]

Сообщение от Frigate Прошу помочь советом.

Помогаю: RegenerateTableSuppressed
Читать здесь, начиная с 4 поста или здесь При запуске Lisp идет утечка памяти

[Frigate]

Здравствуйте!

Прошу объяснить непонятную ситуацию:

у меня прога видит локульную переменную своей внутренней функции.

Вернее, не сама прога, а функция обработки ошибок *error*

Значит, обработчику ошибок доступны локальные переменные внутренних функций програмы???

ПРикольно - только что попробовал еще с одной переменной - просто локальной переменной внутренней функции присвоил некое значение. А в обработчике ошибок в самой программе написал PRINC эту локальную переменную внутренней функции - и ВЫВОДИТ ))) Во чудеса-то. Или так и должно быть?

Хочу уточнить, что сама программа НЕ ВИДИТ локальной переменной внутренней функции, т.е. я задал все верно. А вот обработчику ошибок доступно все... даааа... наводит на интересные мысли )))

[TararykovDG]

Frigate, ничего необычного. В обработчике ошибок *error* будут видны только те локальные переменные которые были определены в той функции из которой был вызван обработчик ошибок *error*
Пример

Код:

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

(defun loc_1( / a)
  (setq a 1)
  (getpoint "\n1-я точка: ")
  )

(defun loc_2( / b)
  (setq b 2)
  (getpoint "\n2-я точка: ")
  )

(defun *error*(msg / )
  (princ a)
  (princ b)
  )

(defun glob()
  (loc_1)
  (loc_2)
  )

Если нажать Esc на запрос "1-я точка: " т. е. вызвать ошибку во время выполнения функции loc_1, то в *error* a = 1, b = nil, если нажать Esc на запрос "2-я точка: ", то в *error* a = nil, b = 2

[Frigate]

TararykovDG,

спасибо, действительно, все очень логично получается. Только теперь придется в обработчике ошибок учитывать и эту особенность

[VVA]

Frigate, Еще логичнее делать ф-цию *error* локальной. Тогда ей будут доступны все переменные функции верхнего уровня и не переопределяется стандартная ф-ция *error*. В этом примере ф-ция *error* объявлена локальной по отношению к ф-ции C:R2E и ей доступна переменная Doc без дополнительного объявления.
Вот примерный шаблон программы

[Frigate]

VVA,

я именно так и делал, вроде бы... Взял код-шаблон у Алексея (КРЫС):

Код:

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

(defun C:
	(
	/
	*error*	
	adoc
	)
(vl-load-com)

(vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))

(defun *error* (msg)
(vla-endundomark adoc)
(princ "Описание произошедшей ошибки: ")
(princ msg)
(princ)
)



(vla-endundomark adoc)

(PRINC)

);_end C:

Еще хотел поблагодарить тебя за классные ссылки на сайт Мак Ли - как раз понадобился для программного изменения динсвойств блоков.

[Лиспер]

Frigate, а имя команды-то где?

Код:

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

(vl-load-com)

(defun c:cmd-name (/ *error* adoc)

  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ "Описание произошедшей ошибки: ")
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  ;; Что-то делать
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[ShaggyDoc]

А ещё лучше программировать так, чтобы до *error* вообще дело не доходило. Эта функция срабатывает, когда "поздно пить боржоми". Обычно, если пользователь ESC нажал. В *error* можно только попытаться что-то исправить, обычно востановить какую-то обстановку (системные переменные). Когда-то это было единственное средство.

Но давно уже есть ловушки ошибок - функции vl-catch-all-apply, vl-catch-all-error-p, vl-catch-all-error-message. Они предотвращают саму возможность ошибок пользователя, чтобы при нажатии ESC программа не прерывалась. На мой взгляд это самое полезное нововведение в LISP после AutoCAD-14.

В очередной раз привожу высокоуровневую функцию обработки ошибок. Она упрощает использование "святой троицы".

Пример использования в комментарии:

Код:

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

(defun ru-error-catch
       (protected_expression on_error_expression / catch_error_result)
;|
Пример вызова
(ru-error-catch
    (function (lambda ()
                ;;; защищаемое выражение  
                (
                
                )
                ;;; То что вернет - будет результатом
              ) ;_ end of lambda
    ) ;_ end of function
    (function
      (lambda (err_msg)
        ;; если надо - выводим сообщение. err_msg подставит Автокад
        (princ (strcat "\nОШИБКА такой-то функции: " err_msg))
        ;; возвращаем NIL при ошибке
        nil
      ) ;_ end of lambda
    ) ;_ end of function
  )

|;
  
  (setq catch_error_result
         (vl-catch-all-apply protected_expression)
  ) ;_ end of setq
  (if (and (vl-catch-all-error-p catch_error_result)
           on_error_expression
      ) ;_ end of and
    (apply on_error_expression
           (list (vl-catch-all-error-message catch_error_result))
    ) ;_ end of apply
    catch_error_result
  ) ;_ end of if
) ;_ end of defun

Такой функцией надо оборачивать места возможных ошибок - и пользовательский ввод, и расчетную часть. Даже деление на ноль можно перехватить.

[Frigate]

Лиспер,

имя шаблону-то зачем? )))

Да, может твой код и логичнее, но по-сути он ничего не меняет.

Кстати, а как же определение adoc уже после определения функции *error*? Какой тогда смысл так переставлять определение обработчика ошибок?

В любом случае, при таком раскладе никакие системные переменные не изменяются, ничего еще не нарисовано, так что не фатально.

ShaggyDoc,

да, я так и стараюсь везде делать - чтобы выполнение функции или программы могло быть прервано только при ошибке, когда пользователь нажал ESC.
С ситуацией возможного деления на ноль - иногда может быть полезна обертка из vl-catch. Уже столкнулся с такой ситуацией в своих прогах, что при определенных обстоятельствах при длинных вычислениях происходило деление на ноль. Но возникшая ошибка помогла мне исправить код - просто убрать возможность появления нуля:

Код:

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

(if (= col_n 0)
(setq col 1)
)

А поводу ESC все-таки спорно - ведь из диалоговых окон, например, при отмене внесенных изменений удобно нажать ESC (если есть клавиша типа "Отменить"). Также, не во всех программах обоснован запрет нажатия ESC. Хотя на эту тему немало копий сломано на форумах, и у всех свое мнение.

Например, при необходимости указания точки пользователем (точка вставки таблицы, к примеру), пользователь отказывается от продолжения, тупо нажав ESC (даже если есть штатный вариант выхода из проги при помощи if). Что в таком случае нужно посылать в программу? Какую точку? ПО -моему, никакой не нужно, а нужно корректно убрать все внесенные изменения. Но ведь это же самое можно сделать и при помощи *error*. Может я что-то недопонимаю тут? Тогда был бы рад объяснению от мастеров ЛИСПа :-)

[Лиспер]

Frigate, просто я предпочитаю сначала объявлять локальные функции, а потом уже основной код. Если код достаточно длинный и функций много, можно легко запутаться.

Сообщение от Frigate Например, при необходимости указания точки пользователем (точка вставки таблицы, к примеру), пользователь отказывается от продолжения, тупо нажав ESC (даже если есть штатный вариант выхода из проги при помощи if). Что в таком случае нужно посылать в программу?

Ничего не нужно посылать. Выполняется отмена выполненных действий - и все.

[ShaggyDoc]

А поводу ESC все-таки спорно - ведь из диалоговых окон, например, при отмене внесенных изменений удобно нажать ESC (если есть клавиша типа "Отменить"). Также, не во всех программах обоснован запрет нажатия ESC. Хотя на эту тему немало копий сломано на форумах, и у всех свое мнение.

Нажатие ESC в приличных диалоговых окнах не разрушает всю программу. Происходит выход из какого-то куска, например диалога.

ESC не предназначена для отмены каких-то ранее выполненных действий! Для этого должна быть или специальная кнопка (опция), или надо, в стиле штатных команд, давать возможность использовать UNDO/REDO. Вот тут программист и должен позаботиться об расстановке меток для отката.

Например, при необходимости указания точки пользователем (точка вставки таблицы, к примеру), пользователь отказывается от продолжения, тупо нажав ESC (даже если есть штатный вариант выхода из проги при помощи if). Что в таком случае нужно посылать в программу? Какую точку?

В момент указания точки пользователь имеет право отказаться от ввода самой точки, в том числе по ESC. Но это не должно разрушать всю программу. Кусок кода, защищенный ловушкой, просто вернет NIL, но управление останется у программы.

Современные программы работают не последовательно, а "параллельно". Программа, в стиле AutoCAD, имеет всякие опции. Одной из опций может быть "действие по умолчанию", т.е. нажатие Enter (пустой ввод). Таким действием может быть и выход. Может быть и ESC, но не в момент ввода, а в момент ожидания чего-то.

Т.е. само нажатие ESC не надо запрещать, а разрушение программы предотвращать надо. Примерно как для выключения компьютера надо закрывать Windows, а не выдергивать шнур из розетки.

[Frigate]

Лиспер,

так и я о том же - что *error* в таких ситуациях, как я описал, ничем особо не хуже, чем эти три новые функции. Едингственное, чем новые функции лучше (хорошо подумав) - в случае с vl-catch можно заранее понять, какие действия отменять, а в случае с *error* - нужно сначала проверять, стоит ли отменять энное действие. Напр., нужно проверить, имеется ли полилиния, которая создается в процессе выполнения программы. Если имеется - удаляем.
В общем в этом есть определенное преимущество функций vl-catch. Может именно поэтом их так любят спецы ЛИСПа?

ShaggyDoc,

сказано более чекм убедительно. Думаю, одну из следующих программ попробую написать с применением vl-catch.

Еще одна причина моего "недорастания" до этих новомодных функций - использовал функцию Алексея (КРЫС), переделал немного под себя, но vl-catch оставил. В нескольких местах накосячил с кодом. Но где - не смог понять, пока не убрал все vl-catch. Т.е. возможно vl-catch и можно использовать, но обязательно с возможностью вывода сообщения о том, какая ошибка произошла. Собственно, пример Вы дали на предыдущей странице. Буду разбираться

[Iogan]

Уважаемые!!!, добрый день.
Нужна помощь, запарился ужо...
Задача.. Запускаю ABC.lsp , открывается вторая сессия acad, выполняется произвольная ф-я, сессия закрывается.
1. Как программно сделать активным окно второй сессии acad.
2. Как запустить мою функцию во второй сессии
3. Как из .lsp выделить все объекты на чертеже
(vla-activate docdwg); до этой ф-ии все отлично работает, вторая сессия открыта
(vla-sendcommand docdwg (defun cod (cd obj))...) ; эта ф-я не хочет выполнять мою ф-ю, просто игнорирует, что-то делаю не так..
Надеюсь на вашу помощь. Заранее благодарен

[Лиспер]

Iogan, lisp может выполняться только в активном документе, из которого он и был запущен. При смене фокуса (то есть смене активного документа) выполнения лиспа приостанавливается до возврата в исходный файл.

[Iogan]

Лиспер, спасибо за быстрый ответ
Собственно дело в следующем
во второй сессии выполняются простейшии ф-ии (вставка текста "strcat", нарисовать что нибудь и т.д.) но вот выполнять мою ф-ю написанную ранее и прекрасно работающую (подсчет количества блоков и их автоматическую нумерацию) не желает. Я хочу следующее - из командного файла (первой сессии) выполнить операции над блоками в других файлах .dwg и получить конечный результат в основном документе.
Вот такая закавыка...

[gomer]

Сообщение от Frigate А поводу ESC все-таки спорно - ведь из диалоговых окон, например, при отмене внесенных изменений удобно нажать ESC (если есть клавиша типа "Отменить"). Также, не во всех программах обоснован запрет нажатия ESC. Хотя на эту тему немало копий сломано на форумах, и у всех свое мнение. Например, при необходимости указания точки пользователем (точка вставки таблицы, к примеру), пользователь отказывается от продолжения, тупо нажав ESC (даже если есть штатный вариант выхода из проги при помощи if). Что в таком случае нужно посылать в программу? Какую точку? ПО -моему, никакой не нужно, а нужно корректно убрать все внесенные изменения. Но ведь это же самое можно сделать и при помощи *error*. Может я что-то недопонимаю тут? Тогда был бы рад объяснению от мастеров ЛИСПа :-)

В диалогах есть свой обработчик start_dialog
при вводе точки тоже можно пользоваться безопасными фунциями - это фунции, возвращающие nil по ошибке (esc)
Например:

Код:

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

(defun safe-getpoint ()
;;; Ваш код
)
(defun safe-draw (bp)
;;; Ваш код
)

(defun c:cmd ( / pt)
  (and (setq pt (safe-getpoint))
                     (safe-draw pt)
  )
)

Этот пример практичен в простых задачах типа "ткнул-отрисовал"

[Frigate]

gomer,

я диалоговые окна привел просто как пример - считаю, если возможно, надор пользователю обеспечить возможностьвыхода из программы при вводе данных не только "штатным вызходом проги", но и по ESC. Код где-то на caduser видел.

У меня сейчас еще один вопрос стоит:

как через объектную модель можно обновить поля в блоке? (если вообще это реально)

см. тему http://forum.dwg.ru/showthread.php?p=604338#post604338

Просто Если делать обновление полей блока командными методами через sendcommand, то по завершении работы callback-функции исчезает выделение самого блока. А нужно, чтобы оно не исчезало. Вернуть выделение через setfirst тоже не удалось...
Прошу помочИ


2 Алексей (КРЫС) и всем

кажется я выявил глюк блоков в автокаде.

Сейчас я понял, как они создаются :-)

Это касается ЛЮБЫХ динамическийх блоков с атрибутами!

Итак:

имеем динблок с атрибутом.
Заходим в свойства атрибута (_eattedit) и меняем степень растяжения текста.
После этого пошевелим любое из динсвойств блока (видимость, выбор, линейное растяжение - у меня при любом варианте глюк возникает).
Далее копируем блок и вставляе (Ctrl+C / Ctrl+V). Степень растяжения вернулась к исходной для блока.

Затем копируем этот блок.

Да, через _copy или кп все копируется без глюка.

Причем ТО ЖЕ САМОЕ происходит с любыми свойствами блока, кроме динамических - те то хорошо копируются )))

Шрифт например может так же слететь, толщина...

Вывод - копировать через _copy (НЕ через буфер). А лучше всего вставлять блок только программно, с уже внесенными изменениями в свойства атрибутов типа текстового стиля, толщины линий блока и тп

[gomer]

Сообщение от Frigate Прошу помочИ

помолчу...

[Frigate]

gomer,

"ПомоЧи" - это "помощи", а не "помолчи"

Молчать то, как раз, не нужно. Особенно если есть что сказать по существу

[Frigate]

Cтолкнулся с проблемой - часть будущих пользователей работает в однодокументном режиме автокада (SDI равна "1"). А у меня обмен между документами сделан через "внедокументные переменные". Но эти переменные видны только в одном приложении автокада. Есть ли какая возможность обмениваться информацией между такими вот отдельно запущеннымы файлами автокада (каждый в своем приложении)?

[Лиспер]

Используй реестр или файлы (ini / txt / cfg - как запишешь, так и прочитаешь).

[Frigate]

Лиспер,

значит другого пути нет.

Ладно, пока сделаю примечание в справке, в каком режиме надо работать с моими командами (вернее, всего лишь с двумя пока, которые отвечают за запись и чтение внедокументной переменной).

А потом уже буду создавать временный файлик.

[Лиспер]

А проще работать с реестром И наверняка быстрее

[Woron]

Сообщение от Кулик Алексей aka kpblc Red Nova, лично я начинал с командных методов.

Где можно взять описание этих самых команд?
Пролистал несколько книг по лиспу (по оглавлениям прошелся) во всех подразумевается, что я эти команды уже знаю.
_line _arc _circle я еще понял как делать, а вот на _spline застрял.
И размеры как описывать не совсем понятно. (у меня сейчас 2007 AutoCAD стоит).

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

В.Свет, "Язык макрокоманд и создание кнопок". Есть в местном Download,

[Woron]

Читать начал но это не то что мне нужно.
Я лучше напишу, что сделать пытаюсь, а то похоже я вопрос не правильно задаю.
Сделал я программку (в VB) я в нее закидываю координаты XY, а она создает .lsp файл в котором такой текст

;(load "D:/acad.lsp") (command "_line" "0,0" "0,0" _enter) (command "_line" "0,0" ".5828264,0" _enter) (command "_line" "0,.2205667" ".6861063,.2205667" _enter) (command "_line" "0,.4399042" ".8006551,.4399042" _enter) (command "_line" "0,.6578436" ".9258681,.6578436" _enter) (command "_line" "0,.8742085" "1.061283,.8742085" _enter) (command "_line" "0,1.08882" "1.206534,1.08882" _enter) (command "_line" "0,1.301498" "1.361324,1.301498" _enter) (command "_line" "0,1.51206" "1.5254,1.51206" _enter) (command "_line" "0,1.720324" "1.698548,1.720324" _enter) (command "_spline" ".5828264,0" ".6861063,.2205667" ".8006551,.4399042" ".9258681,.6578436" "1.061283,.8742085" "1.206534,1.08882" "1.361324,1.301498" "1.5254,1.51206" "1.698548,1.720324" _enter "@0,0" "@0,0")

Вот со сплайном проблема. Как его правильно вызывать нигде не написано. Точки он нормально берет, но вот как ему показать, что точки кончились и последние координаты это косательные к нач. и конеч. точкам?

И еще вопрос. В одной из книг было написано, что при появлении в AutoCADе новых команд, старые сохраняют. И в той же книге была описана команда _dimradial. Вот только AutoCAD говорит, что такой команды не знает. Может у меня отключено что-то?

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

1. Не обрабатываются привязки
2. Что в команде делает неинициализированная переменная _enter? Нажатие Enter эмулируется двойными кавычками.
3. Кто-то мешает использовать нормальную объектную модель? И методы типа AddLine, AddSpline?

[Woron]

1. Где?
2. В листинге программы видел.
3. Вот это я уже совсем не понял. Методы Add вроде с command не вызываются?

Заменил _enter на "" сплайн построился. Спасибо!

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

А разве кто-то заставляет использовать именно command? Если написано внешнее приложение, то можно сделать наподобие:

Код:

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

Dim AcadApp As Object
Dim ActiveDoc As Object
Dim ptStart(2) As Double, ptEnd(2) As Double
Dim ptSpline() As Double

Set AcadApp = GetObject(, "AutoCAD.Application")
Set ActiveDoc = AcadApp.ActiveDocument

With ActiveDoc.ModelSpace
  ptStart(0) = 0#: ptStart(1) = 0#: ptStart(2) = 0#
  ptEnd(0) = 0#:   ptEnd(1) = 0.5828264: ptEnd(2) = 0#
  .AddLine ptStart, ptEnd
End With

Ну и тому подобное
P.S. Код пишу без проверки и "насухую".

[Woron]

Такое я пока еще не умею, только начал разбираться.
Скопирую для примера

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

Прежде чем копировать, советую все же определиться: пишется внешнее приложение, обращающееся к AutoCAD как к СОМ-серверу? Или что-то внутреннее?
И обязательно, обязательно! проверить работу кода.

[Woron]

Внешнее. Я еще книгу почитаю, когда время будет.
А пока мне соманда хватит. (обезьянью работу не делать).
Спасибо за помощь.
(З.Ы. Я не конструктор, мне акад для "узкоспециализированных" операций нужен )

[ashas-]

Здраствуйте, уважаемые форумчане !

Пытаюсь освоить лисп и возник такой вот вопрос...
Вопрос: можно ли последнюю точку сплайна соединить с ближайшей точкой заданной окружности, или перпендикулярно ей?

Заранее Благодарю!

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

Можно, почему нет...

[ashas-]

Буду очень признателен если подскажете как . Ну или хотя бы с помощью каких команд это можно воплотить в жизнь...

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

"Последнюю" - имеется в виду последнюю по построению? Тогда так:

Код:

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

 (vl-load-com)

(defun c:test (/ adoc circle spline end)
  (if (and (= (type (setq spline (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (car (entsel "\nУкажите сплайн <Отмена> : "))
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (= (cdr (assoc 0 (entget spline))) "SPLINE")
           (= (type (setq circle (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (car (entsel "\nУкажите окружность <Отмена> : "))
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (= (cdr (assoc 0 (entget circle))) "CIRCLE")
           ) ;_ end of and
    (progn
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (vla-addline (vla-objectidtoobject
                     adoc
                     (vla-get-ownerid (setq spline (vlax-ename->vla-object spline)))
                     ) ;_ end of vla-ObjectIDToObject
                   (vlax-3d-point (setq end (vlax-curve-getendpoint spline)))
                   (vlax-3d-point (vlax-curve-getclosestpointto (vlax-ename->vla-object circle) end))
                   ) ;_ end of vla-AddLine
      (vla-endundomark adoc)
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

[ashas-]

Видимо я не совсем корректно задал вопрос. (

Мне нужно что бы при рисовании сплайна, последняя его точка, в моем случае это 4-ая (именно точка сплайна) соединялась с заданной окружностью. Которую до этого мы закрепили за букву.

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

Ничего не понял. Ну используй привязки, в чем трудность?

[ashas-]

С привязкой нужно в ручную доводить точку до окружности, хочется что бы это сделал за меня лисп ).

Я хочу сделать, свою мультивыноску. Стандартная меня не устраивает... У нее сплайн либо слева, либо снизу, либо сверху, либо справа и другого не дано. Смотрится по колхозному...

Была идея довести сплайн до центра окружности, а потом нужную часть обрезать... Но так и не смог придумать как это сделать, что бы не приходилось выбирать нужный конец сплайна.

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

А просто свой вариант стиля почему не настроить?

[ashas-]

Не знаю , раньше я не замечал настройки которая решает эту проблему )! Спасибо!

[ashas-]

Возникла такая проблема, нужно что бы после нажатия ESC программа все равно закончила ее до конца.

Помогите пожалуйста кто может... И вообще это возможно?

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

Какая программа? И потом, в этой теме как бы обучают лиспу. Помогают решить проблему в разделе "Программирование"...

[gomer]

Сообщение от Кулик Алексей aka kpblc нужно что бы после нажатия ESC программа все равно закончила ее до конца.

А в чем тогда смысл эскейпа?

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

gomer, я этого не говорил.

[ashas-]

Прошу прощения, если разместил свой вопрос не в том разделе. Я вроде как тоже пытаюсь научиться поэтому решил, что здесь самое место. Программа все та же ), мультивыноска... Все таки стандартная мне все равно не устраивает ))). Я зациклил с помощью While, что бы постоянно ставилась мультивыноска, и когда все проставил, нужно что бы привязка и орто вкл. (до этого я их выкл.). Но они включается только когда я жму Enter. Было бы вообще здорово если бы при любом раскладе, привязка и орто включались обратно... Но не знаю как это сделать.

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

Тогда показывай, каким кодом у тебя идет вставка выноски.

[ashas-]

Вот код.

Код:

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

 (defun C:Poz ()
                (getvar "orthomode")
                 (setvar "orthomode" 0)
                  (getvar "osmode")
                   (setvar "osmode" 0) 
       (setq nomer_poz (getint "\Введите № позиции <1>: " ))
        (if (= nomer_poz nil) (setq nomer_poz 1))
         (command "_.CLAYER" "р")
(setq T1 (getpoint "\Укажите точку № позиции: "))
(while T1
         (command "_.circle" T1 "40")
          (setq T2 (getpoint))
           (command "_.circle" T2 "1.5")
            (command "_.hpname" "solid")
             (command "_.bhatch" "_s" (entlast) "" "") 
              (command "_.Spline" T2 pause pause "_per" pause "" "" "")
               (command "_.CLAYER" "о")
                (command "_.text" "стиль" "позиции" "Выравнивание" "СЦ" T1 "0" Nomer_poz )
                 (command "_.CLAYER" "р")
(setq T1 (getpoint "\Укажите точку: "))
         (setq nomer_poz (+ nomer_poz 1))
) ;while
         (setvar "orthomode" 1)
          (setvar "osmode" 1)
         (command "_.osnap" "нор,сер,пер,цен,ква,кас,пар,узе,кон")
)

Смастерил что мог )).

[Лиспер]

А я из вредности предложу сделать другой размерный стиль Нет, ну кто мешает в качестве стрелки для выносок использовать Dot или Dot small?
Теперь по коду:
Зачем выполняются строки (getvar "osmode") и (getvar "orthomode"), если возвращаемые значения нигде не используются?
А если в ответ на приглашение "Введите № позиции <1> " я нажму Esc?
(command "_.clayer" - и дальше на каком языке опция? А если такого слоя нет? И, кстати, это меняет значение системной переменной, которую неплохо было бы вернуть обратно...
А если в ответ на приглашение "Укажите точку № позиции " я отвечу Esc (кстати, про какой там номер позиции-то разговор)?
Зачем вообще менять osmode, если вместо (command "_.circle" t1 40.) можно использовать (command "_.circle" "_none" t1 40.) - я не понимаю.
(command "_.hpname" <>) тоже меняет системные переменные AutoCAD. Обратно кто вертать все будет?
Почему в командах все опции на русском языке? А если у пользователя английский AutoCAD?
Почему принудительно возвращается orthomode в 1? А если на момент вызова не был установлен режим орто? Почему сначала osmode устанавливается в 1, а потом через неизвестно какие опции устанавливается новое значение (которое, кстати, тоже не факт что совпадает со стартовым)?
---
В общем и целом, я бы задумался о применении ToolPalettes - там можно попроще организовать, и все получится более целостное. Настроить только надо

[Woron]

Попробовал вставить кусок из примера.
Отработатл вроде нормально (линию построил), но со смещением.
Вот если я использую

_line "0,0" "20,20"

отрезок строится с точки (0,0,0) до точки (20,20,0).

А если из VB вызываю

ptStart(0) = 0: ptStart(1) = 0: ptStart(2) = 0 ptEnd(0) = 20: ptEnd(1) = 20: ptEnd(2) = 0 .AddLine ptStart, ptEnd

то отрезок строится с точки (-2089.8883,-3269.5897,0) до точки (-2069.8883,-3249.5897,0).

[ashas-]

Что за размерный стиль?

(getvar "osmode") и (getvar "orthomode"), сделал просто потому что видел что их пишут, решил тоже написать... ).
Если после "Введите № позиции <1> " ввести ESC то программа закончит свою работы, да еще и не в лучшем виде.
(command "_.clayer") использовал потому что делал программу только под себя, и не планировалось что бы она у кого то еще работала, и если она не вернется в прежнее значение, это не на что не повлияет.
"Укажите точку № позиции " - некорректно я здесь поставил подсказку. Имелось введу где должен находиться кружок с позицией.
Поменял osmode что бы ничего лишнего не цеплялось, дальше рисуеться сплайн и маленький кружок. Если стоит привязка "конточка" (если не ошибаюсь) то центр маленького круга и сплайн почему то не совпадают... Что делает "_none"??
Все опции на русском, потому что у меня русифицированная версия, и я не долга мучаясь написал по русски что б можно было хотя бы проверить работоспособность.
Орто возвращается обратно в "1", потому что у меня всегда орто включено...
(command "_.hpname" <>) изменение этой переменной и не возвращение ее обратно тоже не несет для меня никакой проблемы, я бы сказал, наоборот, если ее восстановить то понесет...
ToolPalettes - как ее применить? Что именно ты подразумеваешь? Стандартная выноска меня не устраивает.

Вопрос кстати, так и остался открытым, можно как нибудь ескейп обойти?

И еще: как после команды entget вытащить определенную точечную пару, или изменить ее?

[Лиспер]

Сообщение от ashas- Что за размерный стиль?

ashas-, по полной аналогии с тем, что я показывал чуть ранее.

Сообщение от ashas- сделал просто потому что видел что их пишут, решил тоже написать... )

Не стоит так делать. Надо обрабатывать только те системные переменные, которые необходимы программе - не больше и не меньше.

Сообщение от ashas- (command "_.clayer") использовал потому что делал программу только под себя, и не планировалось что бы она у кого то еще работала, и если она не вернется в прежнее значение, это не на что не повлияет.

Программы имеют не очень приятную особенность разрастаться и начинают жить своею жизнью, уже мало связанной с судьбой их автора

Сообщение от ashas- Что делает "_none"

Временно отключает привязку при указании точки. Можно попробовать, это не страшно

Сообщение от ashas- ToolPalettes - как ее применить? Что именно ты подразумеваешь? Стандартная выноска меня не устраивает.

Почему не устраивает? По-моему, настроить выноску не сложно.

Сообщение от ashas- можно как нибудь ескейп обойти?

Можно. Например, так:

Код:

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

(if (= (type (setq pt (vl-catch-all-apply (function (lamdba() (getpoint "\nУкажите точку <Отмена> : ")))))) 'list)
(princ "\nТочка указана")
(princ "\nЛибо нажат Enter, либо Esc"))
(princ)

Сообщение от ashas- как после команды entget вытащить определенную точечную пару

См.функцию assoc

Сообщение от ashas- изменить ее

См. subst

[ashas-]

Спасибо, за подробные разъяснения! Буду разбираться.

В стандартной мультивыноске мне не нравится что она постоянно сплайн с боку цепляет ...
Кулик Алексей aka kpblc, скинул мне два файла, я че то там сделал и он (сплайн) стал цепляться как надо (хаотично, в зависимости с какой стороны ведешь). Но потом че то снова сделал и теперь не могу понять как это сделать снова! Как то так... : )))
И еще мне не нравится что нельзя цвет текста поменять (можно только вместе с кружком).

Да и вообще сейчас написание мультивыноски стало как способ изучения автолиспа )

С функцией "subst" и "assoc" вроде разобрался... внес изменения в весть список примитива, до этого названный с помощью setq (в моем случае это круг)), но эти изменения не применились к примитиву. Почему? Как правильно это делается ?

Вот что я делал:

Код:

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

 (setq cir (entlast))
(setq q (entget cir))
(setq para (assoc 8 q))
(setq nov (subst '(8 . "os") '(8 . "h") q))

[Michael!]

Доброго времени суток!
Знающие люди, подскажите пожалуйста, как проверить в лиспе есть ли слой с данным именем в файле чертежа? И если он есть, его свойства на данный момент времени - скрыт-не скрыт, заморожен-разморожен, заблокирован-разблокирован.

спасибо!

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

(tblobjname "layer" ИмяСлоя) вернет nil, если слоя не существует. Если есть - возвращает ename-указатель на него. А дальше - DXF Reference в руки

[gomer]

Сообщение от Michael! роверить в лиспе есть ли слой с данным именем в файле чертежа? И если он есть, его свойства на данный момент времени - скрыт-не скрыт, заморожен-разморожен, заблокирован-разблокирован.

Как-то так, если не изменяет память:

Код:

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

 (setq lyr_nam "0")
(setq ent_lyr (tblsearch "LAYER" lyr_name))
(vla-get-Freeze (vlax-ename->vla-object ent_lyr))
(vla-get-Lock (vlax-ename->vla-object ent_lyr))

[Michael!]

вот спасибо!!! выручили.

[Michael!]

Доброго времени суток!
Еще вопросик возник:
Есть 2D замкнутая полилиния, образованная отрезками и дугами. Как найти самые удаленные точки по оси Х и по Y (максимальный размер по Х и по Y)
Спасибо!

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

Сообщение от Michael! самые удаленные точки

От чего самые удаленные? И в какую сторону? И в какой системе координат?

[Michael!]

самые удаленные друг от друга по оси Х и по оси Y в World системе координат. (как бы это сказать - самую минимальную координату Х, самую максимальную координату Х, самую минимальную координату Y, самую максимальную координату Y которые принадлежат этой фигуре (замкнутой полилинии)).

[gomer]

vla-getboundingbox

[Michael!]

спасибо!!! разобрался.

[Frigate]

ashas-,

угу, все верно

а теперь смотри функцию entmode

[alex8888]

Frigate, entmode? или entmod

[Frigate]

alex8888,

ну да, конечно entmod

в любом случае в справке найдется поиском нужная комнада )))

[ashas-]

Frigate, спасибо!

[Frigate]

Как программно узнать, что выделенный примитив (напр., по entsel) входит группу? И как определить, в какую группу он входит?


Всегда ли группа (GROUP) в entget-списке находится после пары 102 AcadReactors

(102 . "{ACAD_REACTORS") (330 . <Имя объекта: 7ef0cd10>) (102 . "}")

?

Если я прав, тогда эта функция поможет определить, входит ли указанный примитив в группу:

Код:

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

(defun adv-groups-get-group-of-entity (ent)
;функция возвращает vla-указатель на группу, к которой принадлежит примитив
(IF (equal (cdr (assoc 0 (entget (cdr (assoc 330 (entget ent)))))) "GROUP")
(PROGN
(PRINC "\nИмя группы: ")
(PRINC (vla-get-name (vlax-ename->vla-object (cdr (assoc 330 (entget ent))))))
(PRINC "\n")
(cdr (assoc 330 (entget ent)))
) ; _ end of PROGN
(PROGN
(PRINC "\nВыбранный примитив не входит ни в одну группу.")
nil
) ; _ end of PROGN
) ; _ end of IF
) ; _ end of defun

[gizmo_zx]

Добрый день.
Есть желание написать програмку для операции с буфером обмена.
На VBA все понятно ( получить буфер обмена в текстовую переменную, заменить "/P" на пробел, передать обратно в буфер)
Суть программы: сбросить форматирование текста, и убрать деление на строки (в мультитексте) если такое есть.
Вопрос как это на Lisp`e сделать?

[Do$]

Сообщение от gizmo_zx Суть программы: сбросить форматирование текста, и убрать деление на строки (в мультитексте) если такое есть. Вопрос как это на Lisp`e сделать?

В поиск по форуму - по словам mtext и unformat.

[gizmo_zx]

Сообщение от Do$ В поиск по форуму - по словам mtext и unformat.

мне это надо сделать для буфера обмена (Ctrl+V или Ctrl+С )

[Frigate]

ПОдскажите пожалуйста, как решить такую задачу:

имею множествр отрезков на чертеже - напр., по

Код:

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

(ssget "_X" '((0 . "LINE)))

нужно найти (например, ENAME-указатели или VLA-OBJ) тех отрезков, которых наложены хотя бы частично друг на друга, т.е. имеют больше 1 точки пересечения. Команда inters здесь не подходит никак. Она при наложении отрезков возвращает nil. И это логично.

[Лиспер]

Наложение и пересечение, мне кажется, разные вещи... А чем overkill не устраивает?

[Frigate]

Лиспер,

что-то оверкилл не соединяет отрезки...

он точно должен обрезать и соединять конточками отрезки, которые наложены один на другой?

Добавил: все, разобрался - просто забыл галочку игнорирования цвета поставить.

Но вот дублированные вершины полилиний не удаляет никак (

[VVA]

Сообщение от Frigate Но вот дублированные вершины полилиний не удаляет никак (

PL-VxOpt -Удаление совпадающих вершин из полилинии

мне это надо сделать для буфера обмена (Ctrl+V или Ctrl+С )

Забираешь из буфера обмена текст, сносишь форматирование, послаешь обратно в буфер обмена. Функции здесь: Копирование в буфер обмена

[Frigate]

VVA,

я уже использую твою функцию по удалению совпадающих вершин :-)

Просто захотел посмотреть, как Экспресс с этим справляется.

Забираешь из буфера обмена текст, сносишь форматирование, послаешь обратно в буфер обмена. Функции здесь: Копирование в буфер обмена

второй ЛИСП из сообщения #3 супер! Спасибо, Владимир!

[ashas-]

Всем доброго времени суток.
Прошу помощи магистров!
Я с помощью функции entget получил коды к таблице. В которой в последствии нужно будет изменить содержимое ячеек. Исходя из списка получается что содержимое ячеек храниться под кодом "1" и "302". Но как изменить их содержимое? Если я меняю код "1", то код "302" остается прежним и содержимое ячейки не меняется. То же самое с кодом "302". Если пытаюсь изменить сначала "1" потом "302", то они остаются прежними... Не пойму, что ни так делаю. Пример списка:

Код:

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

 ((-1 . <Имя объекта: 7ef033b0>) (0 . "ACAD_TABLE") (330 . <Имя объекта: 
7ef01cf8>) (5 . "1E6") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") 
(100 . "AcDbBlockReference") (2 . "*T1") (10 1663.54 1380.55 0.0) (41 . 1.0) 
(42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 
0.0 0.0 1.0) (100 . "AcDbTable") (342 . <Имя объекта: 7ef01e38>) (343 . <Имя 
объекта: 7ef03400>) (11 1.0 0.0 0.0) (90 . 22) (91 . 3) (92 . 5) (93 . 0) (94 . 
0) (95 . 0) (96 . 0) (141 . 11.0) (141 . 9.0) (141 . 9.0) (142 . 63.5) (142 . 
63.5) (142 . 63.5) (142 . 63.5) (142 . 63.5) (171 . 1) (172 . 0) (173 . 0) (174 
. 0) (175 . 5) (176 . 1) (91 . 262144) (178 . 0) (145 . 0.0) (92 . 0) (301 . 
"CELL_VALUE") (93 . 6) (90 . 4) (1 . "A1") (94 . 0) (300 . "") (302 . "A1") 
(304 . "ACVALUE_END") (171 . 1) (172 . 0) (173 . 1) (174 . 0) (175 . 1) (176 . 
1) (91 . 0) (178 . 0) (145 . 0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 3) (90 . 
0) (94 . 0) (300 . "") (302 . "") (304 . "ACVALUE_END") (171 . 1) (172 . 0) 
(173 . 1) (174 . 0) (175 . 1) (176 . 1) (91 . 0) (178 . 0) (145 . 0.0) (92 . 0) 
(301 . "CELL_VALUE") (93 . 3) (90 . 0) (94 . 0) (300 . "") (302 . "") (304 . 
"ACVALUE_END") (171 . 1) (172 . 0) (173 . 1) (174 . 0) (175 . 1) (176 . 1) (91 
. 0) (178 . 0) (145 . 0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 3) (90 . 0) (94 
. 0) (300 . "") (302 . "") (304 . "ACVALUE_END") (171 . 1) (172 . 0) (173 . 1) 
(174 . 0) (175 . 1) (176 . 1) (91 . 0) (178 . 0) (145 . 0.0) (92 . 0) (301 . 
"CELL_VALUE") (93 . 3) (90 . 0) (94 . 0) (300 . "") (302 . "") (304 . 
"ACVALUE_END") (171 . 1) (172 . 0) (173 . 0) (174 . 0) (175 . 1) (176 . 1) (91 
. 262144) (178 . 0) (145 . 0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 6) (90 . 4) 
(1 . "A2") (94 . 0) (300 . "") (302 . "A2") (304 . "ACVALUE_END") (171 . 1) 
(172 . 0) (173 . 0) (174 . 0) (175 . 1) (176 . 1) (91 . 262144) (178 . 0) (145 
. 0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 6) (90 . 4) (1 . "B2") (94 . 0) (300 
. "") (302 . "B2") (304 . "ACVALUE_END") (171 . 1) (172 . 0) (173 . 0) (174 . 
0) (175 . 1) (176 . 1) (91 . 262144) (178 . 0) (145 . 0.0) (92 . 0) (301 . 
"CELL_VALUE") (93 . 6) (90 . 4) (1 . "C2") (94 . 0) (300 . "") (302 . "C2") 
(304 . "ACVALUE_END") (171 . 1) (172 . 0) (173 . 0) (174 . 0) (175 . 1) (176 . 
1) (91 . 262144) (178 . 0) (145 . 0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 6) 
(90 . 4) (1 . "D2") (94 . 0) (300 . "") (302 . "D2") (304 . "ACVALUE_END") (171 
. 1) (172 . 0) (173 . 0) (174 . 0) (175 . 1) (176 . 1) (91 . 262144) (178 . 0) 
(145 . 0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 6) (90 . 4) (1 . "E2") (94 . 0) 
(300 . "") (302 . "E2") (304 . "ACVALUE_END") (171 . 1) (172 . 0) (173 . 0) 
(174 . 0) (175 . 1) (176 . 1) (91 . 262144) (178 . 0) (145 . 0.0) (92 . 0) (301 
. "CELL_VALUE") (93 . 6) (90 . 4) (1 . "A3") (94 . 0) (300 . "") (302 . "A3") 
(304 . "ACVALUE_END") (171 . 1) (172 . 0) (173 . 0) (174 . 0) (175 . 1) (176 . 
1) (91 . 262144) (178 . 0) (145 . 0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 6) 
(90 . 4) (1 . "B3") (94 . 0) (300 . "") (302 . "B3") (304 . "ACVALUE_END") (171 
. 1) (172 . 0) (173 . 0) (174 . 0) (175 . 1) (176 . 1) (91 . 262144) (178 . 0) 
(145 . 0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 6) (90 . 4) (1 . "C3") (94 . 0) 
(300 . "") (302 . "C3") (304 . "ACVALUE_END") (171 . 1) (172 . 0) (173 . 0) 
(174 . 0) (175 . 1) (176 . 1) (91 . 262144) (178 . 0) (145 . 0.0) (92 . 0) (301 
. "CELL_VALUE") (93 . 6) (90 . 4) (1 . "D3") (94 . 0) (300 . "") (302 . "D3") 
(304 . "ACVALUE_END") (171 . 1) (172 . 0) (173 . 0) (174 . 0) (175 . 1) (176 . 
1) (91 . 262144) (178 . 0) (145 . 0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 6) 
(90 . 4) (1 . "E3") (94 . 0) (300 . "") (302 . "E3") (304 . "ACVALUE_END"))

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

Работать с таблицей через DXF - удовольствие из разряда "врагу не пожелаешь". Настоятельно советую разобраться с vla-представлением и работой с ним.

[VVA]

Сообщение от ashas- Не пойму, что ни так делаю

Сложно сказать, не видя что ты делаешь. Но лучше прислушатьсмя к совету предыдущго поста

[ashas-]

Vla я еще не разбирал... Как то там все сложно (по крайней мере впечатление такое создается).
Если не трудно, можно ткнуть носом на что конкретно следует обратить внимание, учитывая мою задачу?

[gomer]

Сообщение от ashas- Как то там все сложно (по крайней мере впечатление такое создается).

Если не знать английский, то сложно...

[ashas-]

Сообщение от gomer Если не знать английский, то сложно...

В этом наверно то вся и беда...

[Дима_]

ну ежили совсем по простому -

Код:

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

(vla-setcellvalue (vlax-ename->vla-object (car (entsel "\nTable "))) (getint"\nRow ") (getint "\nCol ") (getstring "\nValue "))

[ashas-]

Правильно говорят, пока не прижмет, не разберешься...
Спасибо за правильный вектор .
Дима_, спасибо . А где про эту команду написано "vla-setcellvalue"? Всю книжку Полещука перелопатил, но не нашел...

[Дима_]

Поищи - или кто нибудь добрый даст ссылку как "переводить" команды из справочника автокада по VB на VisualLisp. Она тут раз 100 уже приводилась - мне сейчас просто искать лень. Если коротко берешь любой объект (из справочника VB), к методам добавляешь vla-, для чтения свойств vla-get-, для установки - vla-set- первым параметром идет непосредственно объект - далее остальные параметры. Если параметр имеет "объектное" представление - смотри функции преобразования vlax-... События (events) - реализованны несколько по другому (реакторами) - на них отдельный синтаксис смотри функции vlr-...

[gomer]

Сообщение от Дима_ для установки - vla-set-

чущъ

[Дима_]

тьфу-ты vla-put- кАнечно (перепутал я).

[gnostic]

Всем доброго здоровья!
Подскажите, пожалуйста, как отключить ( а потом снова активировать) 3D привязку? Другими словами, как реализовать нажатие клавиши F4, используя код. В Help-е не нашел ни переменной ни команды, подходяшей для дальнейшего использованя в коде. Пока в тупике! :-(

[Лиспер]

По-моему, по умолчанию F4 не вызывает никакой привязки. И чем отличается "3D"-привязка от обычного Osmode?

[gnostic]

Все! Вопрос решен! Виной всему моя невнимательность:
переменная 3DOSMODE

[Frigate]

Доброе время суток!

Прошу помощи:

что надо "скормить" функции
(command "-refedit" <объект>)

нужно подставить указатель на динблок, но ename

Код:

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

(setq ent (car (entsel)))
(vl-cmdf "-REFEDIT" ent "_o" "_o" "_a" "_n")

не принимает:

Код:

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

Команда: (vl-cmdf "-REFEDIT" ent ent "_o" "_o" "_a" "_n")
-REFEDIT Выберите вхождение:   Ссылка не найдена.
Выберите вхождение:   Ссылка не найдена.
Выберите вхождение: _o
 
*Неверный выбор*
Требуется один объект.
Выберите вхождение: _o
 
*Неверный выбор*
Требуется один объект.
Выберите вхождение: _a
 
*Неверный выбор*
Требуется один объект.
Выберите вхождение: _n
 
*Неверный выбор*
Требуется один объект.
nil
Выберите вхождение: *Прервано*

Что можно сделать?

А без refedit не сделать контекстного редактирования блока и преобразование динблока в блок. Если вручную выделять блок (по совету Супермакса) - то все Ок, но это не то, нужно автоматом разбивать.
Функции типа U2B и тп пробовал - не подходят.

[Лиспер]

Контекстное редактирование блока - зачем под это дело программу ваять? Что-то одно - либо редактирование полностью ручное, либо полностью программное.
Преобразование дин.блока в обычный блок - а это-то зачем? Я реально не понимаю конечной цели...

[Дима_]

"Накрутил" с refedit'ом AutoDesk что-то но выход есть:

Код:

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

(sssetfirst nil (ssadd (car (entsel))))
(vl-cmdf "_refedit"...)

[Frigate]

Лиспер,

это нужно, чтобы сильно замороченные блоки разбивать, почему-то у меня и знакомого они не разбиваются программно, как у VVA:

http://forum.dwg.ru/showthread.php?p...d=1#post711939

Код:

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

(defun C:test (/ ;blk_ref attr_list)
        )
  (setq
    blk_ref (vlax-ename->vla-object (car (entsel "\nВыбери блок: ")))
    ) ;_ end of setq
  
  (setq attr_list (vlax-safearray->list
      (vlax-variant-value (vla-GetAttributes blk_ref))
      ) ;_ end of vlax-safearray->list
 ) ;_ end of setq
  
  (mapcar
    (function
      (lambda (x / txt)
 (setq txt (vla-get-textstring x))
 (vla-put-textstring x "")
 (vla-put-textstring x txt)
 ) ;_ end of lambda
      ) ;_ end of function
    attr_list
    ) ;_ end of mapcar
  
  (setq ent (vlax-vla-object->ename blk_ref))
  (sssetfirst nil (ssadd ent))
  (vl-cmdf "-REFEDIT" "_o" "_o" "_a" "_n")
  (vl-cmdf "_REFCLOSE" "_s")
  
  
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acActiveViewport) ;_ end of vla-regen
  
  ) ;_ end of defun

теперь осталось только кусок проги дописать, чтобы после explode содержимое текстов было идентично значению атрибутов до explode. Но это уже не сложно должно быть.

Дима_,

большое спасибо :-)

Интересный ход!

Да уж, автодеск - еще тот перец )))

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

[Дима_]

Сообщение от Frigate Последнее время при углубленном изучении автокада все чаще попадаются глюки

Если "слезешь" с командных методов - глюков станет в разы меньше.

[ShaggyDoc]

к той же команде _refedit - на русском автокад "не понимает", только оригинальные опции надо вводить

Так это элементарное правило, относящееся ко всем командам - имена команд и опций только оригинальные, с префиксом "_". Для имен команд еще лучше префикс "_."

[VVA]

Сообщение от Frigate почему-то у меня и знакомого они не разбиваются программно, как у VVA:

Ответил в теме

Сообщение от Frigate как например опции к той же команде _refedit - на русском автокад "не понимает", только оригинальные опции надо вводить

Читать как минимум 1-й абзац

[Frigate]

VVA,

я об опциях понимаю, что их надо на англ. писать, просто в руссифицированном автокаде с переведенными командами всегда можно было вводить опции и по русски - не в программе, а непосредственно при черчении, а с некоторыми командами, типа refedit (или ССЫЛРЕД) этого нельзя - не до конца переведена команда.

ДИМА,

благодаря VVA удалось обойтись без командных методов. Вместо refedit заменил масштаб по Z на 1.001 - и вставка блока утрачивает динамику (как проекция динблока). А все остальное - дело техники.

[gnostic]

Всем крепкого здравия! Спасибо Вам всем за форум.
Но к делу:
Если стандартными средствами вызвать окошко свойств такого примитива как box,то там черным по белому(при стандартных цветовых настройках :-)) можно узнать его Length Width и Heigth. Пробую получить те же параметры с помощью кода:

Код:

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

 (setq dxf_CBOICTBA (entget(car(entsel))))

- ничего подобного, даже близко! Если, конечно, не принимать во внимание длиннющий хвост, увы недоступной, но присутствующей информации.
Тот же запрос, но вид сбоку:

Код:

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

 (setq bokc (car (entsel)))
(vl-load-com)
(vlax-dump-object (vlax-ename->vla-object bokc))

- уже теплее, но все равно, без танцев с бубном получит прямой результат ниЗЯЯЯЯЯ :-(
Вопрос к клубу Знатоков - мож кто знает заветных три слова? - Поделитесь пожалуйста!
P.S. "Иди на - не педлагать!" - Unknown command

[Дима_]

Посмотри сюда

[gnostic]

Блииин! Я так признателен и мне так стыдно за то что не удосужился поискать на форуме!
Спасибо огромнейшее!
И еще раз извините за разгильдяйский подход к поиску ответа на вопрос.
Те 8 строк из #10 поста -просто волшебство!


Честно искал по форуму, но пока все еще у разбитого корыта.
Исходные условия - куча примитивов "разбросанных" на группе слоев (скажем dt[ 1-20])
Хочу создать набор только из тех, что лежат на слоях из требуемого диапазона индексов, например dt3-dt7.
Царапаю код:

Код:

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

 (setq nabor (ssget "_X" '((8 . "dt[3-7]"))))
(vl-cmdf "erase" nabor "")

(ластик просто для наглядности).
Все в шоколоде! Но... стоит слегка изменить значение фильтра :

Код:

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

 (setq nabor (ssget "_X" '((8 . "dt[3-10]"))))
(vl-cmdf "erase" nabor "")

И начинаешь вспоминать все богатсво великого и могучего.
Поделитесь пожалуйста, своими замечаниями по этому поводу.

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

Замени (ssget "_X" '((8 . "dt[3-10]"))) на нечто типа (ssget "_X" '((8 . "dt[3-9],dt10")))

[gnostic]

Не, ну так не честно жеже!
Но тем не менее - спасибо.

[gomer]

Сообщение от gnostic Не, ну так не честно жеже!

учите матчасть, все честно...

[gnostic]

Не сочтите за труд - ткните носом.
(Спустя пару минут)
В силу того, что очень не люблю неоднозначность, решил уточнить некоторые моменты.
Перевести на LISP схему создания фильтра, от которого он (LISP) не срыгнет - как бы в вопросах не числится!
Если есть какие то основополагающие моменты (даже из школьного курса математики), о которых я не догадываюсь(говорю честно), то буду очень признателен за то что обратите на них внимание. А так, по принципу :
"Вы, товарищ студент, дурак! - А Я мост Патона строил!"
либо
"Не плюйте рядом с членом Масонской ложи!" по меньшей мере, на этом ресурсе выглядит комично.

[gomer]

Сообщение от gnostic Не сочтите за труд - ткните носом

Сообщение от gnostic (setq nabor (ssget "_X" '((8 . "dt[3-10]"))))

строка - это последовательность символов, 9 это 1 символ, 10 - это уже 2... такая конструкция работать "правильно" по определению не будет...

[gnostic]

Признаться, никогда бы в жизни не додумался!
Очень очень Вам благодарен! Спасибо!

[Aminka]

Доброго времени суток!

Столкнулась с такой вот непоняткой:

Код:

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

 
(setq selection (ssget '((-4 . "<OR")(0 . "polyline")(0 . "lwpolyline")(-4 . "OR>") ))); end setq
(setq sel_length(sslength selection))
 (setq spisok_dlin2 (ssnamex selection));;получили список, элемнты которого в свою очередь - списки
     (setq s1 (length (ssnamex selection)))

Так вот, при пошаговой отладке выяснилось что длина списка s1 и "длина" набора sel_length не совпадают. Выбираю прямоугольником в пространстве модели 3 полилинии, sel_length=3, s1 = 4.

Господа, не сочтите за труд, помогите -откуда может появляеться лишний элемент списка?

[gomer]

Сообщение от Aminka Так вот, при пошаговой отладке выяснилось что длина списка s1 и "длина" набора sel_length не совпадают. Выбираю прямоугольником в пространстве модели 3 полилинии, sel_length=3, s1 = 4.

Код:

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

 (vl-remove-if 'listp (mapcar 'cadr (ssnamex selection)))

Смотришь в книгу... видишь...

[Лиспер]

<...> Удалено, показано более удачное решение.

[Aminka]

Сообщение от gomer Код: [Выделить все] (vl-remove-if 'listp (mapcar 'cadr (ssnamex selection)))

Gomer, спасибо, но мне не понятно именно откуда берется лишний мусор при применении ssnamex, поскольку г-н Полищук утверждает, что если функция ssnamex без указания номера должна возвращать список, то длина этого списка будет равна количеству элементов набора. Однако, если выбирать не кликом мыши по объекту, а прямоугольником, то появляется лишнее значение.

[VVA]

Сообщение от Aminka но мне не понятно именно откуда берется лишний мусор при применении ssnamex

Читай справку об ssnamex. Помимо самих примитивов ssnamex возвращает более детальную информацию, например, каким способом был выбран примитив. И если способ рамка (Window or WPolygon), секрамка (Crossing or CPolygon) или линия (Fense), то будут представлены еще и описания этих многоугольников. Это и есть "лишнее значение".
Еще способ преобразовать набор в список примитивов (без vla функций) _dwgru-conv-pickset-to-list

[gomer]

Сообщение от VVA Еще способ преобразовать набор в список примитивов (без vla функций)

кхм, без ssnamex

[Aminka]

Ооо! Спасибо, еще куча всяких интересностей..)
Дивная штука автолисп..для решения одной простенькой задачи я уже накатала два варианта , а есть еще множество всяких вариантов. Посему еще вопрос-как вы определяете оптимальность для простеньких программ - быстродействием? в редакторе при трассировке где-то дано общее время выполнения лисп-приложения?

[Do$]

Сообщение от Aminka для решения одной простенькой задачи

...код может оказаться далеко не простым, если учитывать многочисленные ньюансы.

Сообщение от Aminka как вы определяете оптимальность для простеньких программ - быстродействием?

В первую очередь - универсальностью решений. Часто - в ущерб быстродействию (современные компьютеры позволяют такую роскошь).

Сообщение от Aminka в редакторе при трассировке где-то дано общее время выполнения лисп-приложения?

Нет в редакторе такого, время работы можно оценить так, как советует VVA в этом посте.

[Fynjy87]

Здравствуйте!
Как хорошо, что уже есть тема для чайников)

У меня вопрос. Поиском ответ найти не удалось. Подскажите, пожалуйста, как значения координат точек при создании объектов привязать к значениям переменных? Например, как для отрезка:

Код:

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

 (entmake '((0 . "LINE") (8 . "1") (10 0 0) (11 0 60)))

Получить по существу (10 X1 Y1) (11 X2 Y2), только на языке лиспа.

[Лиспер]

Это так что ли?

Код:

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

(entmakex (list '(0 . "LINE") '(8 . "1") (list 10 x1 y1) (list 11 x2 y2))

[Fynjy87]

Сообщение от Лиспер Это так что ли? Код: [Выделить все] (entmakex (list '(0 . "LINE") '(8 . "1") (list 10 x1 y1) (list 11 x2 y2))

Да. Здорово) Теперь все намного проще. Спасибо!

[Frigate]

День добрый!

Прошу помощи по программной работе с OpenOffice. Копал везде - в ЛИСП не нашел примеров работы с OpenOffice. Только компилированный модуль.
Проверил - модуль работет вроде корректно. Но - нужно, чтобы приложение (сам файл) (Calc=Excel) было открыто. А как его открыть программно?

Напр., для Excel делают так:

Код:

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

    (setq path (getfiled	"Выберите файл Excel:"
			(getvar "dwgprefix")
			"xls"
			16
	      )
  )
  (setq sheet_name_or_number 1); 
  (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
  (vla-put-visible ExcelApp :vlax-true)

А как запустить подобное приложение и открыть файл Calc (Open Office)?

Буду благодарен з аподсказку.

Если советов не будет, придется работать через АДО c xls.
И проверять, что я там наворотил в файле, открывая файл xls из OpenOffice.

Либо упрощенный вариант - создавать файл csv формата.

[VVA]

Сообщение от Frigate А как запустить подобное приложение и открыть файл Calc (Open Office)?

Спросить у гугла
how to create object (word/excel) for openoffice
Если за xls зарегистрирован OpenOffice (т.е. по даблклику на файле грузится OpenOffice), то можно так

Код:

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

(defun vva-xopen (name / di na sh)
;; get from Patrick_35
;; http://www.theswamp.org/index.php?topic=29548.0 
;;;Usage 
;;;(setq my_file (vva-xopen "c:/test.txt")) 
;;;(setq my_file (vva-xopen "c:/test.avi")) 
;;;(setq my_file (vva-xopen "c:/test.3gp")) 

  (and   (setq name (findfile name)) 
   (setq sh (vlax-create-object "Shell.Application")) 
   (setq di (vlax-invoke sh 'Namespace (vl-filename-directory name))) 
   (setq na (vlax-invoke di 'parsename (strcat (vl-filename-base name) (vl-filename-extension name)))) 
   (vlax-invoke-method na 'invokeverbex "open") 
  ) 
  (vlax-release-object sh) 
  na 
)

[Frigate]

VVA,

Владимир, спасибо аз ответ. Этот код мне пригодится. Но хотелось бы все-таки понять, как из ЛИСПа забраться в OpenOffice - может кто уже дошел до этого и не прочь поделиться?
Для меня описание, как из Делфи,С++ и тп попасть в OpenOffice пока сродни китайским иероглифам. Если б видеть хоть какой-нить аналог на ЛИСПе, то дальше б уже разобрался по этому аналогу. А так - остается лишь пользоваться скомпилированным модулем по обмену с OpenOffice (лежит в download), либо (что проще и надежнее) создавать файл crv в ЛИСПе.

[Fynjy87]

Еще раз, здравствуйте!)

Подскажите, пожалуйста, можно ли в лиспе задавать относительный путь к файлу? В программе Елпанова Евгения, которую я взял за основу, файлы Excel выбираются через getfiled. Когда файлов много, это неудобно. Я нашел только как жестко закрепить пусть к файлу. Но намного удобнее было бы с относительным. Это возможно?

[Дима_]

Сообщение от Fynjy87 Но намного удобнее было бы с относительным. Это возможно?

В прямую нет - автолисп не знает из какого файла загруженна программа, поищи - обсуждалось - есть варианты через поиск .lsp файлов (кривенький), (getenv "appdata") и пр.

[Fynjy87]

Сообщение от Дима_ В прямую нет - автолисп не знает из какого файла загруженна программа, поищи - обсуждалось - есть варианты через поиск .lsp файлов (кривенький), (getenv "appdata") и пр.

Ясно. Спасибо за ответ! Похоже, на данный момент шкурка выделки не стоит.

[ShaggyDoc]

шкурка выделки не стоит

Неправильный вывод. В правильной программе не должно быть никаких абсолютных путей. Все дополнительные файлы должны лежать там, где положено им лежать. А не куда их кто-то положил.

Хорошая программа должна их уметь найти. А в плохой можно и записать "C:/SuperPuper"

[Fynjy87]

Сообщение от ShaggyDoc Неправильный вывод. В правильной программе не должно быть никаких абсолютных путей. Все дополнительные файлы должны лежать там, где положено им лежать. А не куда их кто-то положил. Хорошая программа должна их уметь найти. А в плохой можно и записать "C:/SuperPuper"

Согласен. Но тут дело в приоритетах, поэтому я и сказал "на данный момент". Т.е. сейчас я ограничен во времени и мне главное написать, пусть "неправильную", но рабочую программу. А потом я уже буду потихоньку разбираться и доводить ее до правильного состояния.
Учитывая, что я только начал осваивать лисп и раньше с программированием совсем не сталкивался, сейчас у меня уйдет слишком много времени на то, чтобы разобраться. И я просто не успею.

[Frigate]

Fynjy87,

можно найти путь относительно файла чертежа, из которого ты вызываешь программу. У меня так организовано - есть директория проекта, в ней лежат чертежи и папки с определенной иерархией. Зная эту иерархию и путь к чертежу, несложно понять, как "пробежаться" по всем папкам директории проекта.

Пусть к твоему файлу чертежа находишь по

Код:

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

(getvar "dwgprefix")

или так

Код:

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

(vla-get-path
	       (vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-path

[VVA]

Сообщение от Frigate можно найти путь относительно файла чертежа,

Акад2006-пропадают внешние ссылки пост 9

PL_XRefChgr Функция глобальной замены абсолютных путей ссылок и растров на относительные и обратно, версия: 0.91

[Fynjy87]

Сообщение от Frigate Пусть к твоему файлу чертежа находишь по Код: [Выделить все] (getvar "dwgprefix")

Здорово!) Бывает же так просто. Очень забавно смотрится после всего того, что я сказал про нехватку времени для того, чтобы в этом разобраться
Но без вас я бы действительно это долго искал. Спасибо!

VVA
Сасибо, хорошие программы. Пригодятся на будущее.

[baaba]

Код:

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

 (setq a (getstring)

Что мне нужно:
если пользователь ввёл текст, ничего не делаю с переменной, оставляю как есть, если ввёл число, преобразую оператором atof в число:

Код:

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

 (setq a (atof a))

Подскажите, какая функция может проверить содержимое переменной, номер это или литера?
Как проверить содержимое переменной что бы затем присвоить ей тип?

[Лиспер]

(if (wcmatch a "[0-9]*")
(setq a (atof a))
)

[TararykovDG]

Почитайте тему
{Конкурс} Lisp. Пребразование в число при возможности

[baaba]

Лиспер, Тарарыков, спасибо!! Оба варианта нравятся!
Написал небольшой лисп для изменения dxf кода группы примитивов, может кому пригодится, выкладываю:

Код:

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

 (defun chdxf (en co vo)
	(entmod (subst (cons co vo) (assoc co en) en))
)
(defun mch (nlst n co vo)
	(if (<= 0 n)
		(progn
			(chdxf (entget (ssname nlst n)) co vo)
			(mch nlst (1- n) co vo)
		)
		(princ)
	)
)
(defun c:chdxf (/ co vo nlst)
	(setq
		co (atoi (getstring "\nEnter DXF code to change:"))
		vo  (getstring T "\nEnter new value to change:")
		nlst (ssget)
	)
	(if (wcmatch vo "[0-9]*") (setq vo (atof vo)))
	(mch nlst (1- (sslength nlst)) co vo)
)

[Лиспер]

entupd забыл - это раз; вместо (atoi (getstring <...>)) можно использовать (getint) - это два; на форуме были функции по изменению DXF-кодов - это три
В частности: а что будет, если я захочу поменять, например, 100 группу? Или -1? Или 5? Или 330? А что будет, если для примитива с цветом "ПоСлою" (группа 62) я захочу поменять цвет на 1?

[baaba]

Сообщение от Лиспер entupd забыл - это раз; вместо (atoi (getstring <...>)) можно использовать (getint) - это два; на форуме были функции по изменению DXF-кодов - это три В частности: а что будет, если я захочу поменять, например, 100 группу? Или -1? Или 5? Или 330? А что будет, если для примитива с цветом "ПоСлою" (группа 62) я захочу поменять цвет на 1?

Я так и не понял зачем нужен entupd? За getint спасибо! Что за функции то? Где про код 62 писали? У меня естественно не получается -(
Плииз, ссылку на тред!! И можно-ли по-быстрому прикрутить меню на DSL?

[gomer]

Сообщение от baaba Написал небольшой лисп для изменения dxf кода группы примитивов,

А окно свойств у вас всегда скрыто?

[Fynjy87]

Здравствуйте!

Столкнулся с такой ситуацией. Мне нужно обрезать линии, выходящие за прямоугольную область (высотой H и длиной L). Если делаю это через лисп

Код:

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

 (setq x 1
      y H
      x1 0
      y1 (+ 1 H)
      x2 (+ 1 L)
      y2 (+ 1  H)
      x3 (+ 1 L)
      y3 0 )
(command "_trim"
	 (list x y)
	 ""
	 "Л"
	 (list x1 y1)
	 (list x2 y2)
	 (list x3 y3)
	 ""
	 "")

То при включенной объектной привязке точки линии выделения объектов приснапыватся к границам области, и команда выполняется с ошибкой.
Когда вводишь те же самые команды по очереди просто в командной строке, точки ввода остаются на своих местах. Почему такой косяк, и как от него избавиться?

Или как отключить в лиспе привязку так, чтобы не сбрасывались пользовательские режимы привязки?

[TararykovDG]

Сообщение от Fynjy87 Или как отключить в лиспе привязку так, чтобы не сбрасывались пользовательские режимы привязки?

Код:

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

 
(setq old_value (getvar 'osmode)) ; запомнил текущий режим привязки
(setvar 'osmode 0) ; отключил привязки
... ; здесь Твой код
(setvar 'osmode old_value) ; восстановил привязки

[lastloch]

Сообщение от TararykovDG А Вы пробовали выключить и снова включить

Метод хорош, но пользователь, иногда, не дождавшись окончания исполнения кода, нажимает ESC и привязки остаются отключенными....

[Do$]

Сообщение от lastloch иногда, не дождавшись окончания исполнения кода, нажимает ESC

Вполне нормальная реакция для пользователя автокада - завершать команды нажатием Enter или Esc. Вот если б по Alt+F4 - это уже ненормально
Поэтому, нужно и такие ситуации обработать. Если интересно как - поиск по форуму по словам "отлов ошибок".

[Disney]

Сообщение от lastloch Метод хорош, но пользователь, иногда, не дождавшись окончания исполнения кода, нажимает ESC и привязки остаются отключенными....

Не буду давать 58 перессылающихся друг на друга ссылок, попробую чуть-чуть подытожить:

1. Не использовать командные методы:
   1. на самом деле entmake или enmakex не такие уж и страшные, надо только немного разобраться с DXF форматом, благо на всё это есть справка.
      
      
   2. Или с помощью ActivX методы Add..., там вообще всё просто, как слышится так и пишется, но справки как таковой по ActiveX в Visual Lisp нет, но зато есть по VBA и есть статья Четыре правила для работы с ActiveX в Visual Lisp в которой доходчиво объясняется как пользоваться справкой по VBA при работе с ActiveX
      
      
2. Использовать Command, луче уж тогда vl-cmdf
   1. Самый простой и в принципе надёжный, ставить "_none" перед вводом координат
      Код:

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

      (Vl-Cmdf "_trim"  "_none" (list x y) "" "Л" "_none" (list x1 y1) "_none" (list x2 y2) "_none" (list x3 y3) "" "")

   2. Чтобы много и каждый раз не писать "_none", можно отключать через системную переменную osmode, но возникает проблема с восстановлением привязок, если пользователь посреди программы нажмёт Esc. Тут уже надо бороться с Esc:
      1. Переопределение функции *error*, тогда по нажатию Esc, наша программа оборвётся там где её прервали, но у нас останется возможность, восстановить всё как было.
         
         
      2. Помещать все опасные моменты кода в функцию vl-catch-all-apply, при нажатии Esc ход выполнения программы не прервётся, и например, после анализа сбоя, можно продолжить работу программы дальше.

[TararykovDG]

lastloch, хотя Do$, уже ответил я все-таки добавлю.
Во-первых, Вы процетировали не моё сообщение, а мою подпись, поэтому Ваше сообщение выглядит не много неоднозначно.
Во-вторых, вопрос Fynjy87, не касался обработчика ошибок и отлова нажатия Esc. А для этого есть функции vl-catch-all-error-p и vl-catch-all-apply, с помощью которых все это обрабатывается и все пользовательские настроки (в том числе и режим привязок) восстанавливается после завершения работы программы!

P.S. Пока писал сообщение Disney уже все для всех разжевал

[Лиспер]

http://autolisp.ru/2009/09/22/programming-style/
http://autolisp.ru/2009/09/13/error-catch/
http://autolisp.ru/2009/09/20/howto_undo/

[VVA]

Добавлю еще к постам #1391-#1393
Все это уже обсуждалось почти в самом начале темы и касалось использования command
1. Правило
2. Osmode
3. *Error*
4. Помимо сброса OSMODE в 0, привязку можно отключать (аналог F3)
disable_osmode

[Fynjy87]

Спасибо всем за ответы!

Очень много полезной и интересной информации. Потихоньку все читаю. Особенно то, что на русском (с английским проблемы).

Сообщение от VVA 4. Помимо сброса OSMODE в 0, привязку можно отключать (аналог F3) disable_osmode

Вот, это идеальный вариант для меня на данный момент по соотношению простота/качество.

Сообщение от Disney на самом деле entmake или enmakex не такие уж и страшные, надо только немного разобраться с DXF форматом, благо на всё это есть справка.

Согласен, что они нестрашные, и использую их для создания объектов. Но разве можно с их помощью осуществить подрезку?

[Do$]

Подрезку можно осуществить с помощью функций модификаций объектов, например entmod.

[Frigate]

День добрый!

Решил не создавать новую тему. а спросить тут.

Вопрос о различии между взрывом блока с маскировкой внутри при помощи _burst в Express и (vla-explode ent).
А различие во в чем:

если взорвать при помощи (vla-explode ent), то маска может закрыть видимую часть блока после взрыва. Команда _burst взрыввает все корректно - маска находится там, где была поставлена при определении (создании) блока.

Пока лишь один вариант напрашивается - ставить маску после разбиения блока "под" остальными объекты блока при помощи _draworder.

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

Это дело определяется порядком создания примитивов. ИМХО желательно поменять именно его, не прибегая к _.draworder.

[Frigate]

Спасибо , Алексей!

А я то был уверен, что создал примитивы в блоке в правильном порядке )))
Срочно нужно переделать, пока этот неправильный блок не расплодился )))

[alex8888]

Прошу помочь разобраться.

Как сделать в моем выражении, чтобы вместо строковых значений переменных, в них были бы вещественные? Что нужно вместо setq y?

Код:

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

(setq a "355,6" b "320.4" c "10,8" d "22.14")
(foreach x (list a b c d) (setq y (distof (vl-string-subst "." "," x) 2)))

или как то приблизительно так

Код:

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

(foreach x (setq y (list a b c d)) (apply 'append y (distof (vl-string-subst "." "," x) 2)))

Пока не докумекаю как это сделать правильно

По одному переводить проблемы нет, но хотелось бы все скопом

[TararykovDG]

alex8888, если правильно понял Твой вопрос, то

Код:

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

 
(mapcar '(lambda(x) (distof (vl-string-subst "." "," x) 2)) (list a b c d))

[alex8888]

TararykovDG,

спасибо, именно то что нужно.

А если немного по другому, можно ли обойтись вообще без составления списка? Например, имею переменные, а,б,в,г и тд, в которые записаны строковые значения из полей диалогового окна (на DCL). Хочу эти значения получить числами, при этом без разницы, введены ли они с разделителем - запятой или точкой и записать их в те же переменные.
Как я говорил, по отдельности труда не составляет использовать конструкцию типа (distof (vl-string-subst "." "," x) 2).
Как работать со списком теперь тоже понятно. Но из списка снова нужно восстанавливать эти переменные, той же nth.
Есть другие алгоритмы решения задачи?

[VVA]

alex8888,

Код:

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

(setq a "355,6" b "320.4" c "10,8" d "22.14")
(mapcar '(lambda(x)(set x (read (vl-string-subst "." "," (eval x)))))
        (list 'a 'b 'c 'd)
        )

Вместо read можно использовать distof

[alex8888]

VVA

Спасибо, так намного лучше.

[TararykovDG]

alex8888, все-таки я не до конца правильно понял что было нужно и хотя VVA уже написал как надо, вот еще вариант, хотя те же "..." только сбоку

Код:

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

 
(setq a "355,6" b "320.4" c "10,8" d "22.14") 
(foreach x (list 'a 'b 'c 'd) (set x (distof (vl-string-subst "." "," (eval x)) 2)))

[alex8888]

TararykovDG,

а это как раз то, что пытался изобразить я, но никак не врубался, куда же "ваучер засунуть" (гусары-молчать!).

Оказывается, просто надо было докопаться до (eval x), остальное, вроде бы как и правильно начинал делать.

Еще раз спасибо.

[TararykovDG]

Сообщение от alex8888 Оказывается, просто надо было докопаться до (eval x), остальное, вроде бы как и правильно начинал делать.

Еще обрати внимание, что используется set x..., а не setq x ... . Иначе работать не будет, так как функция setq x ... присваивает некоторое значение переменной x, а set x ... присваивает значение символу, на который ссылается x, в нашем случает x поочередно ссылается на переменные a b c d и как раз им уже и присваиваются значения полученные выражением (distof (vl-string-subst "." "," (eval x)) 2)

[Disney]

Сообщение от alex8888 Например, имею переменные, а,б,в,г и тд, в которые записаны строковые значения из полей диалогового окна (на DCL). Хочу эти значения получить числами, при этом без разницы, введены ли они с разделителем - запятой или точкой и записать их в те же переменные.

А вообще, является ли введёно значение числом тебе тоже без разницы?
Я бы проверял значение ещё при его вводе в диалоге

Код:

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

 (action_tile
  "key"
  (vl-prin1-to-string
    (quote
      (if (not (setq key_value
		      (distof
			(vl-string-subst
			  "."
			  ","
			  (vl-string-subst
			    ""
			    " "
			    $value
			  )
			)
		      )
	       )
	  )
	(progn
	  (alert "\n Не верное число"
	  )
	  (mode_tile "key" 2)
	)
      )
    )
  )
)

Причём, как видно из кода, я бы ещё поубирал пробелы, потому что (distof "5 000") -> 5. И использовать нужно именно distof, потому что (read\atof "100 , нет лучше 500") -> 100 , не смотря на то, что пользователь всё же хотел 500, а вот distof в такой ситуации вернёт nil, и попросит пользователя быть более корректным.

[Do$]

Offtop: В аргументе функции alert "\n" - лишнее.

[ShaggyDoc]

Я бы проверял значение ещё при его вводе в диалоге

Разумеется, проверку надо делать как можно раньше. Если логикой предусмотрен ввод именно числа, то диалог не должен отработать OK, пока не будет введено именно число. Причем, возможно - число в допустимом диапазоне.
Такую (или любую другую) проверку лучше прятать в библиотечную функцию, чтобы не писать в каждой конкретной программе. Эта функция должна блокировать какой-то при "tile" при неверных параметрах ввода. Сообщение об ошибке должно быть как можно более информативным. Можно и в alert вывести (что проще), а можно и в специальный элемент самого диалога.

Вот пример такой функции

Код:

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

 (defun ru-dcl-check-tile-param
       (tile_name txt nmin nmax old dec locked_tile / val tmp res key)
  ;;nmin     - минимум
  ;;nmax     - максимум
  ;;old      - старое значение
  ;;dec      - точность отображения
  ;;locked_tile  - ключ кнопки, которую заблокировать при ошибке
  (if (setq tmp (atof (get_tile tile_name)))
    (progn
      (setq res "")
      (mode_tile locked_tile 0)
      (if (> tmp nmax)
        (setq res (strcat txt
                          " "
                          (rtos tmp 2 dec)
                          " больше "
                          (rtos nmax 2 dec)
                  ) ;_ end of strcat
        ) ;_ end of setq
      ) ;_ end of if
      (if (< tmp nmin)
        (setq res (strcat txt
                          " "
                          (rtos tmp 2 dec)
                          " меньше  "
                          (rtos nmin 2 dec)
                  ) ;_ end of strcat
        ) ;_ end of setq
      ) ;_ end of if
      ;;(set_tile "error" res)
      (if (/= res "")
        (progn
          (mode_tile tile_name 3)
          (ru-msg-alert res)
          (setq tmp old)
        ) ;_ end of progn
      ) ;_ end of if
      (set_tile tile_name (rtos tmp 2 dec))
    ) ;_ end of progn
  ) ;_ end of if
  tmp
) ;_ end of defun

[alex8888]

До "суровой" проверки руки пока не дошли, по простому, считаем, что вводится число, хотя и уже без разницы в виде с "," или "." Если будет не число, то программа не сработает - покажет ошибку, хотя и неизвестно где конкретно.
А вот action_tile в виде библиотечной функции что то не получается создать - есть ли тут какие-то подводные камни и подвохи?
В качестве примера попытка создать модуль на основе кода 1408:

Код:

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

(action_tile "eb1"  (at_input_value ring_d1))
(action_tile "eb1"  (at_input_value ring_d1))

Код:

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

(defun at_input_value (key_value / )
  
      (vl-prin1-to-string
      (quote
        (if (not (setq key_value
                        (distof
                          (vl-string-subst
                            "."
                            ","
                            (vl-string-subst
                              ""
                              " "
                              $value
                            )           ;vl-string-subst
                          )             ;vl-string-subst
                        )               ;distof
                 )                      ;setq
            )                           ;not
          (progn
            (alert "\n Íå âåðíîå ÷èñëî"
            ) ;_ end of alert
            (mode_tile "key" 2)
          )                             ;progn else
        )                               ;if
      )                                 ;quote
    )                                   ;vl-prin1-to-string

)

Не работает, хотя в виде:

Код:

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

(action_tile
    "eb1"
    (vl-prin1-to-string
      (quote
        (if (not (setq ring_d1
                        (distof
                          (vl-string-subst
                            "."
                            ","
                            (vl-string-subst
                              ""
                              " "
                              $value
                            )           ;vl-string-subst
                          )             ;vl-string-subst
                        )               ;distof
                 )                      ;setq
            )                           ;not
          (progn
            (alert "\n Íå âåðíîå ÷èñëî"
            ) ;_ end of alert
            (mode_tile "key" 2)
          )                             ;progn else
        )                               ;if
      )                                 ;quote
    )                                   ;vl-prin1-to-string
  )

очень даже как.

[Frigate]

Прошу подсказать, как программно переопределить описание блока в файле? Чтобы при _.insert уже вставлялся обновленный блок.

Файл вставляю из библиотеки блоков функцией от VVA:

Код:

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

(lib:add-block-to-doc-from-lib "MIP_LIB_DYN" "MIP_WELL_DYN_P")

[Лиспер]

1. открыть описание блока в текущем файле и внести изменения
2. открыть описание блока в файле-библиотеке, внести изменения и сохранить.

Вообще-то можно было бы сделать совсем по-хитрому: внести изменения в библиотечный файл, а потом при импорте проверять соответствия элементов имеющегося блока и библиотечного блока. При необходимости заменить состав. Только долго это и не всегда корректно работает...

P.S. Хотя, если использовать ToolPalettes, то там есть возможность повторного импорта указанного блока (с возможностью переопределения), насколько мне помнится.

[VVA]

"MIP_LIB_DYN" - имя dwg файла библиотеки
"MIP_WELL_DYN_P" - имя блока в библиотеке
Frigate, В этой ф-ции используется команда _-insert, отсюда нюансы:
1. В текущем чертеже не должно быть блока и именем, совпадающем с именем файла библиотеки. Если такой блок есть, нужно дать ему новое имя.
2. Если хочешь обновить сам блок, так же дай ему новое имя. Тогда после insert вставится обновленный блок

[Disney]

Сообщение от alex8888 Не работает

Читаем внимательно справку
action_tile
vl-prin1-to-string
quote

[alex8888]

Disney, перечитал справку, книгу Полещука по нескольку раз в указанных местах и так ничего не понял, на что ты советовал обратить внимание, извини.
По action_tile наверное, что выражение надо писать в кавычках вот так:

Код:

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

(action_tile "eb1"  "(at_input_value ring_d1)")

vl-prin1-to-string просто переводит аргумент в строку, у нас используя
quote для обработки выражения без вычисления.
Ну а теперь как связать все воедино? Получается, что в action_tile мы передаем Лисп-выражение в виде строки. Но почему нельзя передать вместо нее вызов функции с той же строкой внутри? Или надо как то по другому записать? Если не лень, можешь разжевать поподробнее ?

[Disney]

Сообщение от ShaggyDoc Такую (или любую другую) проверку лучше прятать в библиотечную функцию

Что-то у меня ни фига библиотечные не получаются, в лучшем случаи шаблонные, постоянно что-то да приходиться менять, и вводить 58 необязательных аргументов тоже не хочется.

Сообщение от alex8888 можешь разжевать поподробнее

Я честно наверно минут 30 пытался ответить не разжёвывая, так, намёками, чтоб сам разбирался, но ни фига не получилось.
Вот так будет работать, разбирайся:

Код:

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

 
(action_tile
  "eb1"
  "(setq ring_d1(at_input_value $key))"
)
		    ;
(defun at_input_value (key / temp)
  (if (not (setq temp
		  (distof
		    (vl-string-subst
		      "."
		      ","
		      (vl-string-subst
			""
			" "
			(get_tile key)
		      )
		    )
		  )
	   )
      )
    (progn
      (alert "Тут сообщение о не верном вводе")
      (mode_tile key 2)
    )
  )
  temp
)

[Лиспер]

Сообщение от Disney вводить 58 необязательных аргументов тоже не хочется.

А зачем 58? Не проще ли сделать один аргумент, но списком? http://autolisp.ru/2009/10/21/lisp-overloading/

[Disney]

Лиспер, да я в курсе, и тема недавно подобная была.
Конкретный пример, есть у меня в диалоге 4 edit_box, допустимые значения:

1. Цело, причём я не хочу чтобы "34 попугая" - считалось целым числом 34
2. Целое, но только положительное
3. Вещественное, при чём допускается префикс\суффикс
4. Вещественное, причём очень важно введено просто положительное или именно со знаком "+"

Чисто теоретически, конечно можно написать одну функцию, которая будет проверять все введённые значения на допустимость, но оно надо?

[gomer]

Сообщение от Disney о оно надо?

Надо!
зы п.3 почти противоречит п1

[Disney]

Сообщение от gomer зы п.3 почти противоречит п1

Вот и я про тоже, но это не пункты, а разные допустимые значения для разных edit_box, которые вы предлагаете проверять одной библиотечной функцией.

[ShaggyDoc]

Поясняю, как использовать библиотечную функцию ru-dcl-check-tile-param для контроля ввода во множестве программ.
Библиотечная - это функция, которая уже находится в памяти, наподобие штатных. Т.е. она доступна всегда, в любой программе.

Допустим, есть программа с диалоговым окном, в котором вводятся длина, ширина и отметка отверстия.

Ввод описан в соответствующих action_tile:

Код:

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

 ...
 (action_tile "ed_hole_length" "(_edit_length)(_set_tiles)")
 (action_tile "ed_hole_width" "(_edit_width)(_set_tiles)")
 (action_tile "ed_level" "(_edit_level)(_set_tiles)")
...

Здесь (_set_tiles) - вызов локальной функции заполнения полей диалогового окна через set_tile. Вызывается после действия в каждом action_tile. Не привожу, чтобы не отвлекать на второстепенное.

Контроль ввода спрятан в локальные функции _edit_*:

Код:

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

  (defun _edit_length ()
  (setq *hole_length
        (ru-dcl-check-tile-param
         "ed_hole_length"
         "Длина"
         50
         6000.0
         *hole_length
         0
         "button_do"
        )
  )
 )

 (defun _edit_width ()
  (setq *hole_width
        (ru-dcl-check-tile-param
         "ed_hole_width"
         "Ширина"
         0
         6000.0
         *hole_width
         0
         "button_do"
        )
  )
 )

 (defun _edit_level ()
  (setq *level_floor
        (ru-dcl-check-tile-param
         "ed_level"
         "Отметка"
         -100000
         100000
         *level_floor
         0
         "button_do"
        )
  )
 )

Зачем это спрятано в локальные функции, а не записано просто в action_tile? Да для удобства и надежности. Конечно, можно написать и:

Код:

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

 (action_tile
    "ed_hole_length"
    "(setq *hole_length (ru-dcl-check-tile-param \"ed_hole_length\" \"Длина\" 50 6000.0 *hole_length 0 \"button_do\"))(_set-tiles)"
)

результат будет аналогичный. Но формировать строку внутри строки неудобно - обратите снимание на слэши перед кавычками. Здесь легко ошибиться, поэтому лучше спрятать в функции. Да и код основной программы получается более ясный и лаконичный.

[Disney]

Сообщение от ShaggyDoc Но формировать строку внутри строки неудобно

а так

Код:

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

 (action_tile
  "ed_hole_length"
  (vl-prin1-to-string
    (quote
      (progn
	(setq *hole_length
	       (ru-dcl-check-tile-param
		 "ed_hole_length"
		 "Длина"
		 50
		 6000.0
		 *hole_length
		 0
		 "button_do"
		)
	)
	(_set-tiles)
      )
    )
  )
)

Т.е. я не в коем случаи не против функций, но пока при написании кода не сильно задумываюсь над его лаконичностью и ясностью, хотя потом при его редактировании спустя, скажем месяц, очень об этом жалею.

[Do$]

Можно полностью отказался от action_tile и пользоваться функцией отклика диалога, которая указывается третим аргументом функции new_dialog. А в ней уже обрабатывать события, используя переменные действия диалога. В таком варианте вопросов по формированию строки вообще не возникает.

[alex8888]

Do$

Можно полностью отказался от action_tile

,
примерчик можно?
Offtop: Достаточно актуально для меня по крайней мере.

[Disney]

Сообщение от Do$ пользоваться функцией отклика диалога, которая указывается третим аргументом функции new_dialog. В таком варианте вопросов по формированию строки вообще не возникает.

А не чего, что этот третий аргумент является строкой?

[ShaggyDoc]

а так

Всяко можно. И сзаду и спереду. Но обрати внимание, ты последовательно вызываешь три ненужных "технологически" функции vl-prin1-to-string, quote и progn и только ради того, чтобы сделать код более запутанным.

Ну, и попробуй, какой будет получаться результат, учитывая последовательное применение функций. А ведь в action_tile надо всего лишь передать имя в виде строки. Или выражение, которое надо выполнить. На других языках сделать это чрезвычайно сложно.

[Do$]

Сообщение от alex8888 примерчик можно?

http://forum.dwg.ru/showthread.php?p=465226 начиная с #14.

Сообщение от Disney А не чего, что этот третий аргумент является строкой?

Напрягает маленько, но терплю

[gomer]

Сообщение от ShaggyDoc обрати внимание, ты последовательно вызываешь три ненужных "технологически" функции vl-prin1-to-string, quote и progn и только ради того, чтобы сделать код более запутанным.

Это "ООП"! ну, не создавать же местные лямбды и дефуны

[gizmo_zx]

Помогите доработать "dictedit".
Чтоб удалить все связи словаря "Datalink" за раз по нажатию "Delete" (их уже сотни).

[ALFMario]

НЕ могу понять почему код не работает с аннотативными размерами

Код:

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

   (defun C:DLA ( / ss i pt1 pt2 lst e1 ed mpt ang90 pt14 Isrus *error*)
  (defun *error* (msg)(princ msg)
 (vla-endundomark(vla-get-activedocument (vlax-get-acad-object)))) ;_ end of defun
  (vl-load-com)
  (vla-startundomark(vla-get-activedocument (vlax-get-acad-object)))
 (setq Isrus (= (getvar "DWGCODEPAGE") "ANSI_1251"))
  (setq e1 nil mpt 1) 
   (while mpt
     (cond ((= mpt 1)
            (setq e1 (car(entsel (if Isrus  "Выберите эталонный размер <указать точку>:"
				            "Select source dimension <pick point>:"
				   ))))
            (if e1
              (if (and (=(cdr(assoc 0 (setq ed (entget e1)))) "DIMENSION")
                       (member '(100 . "AcDbAlignedDimension")ed)
                       )
                (progn
                (setq mpt nil)
                (setq pt1 (cdr(assoc 10 ed)))
                )
		(if Isrus
		  (princ "\nНужно выбрать линейный размер")
		  (princ "\nNeed linear or aligned dimension")
		  )
                )
              (setq mpt 2)
              )
            )
           ((= mpt 2)
            (if(setq pt1 (getpoint (if Isrus
				     "\nУкажите точку выравнивания <выбрать размер>:"
				     "\nPick align point <select dimension>:"
				     )))
              (setq pt1 (trans pt1 1 0) mpt nil)
              (setq mpt 1)
              )
            )
           (t nil)
           )
     )
  (princ (if Isrus "\nВыберите размеры для варавнивания" "\nSelect the dimensions for alignment"))
  (if (setq ss (ssget "_:L" '((0 . "DIMENSION"))))
  (progn
  (setq i '-1)
  (repeat (sslength ss)
    (setq e1  (ssname ss (setq i (1+ i))))
    (if (member '(100 . "AcDbAlignedDimension")(setq ed(entget e1)))
      (progn
        (setq pt2 (polar pt1 (+ (setq ang90 (angle (cdr(assoc 10 ed))(cdr(assoc 14 ed))))(* 0.5 pi)) 1e3))
        (if (and
              (setq mpt (inters pt1 pt2
                                (cdr(assoc 10 ed))
                                (polar (cdr(assoc 10 ed)) ang90 1e3)
                                nil
                                )
                    )
              (setq ed (subst (cons 10 mpt)(assoc 10 ed) ed)) 
               )
          (progn
            (entmake ed)
            (entupd e1)
            )
                                
      )
      )
    )
    )
  )
  )
  (setq ss nil)
(vla-endundomark(vla-get-activedocument (vlax-get-acad-object)))    
  (princ)
  )

[gomer]

наверное из-за смайлика в названии

[ALFMario]

пробовал рисовать не смайлик, всё равно не аннотацие размера не работает

[VVA]

ALFMario, приложи файл с примером где не работает

[gomer]

Повторюсь здесь... ну очень уж интересная задачка... Вот условие...

На железнодорожных путях стоит товарный состав состоящий из цистерн и товарных вагонов. Определить сколько цистерн в составе и первую максимальную по количеству цистерн цепочку, ее начало и длину.
Состав может выглядеть так: '( 0 0 1 0 1 1 1 0 0 0 1 1 0 0 1 1 1 ... )
'( 0 0 1 0 1 1 1 0 0 0 1 2 1 1 0 0 1 1 1 ... ) общий случай, когда в нем не только цистерны и вагоны... где 1 - цистерны, 0 - вагоны 2 ... - еще чего нибудь прицепили
Нужно решение именно на лиспе ...

[Disney]

Сообщение от gomer ну очень уж интересная задачка...

Вполне простая задачка, другой вопрос как её максимально изящно решить в пару действий...
вот мой вариант:

Код:

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

 (defun Search_for_tanks (train / pos count result cistern)
;;;  (Search_for_tanks '( 0 0 1 0 1 1 1 0 0 0 1 2 1 1 0 0 1 1 1))
  (setq
     pos 1
      count 0)
(while train
  (setq flag (eq (car train)1)
	train (cdr train))
  (cond
    ((and (not train)cistern flag)
     (setq result (cons (list pos (1+ count)) result)))     
    ((and cistern flag)
     (setq count (1+ count)))
    (flag
     (setq count 1
	   cistern t))
    (cistern
     (setq result (cons (list pos count) result)
	   pos (+ pos count 1)
	   cistern nil))
    (t (setq pos (1+ pos)
	     count 0))))
(setq max_chain (car(vl-sort (reverse result)(function(lambda (x y)(> (cadr x)(cadr y)))))))
(princ (strcat"\nВсего цистерн " (itoa (apply '+ (mapcar 'cadr result)))", первая максимальная цепочка начинается с " (itoa (car max_chain))"-ой позиции, и состоит из "(itoa (cadr max_chain))" цистерн"))
  )

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

http://forum.dwg.ru/showpost.php?p=739916&postcount=8

[gomer]

Сообщение от Кулик Алексей aka kpblc http://forum.dwg.ru/showpost.php?p=739916&postcount=8

Я специально выбрал именно эту тему... так как интересовало решение именно на лиспе... воть
Хотелось бы увидеть решение от Димы_ ... ... ...
Disney, пасиб... и hwd тоже...
Мое решение...
1. Сгруппировать вагоны и цистерны по спискам:
'((0 0) (1) (0) ... )
2. найти максимальный по длине, а заодно и его длину
3. отрезать его вместе с хвостом
4. собрать остальное и вычислить длину получившегося списка...
Вопрос собственно в том, как объединить по п.1

[Disney]

Сообщение от gomer Сгруппировать вагоны и цистерны по спискам: '((0 0) (1) (0) ... )

gomer, я тебе удивляюсь, там же совсем всё просто, или тебе рекурсии ни как покоя не дают?

Код:

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

 ;;;(group_values '(0 0 1 0 1 1 1 0 0 0 1 2 1 1 0 0 1 1 1))
(defun group_values (_list / first temp_list next res_list)
  (while _list
    (setq
      first	(car _list)
      temp_list	(list first)
    )
    (while (eq first (setq next (cadr _list)))
      (setq temp_list (cons next temp_list)
	    _list     (cdr _list)
      )
    )
    (setq res_list (cons temp_list res_list)
	  _list	   (cdr _list)
    )
  )
  (reverse res_list)
)

, я бы тоже посмотрел на рекурсивную функцию, причем заменить каждый while на отдельные fun_rec не проблема, а вот как задачу решить через одну fun_rec без использования циклов внутри неё, где-то на уме крутиться, а в код ни как не ложиться.

[TararykovDG]

У меня вот такой вариант. Без рекурсии правда, но и без вложенного цикла.

Код:

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

 
(defun test(lst_in / lst_current lst_out)
  (setq lst_current (list (car lst_in)))
  (foreach item (cdr lst_in)
    (if (= item (last lst_current))
      (setq lst_current (cons item lst_current))
      (setq lst_out (append lst_out (list lst_current))
	    lst_current (list item)
	    )
      )
    )
  lst_out
  )

_$ (test '(0 0 1 0 1 1 1 0 0 0 1 2 1 1 0 0 1 1 1))
((0 0) (1) (0) (1 1 1) (0 0 0) (1) (2) (1 1) (0 0))

[gomer]

Сообщение от Disney там же совсем всё просто, или тебе рекурсии ни как покоя не дают?

Ой, вот именно не дают... Кажется, мой мозг отбился от рук... В последнее время одни только идеи... например dcl библиотека блоков с деревом по xml-файлу, наподобие того, что ты сделал здесь
я то надеялся обойтись одной простой рекурсивной функцией... но не тут-то было...

[Дима_]

Сообщение от gomer Хотелось бы увидеть решение от Димы_ ... ... ...

Друзья мои я сейчас занят "люто" (большой проект делаю) - заскавиваю на форум чтоб от писанины отдохнуть - где то рядом Дисней еще про прямоугольники спрашивали - будет время обязательно отпишусь - здесь "конечно" я бы сделал рекурсией в один проход

Код:

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

 (defun vagon (lst)
 ((lambda(f-rec) (f-rec 0 0 0 0 0 0 lst))
   (lambda (count maxlen maxlen-start tmp-max tmp-start current lst)
   (if lst
       (if (= (car lst) 1)
           (if (= maxlen tmp-max)
               (f-rec (1+ count) (1+ maxlen) tmp-start (1+ tmp-max)
                      (if (zerop tmp-start) current tmp-start)
                      (1+ current) (cdr lst))
               (f-rec (1+ count) maxlen maxlen-start (1+ tmp-max)
                      (if (zerop tmp-start) current tmp-start)
                      (1+ current) (cdr lst))) 
           (f-rec count maxlen maxlen-start 0 0 (1+ current) (cdr lst)))
       (strcat "Всего " (rtos count)
               " цистерн, наибольшая цепочка в " (rtos maxlen)
               " цистерн(ы), с началом c " (rtos maxlen-start) " вагона.")))))

чирканул "не глядя" - вроде работает. Всем удачи.

[Sleekka]

Дима_, скажи пожалуйста что почитать, чтобы научиться также использовать lambda как ты, без единого setq?

[Дима_]

Тут главное понять не как, а для чего. Про стили программироваия неплохо расписанно в "Структура и интерпритация компьютерных программ", ну а в целом - почитайте про функциональное программирование.

[Sleekka]

Просто я никогда в книгах по visualLisp не встречал как работает конструкция

Код:

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

 ((lambda

Для меня lambda это тест функция mapcar, а как интерпретируется

Код:

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

 ((lambda

- я ума не приложу.
Я бы разбивал список так.

Код:

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

 (defun C:vagoni (/)
(princ (setq sda '( 0 0 1 0 1 1 1 0 0 0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 1 1 )))
(princ "\n")
(princ "\nЦистерн: ")
(princ (length (vl-remove-if (lambda (x) (eq x 1)) sda)))
(setq new_cist_cep_ (list))
(setq new_cist_Podcep_ (list))
(setq new_cist_Podcep_vag_ (list))
(foreach ent sda
(if (eq ent 0)
(progn
(setq new_cist_Podcep_ (cons ent new_cist_Podcep_))
(setq new_cist_cep_ (cons new_cist_Podcep_vag_ new_cist_cep_))
(setq new_cist_Podcep_vag_ (list))
)
(progn
(setq new_cist_Podcep_vag_ (cons ent new_cist_Podcep_vag_))
(setq new_cist_cep_ (cons new_cist_Podcep_ new_cist_cep_))
(setq new_cist_Podcep_ (list))
)
)
)
(setq new_cist_cep_ (cons new_cist_Podcep_vag_ new_cist_cep_))
(setq new_cist_cep_ (cons new_cist_Podcep_ new_cist_cep_))

(setq new_cist_cep_ (reverse new_cist_cep_))
(setq new_cist_cep_ (vl-remove-if (lambda (x) (eq x nil)) new_cist_cep_))
)

Это достаточно криво, хотелось бы понять и другой прием, но пока в лиспе не будет никаких улучшений с быстротой, то разбираться с этим действительно незачем.

[Дима_]

Лямбда - функция высшего порядка от произвольного числа аргументов возвращающая новую (пользовательскую) функцию - где первый аргумент - это список имен аргументов будующей функции, все остальные - тело функции. В отличие от большинства остальных функций - функция запускается "сразу" - до вычисления вложенных аргументов (т.н. специальная форма - так-же как и if, and, or,cond...). По сути defun и setq это обертка т.н. "синтетический сахар" от lambda (в defun добавляется параметр имени функции, в setq - область определения лямбды "расширяется" на все окружение).

но пока в лиспе не будет никаких улучшений с быстротой

- если в смысле autolisp, то боюсь что autodesk "положил" на него окончательно.

[Sleekka]

1) Спасибо за разъяснения - уже становится понятно, что это настоящий лисп, а то что я писал до этого, это обычный старый паскале-подобный код написанный на лиспе. Применять лисп как раз и нужно, через вот эти lambda т.к. сложные функциональные задачи проще и понятнее расписать через настоящий лисп, нежели пытаться превратить это все в циклы.
Автодеск то забил, но и у нас есть возможность забить на автодеск.
Интерпретатор в бриксе например работает ощутимо быстрее. Но это все равно не то чего хотелось бы.
То что автодеск забил, вообще никого не волнует, хочется вооружиться нормальными фраймворками, получать данные о примитивах АВТОКАДА (если вообще автокада, может быть ревитиа, инвентора и т.д.) через API, а уже с данными о примитивах работать на настоящем функциональном лиспе (я где то видел проект где народ пишет компилятор лиспа в MSIL - вот это сила) т.е. я хочу писать лисп-код для "умной" работы с данными для того чтобы получить конечный результат.
А вот получение введенных данных и вывод конечного результата, это удел C# .NET API, для того они и развивались долгие годы в бизнесс-приложениях и добились в этом отличных результатов. Существуют и обычные интерпретаторы под JAVA видимо скоро появятся и для C#, но я сомневаюсь что они будут сильно быстрее чем нынешний лисп в автокаде, а вот компилятор LISP - MSIL - это мне кажется будет серьезный рост производительности, а также кросплатформенность соответствующая самым современным требованиям к ПО.
Но саму идею о том что:
"Лисп-программист не разбивает алгоритм на отдельные элементарные шаги, не использует циклы, ветвления, присвоения значений переменным, а строит функцию, решающую поставленную задачу. При этом структура функции почти дословно соответствует математической формулировке решаемой задачи.
Подобная методология сейчас называется функциональным программированием. Лисп – первый функциональный язык программирования и, вероятно, первый язык, который явно приветствовал использование рекурсии."
ее нельзя убить, пока останутся умные люди на земле, она будет жить в веках.

Эта задачка с вагонами не особо сложна, но дает отличную возможность сравнить два стиля императивный и функциональный, попробую разобраться с твоим кодом (Дима_ ) и применять подобный подход, в своем проекте, надо же когда-нибудь учиться прекрасному.

[gomer]

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

блин, а я все не могу докумекать как код из #1440 сделать рекурсией... видимо простой рекурсией точно не получится...

[TararykovDG]

Сообщение от gomer блин, а я все не могу докумекать как код из #1440 сделать рекурсией... видимо простой рекурсией точно не получится...

gomer, там (в #1440) кстати ошибка. В конце, вместо lst_out должно быть (append lst_out (list lst_current)), а то конец списка не возвращается. Это я от спешки не досмотрел. А вот и рекурсия, правда не очень-то изящно

Код:

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

 
_$ (setq lst (list 2 0 1 2 1 0 1 1 1 2 0 2 2 0 1 1 1 1 0 0 0 1 0 1 1 1 1 2 0))
(2 0 1 2 1 0 1 1 1 2 0 2 2 0 1 1 1 1 0 0 0 1 0 1 1 1 1 2 0)

((lambda(f-rec) (f-rec (cdr lst) (list (list (car lst)))))
  (lambda(lst_in lst_out)
    (if lst_in
      (if (= (car lst_in) (last (last lst_out)))
	(f-rec (cdr lst_in) (reverse (append (list (append (car (reverse lst_out)) (list (car lst_in)))) (cdr (reverse lst_out)))))
	(f-rec (cdr lst_in) (append lst_out (list (list (car lst_in)))))
	)
      lst_out
      )
    )
  )

((2) (0) (1) (2) (1) (0) (1 1 1) (2) (0) (2 2) (0) (1 1 1 1) (0 0 0) (1) (0) (1 1 1 1) (2) (0))
_$ 

[ShaggyDoc]

Но саму идею о том что: "Лисп-программист не разбивает алгоритм на отдельные элементарные шаги, не использует циклы, ветвления, присвоения значений переменным, а строит функцию, решающую поставленную задачу. При этом структура функции почти дословно соответствует математической формулировке решаемой задачи. Подобная методология сейчас называется функциональным программированием. Лисп – первый функциональный язык программирования и, вероятно, первый язык, который явно приветствовал использование рекурсии." ее нельзя убить, пока останутся умные люди на земле, она будет жить в веках.

Но LISP-программисты, которые "не разбивает алгоритм на отдельные элементарные шаги, не использует циклы, ветвления, присвоения значений переменным" - ради чистоты идеи, неспособны разрабатывать программы, необходимые пользователям. Реализовывать математические формулировки задач - да, могут. А если формулировка "не эдакая" - пусть её реализует быдло императивными стилями. Потому что это "неправильная задача".

...она будет жить в веках

Будет. Как идея. Как "город солнца" Кампанеллы. Как живет с 1952 года, когда появился LISP. Надежды, на него возлагавшиеся, не оправдались. Во многом именно благодаря усилиям "пуристов". А когда не зацикливаются на самой идее, которая "будет жить в веках", а используют любые наиболее подходящие средства - получают результаты.

Уж поверьте мне, я наверняка больше всех на форуме и программ и функций написал. И "лямбды" использую (когда надо), и переменные, и (ужас!) циклы и ветвления.

[Дима_]

Сообщение от ShaggyDoc Но LISP-программисты, которые "не разбивает алгоритм на отдельные элементарные шаги, не использует циклы, ветвления, присвоения значений переменным" - ради чистоты идеи, неспособны разрабатывать программы, необходимые пользователям.

При всем уважении Вы здесь загнули. Я буквально неделю назад "смалодушничал" и ввел в f# переменную, а потом замучился потоки синхронизировать - вовремя одумался и убрал ее от греха подальше. Посмотрите на 4 .Net - там и динамическую типизацию ввели, да и в общем все что добавили - корнями упирается в 52 год. Я не сомневаюсь что это действительно вопрос времени т.к. автоматическая оптимизация на порядок отличается в фунуциональных программах, а в рукопашную далеко не уедешь. На наш век конечно "дураков хватит", но ИХМО путь тупиковый.

[ShaggyDoc]

Дима_, а при чем тут f# и .Net?

Тут идеи "которые будут жить в веках" про Лисп-программистов. Причем в конкретной реализации - Автолисп (слабенький, конечно, диалект).

Вот бы вместо идей предъявить полезную прикладную программу (не этюд). Например, как чрезвычайно популярные PlTools или Прокат от Василия Кондрата. Они же ужасно, с точки зрения "вечной идеи" написаны, но нужны людям.

[gomer]

ShaggyDoc, а где Ваш "ответ Чемберлену" (тоже ведь рекурсия )
Вот пока мой... Вроде бы стало все на свои места... но мне все равно не нравится...

Код:

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

 (setq *train* '(4 5 0 0 0 1 0 1 1 2 1 0 0 0 1 1 0 0 1 1 1 0 0 0 6 3)
      *c*     1
      *v*     0
)
(defun train (lst / _train)
  (defun _train	(lst_in lst_out)
    (if	lst_in
      (_train
	(cdr lst_in)
	(if (eq (caar lst_in) (car (last lst_out)))
	  (reverse
	    (cons
	      (append (last lst_out) (car lst_in))
	      (cdr (reverse lst_out))
	    )
	  )
	  (append lst_out (list (car lst_in)))
	)
      )
      lst_out
    )
  )
  (_train (mapcar 'list lst) '())
)

(defun maxchain	(vlst vtype)
  (car
    (vl-sort
      (vl-remove-if-not
	'(lambda (x) (eq vtype (car x)))
	(train vlst)
      )
      '(lambda (x y) (< (length y) (length x)))
    )
  )
)

(defun maxlen (vlst vtype)
  (length (maxchain *train* *c*))
)

(defun maxpos (vlst vtype)
  (vl-position (maxchain vlst vtype) (train vlst))
)

(maxlen *train* *c*)
(maxpos *train* *c*)

Сообщение от ShaggyDoc Вот бы вместо идей предъявить полезную прикладную программу (не этюд). Например, как чрезвычайно популярные PlTools или Прокат от Василия Кондрата. Они же ужасно, с точки зрения "вечной идеи" написаны, но нужны людям.

Почему не может? Чем вам не прикладная задача про цистерны??? В своем алгоритме я выделил три действия - три функции. Если я правильно понимаю, то у всех в принципе алгоритм тот же - переливание "из пустого в порожнее", кроме Димы_ и Sleekka, которые используют прием hwd...
Вот вам еще: расставить вагоны по боксам для ремонта в зависимости от типа вагона... имеем два списка: состав и боксы...
Если в программе нет кнопачек то она не перестает быть программой по определению... важен именно алгоритм... а язык и способ реализации вторичны...
зы Насчет pltools не скажу, но 'прокат' потому и развивается "никак", что написан на "бейсике".

[ShaggyDoc]

Чем вам не прикладная задача про цистерны

А, ну если это "задача", то "тады ой". Это все учебные этюды, которые в учебники можно помещать.

'прокат' потому и развивается "никак", что написан на "бейсике"

Ну, так попробуй переписать по-своему. Хотя бы ради интереса. Вот это - обычная прикладная программа. Написанная намного сложнее, чем можно было. Вот на ней и можно потренироваться.

Боксы и вагоны - это наподобие "ханойских башен" - практически никому не интересны. А прокат - то, что всем надо. Да еще в 3D.

Никакого "абстракционизьма", сплошной "реализьм".

[Дима_]

Сообщение от TararykovDG А вот и рекурсия, правда не очень-то изящно

ИХМО накрутили Вы коллега здесь лишнего - простое правило - если алгоритм простой, то и рекурсия должна выглядеть просто (без надобности я стараюсь не использовать list и append внутри рекурсии - т.к. в итоге это только код усложняет):

Код:

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

 (defun test (lst)
 ((lambda (f-rec) (f-rec (cons (car lst) nil) (cdr lst)))
     (lambda (x lst)
       (if lst
           (if (equal (car x) (car lst))
               (f-rec (cons (car lst) x) (cdr lst))
               (cons x (f-rec (cons (car lst) nil) (cdr lst))))
           (cons x nil)))))

[TararykovDG]

Сообщение от Дима_ ИХМО накрутили Вы коллега здесь лишнего - простое правило - если алгоритм простой, то и рекурсия должна выглядеть просто (без надобности я стараюсь не использовать list и append внутри рекурсии - т.к. в итоге это только код усложняет):

Дима_, я не спорю, просто так как у Вас у меня пока не получается .

[gomer]

Сообщение от ShaggyDoc Ну, так попробуй переписать по-своему. Хотя бы ради интереса. Вот это - обычная прикладная программа. Написанная намного сложнее, чем можно было. Вот на ней и можно потренироваться. Боксы и вагоны - это наподобие "ханойских башен" - практически никому не интересны. А прокат - то, что всем надо. Да еще в 3D. Никакого "абстракционизьма", сплошной "реализьм".

Хм, пробовал, но забил... когда стал разбираться... и на болты болт положил к сожалению... потому что ошибся где-то и не смог найти ошибку

Насчет башен согласен, а насчет не интересно - увы, хотя каждому свое: строителям - прокат, машиностроителям - болты, железнодорожникам - цистерны и вагоны

Дима_, это как раз то, что я хотел...

Код:

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

 (defun train (lst / _train)
  (defun _train (lst_out lst_in)
    (if lst_in
      (if (equal (car lst_out) (car lst_in))
        (_train (cons (car lst_in) lst_out) (cdr lst_in))
        (cons lst_out (_train (list (car lst_in)) (cdr lst_in)))
      )
      (list lst_out)
    )
  )
  (_train (list (car lst)) (cdr lst))
)

воть

/ Перенесено из http://forum.dwg.ru/showthread.php?t=7411 / kpblc /
Почему лисп рисует объект по введённым параметрам на запросы командной строки для предпоследних введённых параметров?

[gomer]

прошло 5 лет... рамка все еще актуальна?

Нет
Другое уже.

Код:

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

 (defun c:razvertka ()
  (setq	H1	(getreal "\n Введите высоту элемента конструкции H1=")
	K1	(getreal
		  "\n Введите размер между внутренними поверхностями граней нижнего основания (диаметр для конуса) K1="
		) ;_ конец getreal
	k2	(getreal
		  "\n Введите размер между внутренними поверхностями граней верхнего основания (диаметр для конуса) k2="
		) ;_ конец getreal
	Udugokr	(getreal
		  "\n Введите в градусах значение угла дуги подлежащей развёртыванию Udugokr="
		) ;_ конец getreal
	ngran	(getint
		  "\n Введите количество граней элемента конструкции ngran="
		) ;_ конец getint
	rp	(getreal "\n Введите радиус инструмента (пуансона) rp=")
	tm	(getreal "\n Введите толщину изгибаемого материала tm= ")
	x	(getreal "\n Введите значение коэффициента изгиба x= ")
	BT	(getpoint
		  "\n Введите координаты базовой точки: [можно мышкой] "
		) ;_ конец getpoint
  ) ;_ конец setq
  (if (= 0 ngran)
    ((setq alfaradian (/ (* pi Udugokr) 180)
	   KK1	      (+ K1 (* 2 (* tm x)))
	   kk2	      (+ k2 (* 2 (* tm x)))
	   Ldug	      (* (* 0.5 kk2) alfaradian)
	   betta1     (atan (/ (- KK1 kk2) (* 2 H1)))
	   r2	      (/ (* 0.5 kk2) (sin betta1))
	   R1	      (/ (* 0.5 KK1) (sin betta1))
	   betta2     (* 0.5 (/ Ldug r2))
	   BT1	      (polar BT (- (* 1.5 pi) betta2) r2)
	   BT2	      (polar BT (* 1.5 pi) r2)
	   BT3	      (polar BT (+ (* 1.5 pi) betta2) r2)
	   BT4	      (polar BT (- (* 1.5 pi) betta2) R1)
	   BT5	      (polar BT (* 1.5 pi) R1)
	   BT6	      (polar BT (+ (* 1.5 pi) betta2) R1)
     ) ;_ конец setq
      (command "_.ARC" BT1 BT2 BT3 "_.ARC" BT4 BT5 BT6)
      (command "_.line" BT1 BT4 "")
      (command "_.line" BT3 BT6 "")
      (command "_.zoom" "_E")
    ) ;_ конец command
    ((setq Y1		    (/ 360 (* 2 ngran))
	   Y1rad	    (/ (* Y1 pi) 180)
	   KK1		    (+ K1 (* tm x))
	   kk2		    (+ k2 (* tm x))
	   Lgran1	    (* 2 (* KK1 (sin Y1rad)))
	   lgran2	    (* 2 (* kk2 (sin Y1rad)))
	   Rgib		    (+ rp (* tm x))
	   Y2rad	    (* 2 Y1rad)
	   Lduggib	    (* Rgib Y2rad)
	   L1kraingran	    (+ Lgran1 (* 0.5 Lduggib))
	   l2kraingran	    (+ lgran2 (* 0.5 Lduggib))
	   L1osngran	    (+ Lgran1 Lduggib)
	   l2osngran	    (+ lgran2 Lduggib)
	   betta3	    (atan (/ (- KK1 kk2) (* 2 H1)))
	   Visotagrani	    (/ H1 (cos betta3))
	   Raznicakraingran (/ (- L1kraingran l2kraingran) 2)
	   Lrebra	    (sqrt (+ (* Raznicakraingran Raznicakraingran)
				     (* Visotagrani Visotagrani)
				  ) ;_ конец +
			    ) ;_ конец sqrt
	   mu		    (atan (/ Raznicakraingran Visotagrani))
	   P1		    (/ (- (* 0.5 KK1) Rgib) (cos Y1rad))
	   p2		    (/ (- (* 0.5 kk2) Rgib) (cos Y1rad))
	   D1		    (* 2 (+ P1 Rgib))
	   d2		    (* 2 (+ p2 Rgib))
	   betta4	    (atan (/ (- D1 d2) (* 2 H1)))
	   Sh		    (/ (* 0.5 d2) (sin betta4))
	   BT7		    (polar BT (* 1.5 pi) Sh)
	   BT8		    (polar BT7 (+ (* 2 pi) mu) l2kraingran)
	   BT9		    (polar BT7 (* 1.5 pi) Lrebra)
	   BT10		    (polar BT9 (+ (* 2 pi) mu) L1kraingran)
	   BT11		    (polar BT8 (+ (* 2 pi) (* 2 mu)) l2osngran)
	   BT12		    (polar BT10 (+ (* 2 pi) (* 2 mu)) L1osngran)
     ) ;_ конец setq
      (command "_.pline" BT7 "_w" 1 1 BT8 BT10 BT9 BT7 "")
      (command "_.pline" BT8 "_w" 1 1 BT11 BT12 BT10 BT8 "")
      (command "_.zoom" "_E")
    ) ;_ конец if
  ) ;_ конец defun  
) ;_ конец defun

gomer

Особо не критикуйте.Пишу код как могу-с книжкой в руках.

В общем проблема в следующем:загружаю активное окно редактора лиспа,перехожу в автокад,из буфера в командую строку вставляю razvertka,дальше по просьбам ком.строки-первый результат нулевой (пусто).В ком.строке какаято ошибка.Повторный ввод-отрисовывает развёртку по ппервым данным.

p.s.Код недоделанный.

[gomer]

Сообщение от Владимир Егорьев Особо не критикуйте.Пишу код как могу-с книжкой в руках.

Либо читайте внимательно книжку, особенно про локальные переменные или функцию (initget 1) или про то, как не стоит забывать вписывать функции в скобки... например... progn... либо чаще смотреть в командную строку

Спасибо за направление.Уже что-то.

Сообщение от gomer ... либо чаще смотреть в командную строку

Это вы про то что пишет ком.строка.Так ни всегда понятно на что она ругается.

[gomer]

у вас результат вычисления setq - список... список не может быть функцией... о чем автогад вам и напоминает... ваша задача найти куда вставить progn... справитесь?

Да gomer.Спасибо.Уверен что справлюсь.
Дело в том что практики нет и поэтому функции лиспа ищу долго.Да и описание не всегда понимаю в книге(ах).


Добавлено->gomer

Всё решилось.
У меня ещё вопрос.
Мне нужно в этом коде выбрать созданный обект (грань многогранника) для того чтобы его ARRAYрить.Функция entlast подходит?

[gomer]

хи-хи... жестко тему прикрыли...

[Apelsinov]

Попробовал немного помочь.
Однако, на мой взгляд, не стоит в принципе вводить исходные данные таким последовательным образом, лучше сделать диалог, например dcl, либо еще каким нибудь образом, но сразу все, а не поочереди.

ну и еще из обязательного - надо локализовать переменные, хотя в вашем случае это много работы, мне лень

Код:

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

 (defun	c:razvertka ()
   (if 
   (and
	 (setq
	   H1 (getreal "\n Введите высоту элемента конструкции H1=")
	 )
	 (setq K1
		(getreal
		  "\n Введите размер между внутренними поверхностями граней нижнего основания (диаметр для конуса) K1="
		)
	 )
	 (setq k2
		(getreal
		  "\n Введите размер между внутренними поверхностями граней верхнего основания (диаметр для конуса) k2="
		)
	 )
	 (setq Udugokr
		(getreal
		  "\n Введите в градусах значение угла дуги подлежащей развёртыванию Udugokr="
		)
	 )
	 (setq ngran
		(getint
		  "\n Введите количество граней элемента конструкции ngran="
		)
	 )
	 (setq
	   rp (getreal "\n Введите радиус инструмента (пуансона) rp=")
	 )
	 (setq tm
		(getreal "\n Введите толщину изгибаемого материала tm= ")
	 )
	 (setq
	   x (getreal "\n Введите значение коэффициента изгиба x= ")
	 )
	 (setq
	   BT (getpoint
		"\n Введите координаты базовой точки: [можно мышкой] "
	      )
	 )
       )
     (if (and (= 0 ngran)
	      (setq alfaradian (/ (* pi Udugokr) 180))
	      (setq KK1 (+ K1 (* 2 (* tm x))))
	      (setq kk2 (+ k2 (* 2 (* tm x))))
	      (setq Ldug (* (* 0.5 kk2) alfaradian))
	      (setq betta1 (atan (/ (- KK1 kk2) (* 2 H1))))
	      (setq r2 (/ (* 0.5 kk2) (sin betta1)))
	      (setq R1 (/ (* 0.5 KK1) (sin betta1)))
	      (setq betta2 (* 0.5 (/ Ldug r2)))
	      (setq BT1 (polar BT (- (* 1.5 pi) betta2) r2))
	      (setq BT2 (polar BT (* 1.5 pi) r2))
	      (setq BT3 (polar BT (+ (* 1.5 pi) betta2) r2))
	      (setq BT4 (polar BT (- (* 1.5 pi) betta2) R1))
	      (setq BT5 (polar BT (* 1.5 pi) R1))
	      (setq BT6 (polar BT (+ (* 1.5 pi) betta2) R1))
	 )
       (and
	 (vl-cmdf "_.ARC" BT1 BT2 BT3 "_.ARC" BT4 BT5 BT6)
	 (vl-cmdf "_.line" BT1 BT4 "")
	 (vl-cmdf "_.line" BT3 BT6 "")
	 (vl-cmdf "_.zoom" "_E")
       )
       (if (and
	     (setq Y1 (/ 360 (* 2 ngran)))
	     (setq Y1rad (/ (* Y1 pi) 180))
	     (setq KK1 (+ K1 (* tm x)))
	     (setq kk2 (+ k2 (* tm x)))
	     (setq Lgran1 (* 2 (* KK1 (sin Y1rad))))
	     (setq lgran2 (* 2 (* kk2 (sin Y1rad))))
	     (setq Rgib (+ rp (* tm x)))
	     (setq Y2rad (* 2 Y1rad))
	     (setq Lduggib (* Rgib Y2rad))
	     (setq L1kraingran (+ Lgran1 (* 0.5 Lduggib)))
	     (setq l2kraingran (+ lgran2 (* 0.5 Lduggib)))
	     (setq L1osngran (+ Lgran1 Lduggib))
	     (setq l2osngran (+ lgran2 Lduggib))
	     (setq betta3 (atan (/ (- KK1 kk2) (* 2 H1))))
	     (setq Visotagrani (/ H1 (cos betta3)))
	     (setq Raznicakraingran
		    (/ (- L1kraingran l2kraingran) 2)
	     )
	     (setq
	       Lrebra (sqrt (+ (* Raznicakraingran Raznicakraingran)
			       (* Visotagrani Visotagrani)
			    )
		      )
	     )
	     (setq mu (atan (/ Raznicakraingran Visotagrani)))
	     (setq P1 (/ (- (* 0.5 KK1) Rgib) (cos Y1rad)))
	     (setq p2 (/ (- (* 0.5 kk2) Rgib) (cos Y1rad)))
	     (setq D1 (* 2 (+ P1 Rgib)))
	     (setq d2 (* 2 (+ p2 Rgib)))
	     (setq betta4 (atan (/ (- D1 d2) (* 2 H1))))
	     (setq Sh (/ (* 0.5 d2) (sin betta4)))
	     (setq BT7 (polar BT (* 1.5 pi) Sh))
	     (setq BT8 (polar BT7 (+ (* 2 pi) mu) l2kraingran))
	     (setq BT9 (polar BT7 (* 1.5 pi) Lrebra))
	     (setq BT10 (polar BT9 (+ (* 2 pi) mu) L1kraingran))
	     (setq BT11 (polar BT8 (+ (* 2 pi) (* 2 mu)) l2osngran))
	     (setq BT12 (polar BT10 (+ (* 2 pi) (* 2 mu)) L1osngran))
	   )
	 (and
	   (vl-cmdf "_.pline" BT7 "_w" 1 1 BT8 BT10 BT9 BT7 "")
	   (vl-cmdf "_.pline" BT8 "_w" 1 1 BT11 BT12 BT10 BT8 "")
	   (vl-cmdf "_.zoom" "_E")
	 )
       )
     )
   )
 )

Apelsinov

Однако, на мой взгляд, не стоит в принципе вводить исходные данные таким последовательным образом, лучше сделать диалог, например dcl, либо еще каким нибудь образом, но сразу все, а не поочереди.

Всё правильно вы говорите.
Но всё постепенно.Я так сказать ещё ходить учусь.
Это с позволения сказать програмка будет использоваться (во всяком случае я надеюсь) в реальности и вот её я и возьму для развития.Пока мне удалось вот это.

Повторю вопрос по поводу entlast:Мне нужно в этом коде выбрать созданный обект (грань многогранника) для того чтобы его ARRAYрить.Функция entlast для этого подходит?

[gomer]

Сообщение от Apelsinov Попробовал немного помочь.

старая школа... моя твоя не понимайт...

Сообщение от Владимир Егорьев Повторю вопрос по поводу entlast:Мне нужно в этом коде выбрать созданный обект (грань многогранника) для того чтобы его ARRAYрить.Функция entlast для этого подходит?

да, подходит... вызывать ее нужно непосредственно после отрисовки примитива... например

Код:

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

 (vl-cmdf "_.ARC" BT1 BT2 BT3 "_.ARC" BT4 BT5 BT6)
(setq arcobj (entlast))
 (vl-cmdf "_.line" BT1 BT4 "")
(setq lineobj (entlast))

[Aminka]

Всем привет и большое спасибо за то, что тратите свое время на ответы на вопросы.

Ну и сам вопрос.

Есть у меня идея сделать своеобразный откат при выполнении выбора объектов, инициированном функцией (ssget). Хотелось бы иметь возможность в случае выбора ненужного объекта выкинуть его из выборки правым кликом кнопки мыши, и продолжать выбирать объекты дальше. Но - нажатие правой кнопки мыши приводит к выходу из ssget.

Вижу только один вариант:
1.Выборка "А" обнуляется. Используется реактор мыши - каждый раз, когда происходит клик правой кнопкой мыши и функция ssget автоматически заканчивает работу по выборке "B" происходит следующее:
1.1. удаляется последний элемент из выборки "B".
1.2. к исходной выборке "А" добавляются только выборка "B".
1.3. обнуляется "B".
1.4. запускается ssget - для новой выборки "B".

Так же возможно поставить реактор на выбор объекта - тогда удаляться будет не последний элемент, а группа элементов.

В том ли направлении я размышляю или есть какие-то другие методики?

[Лиспер]

Есть же штатный вариант: нажать Shift и, не отпуская его, выделить объект, попавший в набор. Объект будет исключен из набора (точный список системных переменных, отвечающих за такое поведение, сказать не могу, навскидку: pickfirst, pickadd, pickdrag).

[Apelsinov]

Aminka, а еще есть ключи команды выбора, стандартные

Код:

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

Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/Previous/Undo/AUto/SIngle

там есть и Remove.
Вы же пытаетесь сделать нестандартный вариант выбора, для пользователя это будет как минимум не привычно.

[Aminka]

Мдя) что еще раз доказывает, что Аминка еще очень мало знает и чертит весьма криво)
Спасибо.

[wetr]

подскажите, как с помощью лисп узнать версию загруженного автокада?

[TararykovDG]

Сообщение от wetr подскажите, как с помощью лисп узнать версию загруженного автокада?

Код:

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

 
(getvar "acadver")

[Лиспер]

Код:

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

 (atoi (vl-string-trim "VISUALP " (strcase (ver))))

[wetr]

TararykovDG, спасибо!
Лиспер - круть!

[VVA]

Почти как у лиспера

Код:

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

  ;;;Get from Elpanov Evgeniy http://www.theswamp.org/index.php?topic=36606.msg416187
  (atoi (substr (ver) 13))

Код:

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

 (setq massiv1 (vla-arraypolar obj (- ngran 2) (* betta4 (- ngran 2)) (vlax-3d-point BT))) 
	   (vlax-safearray->list (vlax-variant-value massiv1))
	   (vl-cmdf "_.zoom" "_E"))))

В результате выполнения массива не точно выполняется градусная мера угла сектора.Я так подозреваю что дело в точности угла.
В чём может быть причина вышеуказанного?

[gomer]

Сообщение от Владимир Егорьев В результате выполнения массива не точно выполняется градусная мера угла сектора.Я так подозреваю что дело в точности угла.

мдя
вот вам для размышлений

Код:

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

 (setq LineObj
  (vla-AddLine
    (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
    (vlax-3d-point '(4 4 0))
    (vlax-3d-point '(7 1 0))
  )
  n 6
)
(vla-ArrayPolar
  LineObj
  n
  (* (1- n) (/ (* pi 2) n))
  (vlax-3d-point '(2 2 0))
)

gomer

Моя вина-я не полностью часть кода выложил в посте 1478.

Код:

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

 (vl-cmdf "_.pline" BT7 "_w" 0.1 0.1 BT8 BT10 BT9 BT7 "")
	   (setq ee1 (entlast))
	   (vl-cmdf "_.pline" BT7 "_w" 0.1 0.1 BT11 BT12 BT9 BT7 "")
	   (setq ee2 (entlast))
	   (setq obj (vlax-ename->vla-object ee1))
	   (setq massiv1 (vla-arraypolar
			   obj
			   (- ngran 2)
			   (* betta4 (- ngran 2))
			   (vlax-3d-point BT)
			 ) ;_ конец vla-arraypolar
	   ) ;_ конец setq
	   (vlax-safearray->list (vlax-variant-value massiv1))
	   (vl-cmdf "_.zoom" "_E")

Мне нужно выполнить массив объекта (второй объект на скриншоте)относительно базовой точки.И получается вот так как на скриншоте 1 или ещё могут быть вариаты,в зависимости от того что у меня будет в качестве переменной betta4,но только не то что надо (см. скрин 2)

p.s. Пунктир и BT-не програмно нарисован.Просто для пояснения.

[gomer]

Владимир Егорьев, зачем вам 2я полилиния? Размножайте первую, у вас логическая ошибка в коде, продумайте тщательно алгоритм действий, лучше запишите... найдите ошибку или спрашивать еще долго будете...

Сообщение от gomer Владимир Егорьев, зачем вам 2я полилиния? Размножайте первую, у вас логическая ошибка в коде, продумайте тщательно алгоритм действий, лучше запишите... найдите ошибку или спрашивать еще долго будете...

Поясню.
Дело в том что первая и последняя (нет её пока на скринах) грани (слева направо) будущего многогранного профиля имеют размеры меньше чем так называемые основные грани.
Поэтому как я задумал-вначале множу относительно ВТ основные грани,а после этого крайние.
У крайней грани относительная точка центра массива не будет ВТ.Будет другая.
Над алгоритмом кода подумаю.

gomer

В функции vlax-3d-point я ввёл "ВТ".Это правильно или нет и надо чтобы обязательно был список в виде чисел?

"ВТ"-это точка с координатами которые получаются после клика мышью в граф.редакторе када.

[gomer]

Сообщение от Владимир Егорьев В функции vlax-3d-point я ввёл "ВТ".Это правильно или нет и надо чтобы обязательно был список в виде чисел?

"BT" - это строка... так нельзя... BT - должен быть списком из 2х или трех чисел... в первом случае третья координата добавляется автоматически в виде нуля

Вот я попробовал задать нули (vlax-3d-point 0 0 0) и при выполнении запросов в ком строке не кликал мышью а тоже ввёл нули-результат тот же самый.
Я уверен что у меня проблема в угле.Ниже в коде это пероеменная mu2 с коэффициентом.
Вначале коэффициент был-2.Грани при этом не совмещались.Затем я начал уменьшать этот коэффициент и грани начали стремиться к совмещению как должно быть по второму скриншоту в посте выше.

Код:

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

 (setq massiv1 (vla-arraypolar
			   obj
			   (- ngran 2)
			   (* (* 1.5125 mu2) (- ngran 2))
			   (vlax-3d-point BT)

Вот этот коэффициент 1.5125.Но всё равно задача не решена.Грани не совмещаются идеально.
Вопрос:Когда выполняется массив по кругу,какая точка множиться?Ведь объект должен быть "привязан".Например центр тяжести объекта.

[gomer]

Я же предложил вам продумать алгоритм, а не танцевать с бубном... Конечно точка тут не причем...
И дело не в угле, хотя именно в нем... а в логике программы...
Вы складываете яблоки с грушами... что получаете?
Вы боитесь выложить код полностью... Почему? без кода помочь весьма проблематично... по сути угол заполнения это количество внутренних граней, умноженное на угол между не параллельными сторонами грани... никаких коэффициентов...

Код:

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

 (defun c:razvertka ()
  (setq	H1	(getreal "\n Введите высоту элемента конструкции H1=")
	K1	(getreal
		  "\n Введите размер между внутренними поверхностями граней нижнего основания (диаметр для конуса) K1="
		) ;_ конец getreal
	k2	(getreal
		  "\n Введите размер между внутренними поверхностями граней верхнего основания (диаметр для конуса) k2="
		) ;_ конец getreal
	Udugokr	(getreal
		  "\n Введите в градусах значение угла дуги подлежащей развёртыванию Udugokr="
		) ;_ конец getreal
	ngran	(getint
		  "\n Введите количество граней элемента конструкции ngran="
		) ;_ конец getint
	rp	(getreal "\n Введите радиус инструмента (пуансона) rp=")
	tm	(getreal "\n Введите толщину изгибаемого материала tm= ")
	x	(getreal "\n Введите значение коэффициента изгиба x= ")
	BT	(getpoint
		  "\n Введите координаты базовой точки: [можно мышкой] "
		) ;_ конец getpoint
  ) ;_ конец setq
  (if (= 0 ngran)
    (progn (setq alfaradian (/ (* pi Udugokr) 180)
		 KK1	    (- K1 (* 2 (* tm (- 1 x))))
		 kk2	    (- k2 (* 2 (* tm (- 1 x))))
		 Ldug	    (* (* 0.5 kk2) alfaradian)
		 betta1	    (atan (/ (- KK1 kk2) (* 2 H1)))
		 r2	    (/ (* 0.5 kk2) (sin betta1))
		 R1	    (/ (* 0.5 KK1) (sin betta1))
		 betta2	    (* 0.5 (/ Ldug r2))
		 BT1	    (polar BT (- (* 1.5 pi) betta2) r2)
		 BT2	    (polar BT (* 1.5 pi) r2)
		 BT3	    (polar BT (+ (* 1.5 pi) betta2) r2)
		 BT4	    (polar BT (- (* 1.5 pi) betta2) R1)
		 BT5	    (polar BT (* 1.5 pi) R1)
		 BT6	    (polar BT (+ (* 1.5 pi) betta2) R1)
	   ) ;_ конец setq
	   (vl-cmdf "_.ARC" BT1 BT2 BT3 "_.ARC" BT4 BT5 BT6)
	   (vl-cmdf "_.line" BT1 BT4 "")
	   (vl-cmdf "_.line" BT3 BT6 "")
	   (vl-cmdf "_.zoom" "_E")
    ) ;_ конец command
    (progn (setq Y1		  (/ 360 (* 2 ngran))
		 Y1rad		  (/ (* Y1 pi) 180)
		 SS1		  (- K1 (* 2 (* tm (- 1 x))))
		 ss2		  (- k2 (* 2 (* tm (- 1 x))))
		 Rgib		  (+ rp (* tm x))
		 ost		  (- (/ Rgib (cos Y1rad)) Rgib)
		 Y2rad		  (* 2 Y1rad)
		 Lduggib	  (* (+ Rgib x) Y2rad)
		 Lgran1		  (- (* 2 (* (/ (* 0.5 SS1) (cos Y1rad)) (sin Y1rad)))
				     (* (+ rp x) Y2rad)
				  ) ;_ конец -
		 lgran2		  (- (* 2 (* (/ (* 0.5 ss2) (cos Y1rad)) (sin Y1rad)))
				     (* (+ rp x) Y2rad)
				  ) ;_ конец -
		 L1kraingran	  (+ Lgran1 (* 0.5 Lduggib))
		 l2kraingran	  (+ lgran2 (* 0.5 Lduggib))
		 L1osngran	  (+ Lgran1 Lduggib)
		 l2osngran	  (+ lgran2 Lduggib)
		 betta3		  (atan (/ (- SS1 ss2) (* 2 H1)))
		 Visotagrani	  (/ H1 (cos betta3))
		 Raznicakraingran (/ (- L1kraingran l2kraingran) 2)
		 Raznicaosngran	  (/ (- L1osngran l2osngran) 2)
		 D1		  (- (/ SS1 (cos Y1rad) (* 2 ost)))
		 d2		  (- (/ ss2 (cos Y1rad) (* 2 ost)))
		 P1		  (/ (- D1 d2) 2)
		 Lrebra		  (sqrt (+ (* P1 P1) (* H1 H1))) ; _
					; конец
					; sqrt
		 mu1		  (atan (/ Raznicakraingran Visotagrani))
		 mu2		  (atan (/ Raznicaosngran Visotagrani))
		 betta4		  (atan (/ (- D1 d2) (* 2 H1)))
		 Sh		  (/ (* 0.5 d2) (sin betta4))
		 BT7		  (polar BT (* 1.5 pi) Sh)
		 BT8		  (polar BT7 (+ (* 2 pi) mu2) l2osngran)
		 BT9		  (polar BT7 (* 1.5 pi) Lrebra)
		 BT10		  (polar BT9 (+ (* 2 pi) mu2) L1osngran)
		 BT11		  (polar BT7 (- (+ pi (* 2 pi)) mu1) l2kraingran)
		 BT12		  (polar BT9 (- (+ pi (* 2 pi)) mu1) L1kraingran)
	   ) ;_ конец setq
	   (vl-cmdf "_.pline" BT7 "_w" 0.1 0.1 BT8 BT10 BT9 BT7 "")
	   (setq ee1 (entlast))
	   (vl-cmdf "_.pline" BT7 "_w" 0.1 0.1 BT11 BT12 BT9 BT7 "")
	   (setq ee2 (entlast))
	   (setq obj (vlax-ename->vla-object ee1))
	   (setq massiv1 (vla-arraypolar
			   obj
			   (- ngran 2)
			   (* (* 1.5125 mu2) (- ngran 2))
			   (vlax-3d-point BT)
			 ) ;_ конец vla-arraypolar
	   ) ;_ конец setq
	   (vlax-safearray->list (vlax-variant-value massiv1))
	   (vl-cmdf "_.zoom" "_E")
    ) ;_ конец if
  ) ;_ конец defun  
) ;_ конец defun

Добавил

Закоментируйте

Код:

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

  (vl-cmdf "_.pline" BT7 "_w" 0.1 0.1 BT11 BT12 BT9 BT7 "")
	   (setq ee2 (entlast))

Эта часть пока не нужна.Это для крайних граней.

Добавлено №2

У меня угол массива (сектора)-это угол между стронами трапеции (2*mu2) умноженный на количество граней (количество трапеций) без двух крайних,т.е. ngran минус 2.
mu2-это угол между высотой трапеции и одной стороной,поэтому я mu2 умножаю на два.

[gomer]

угу... а какие у вас исходные данные?

Я тестировал с H1=1000 K1=500 k2=250 Udugokr=360 ngran=6 rp=5 tm=5 x=0.5

Добавлено.

Я не исключаю и мат ошибку,но это мало вероятно.Хотя не знаю.

[gomer]

Померяйте расстояния от точек граней до центра развертки (базовой точки)... они не равны... в этом случае развертка и не сойдется идеально

даже так:

Код:

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

 (setq massiv1 (vla-arraypolar
			   obj
			   (- ngran 2)
			   (* (- (angle bt bt10) (angle bt bt9)) (- ngran 3))
			   (vlax-3d-point BT)
			 ) ;_ конец vla-arraypolar
	   ) ;_ конец setq

Ммдауж.

gomer,спасибо

А почему такое получается.Углыже равны

Хотя и углы не равны

Но почему.Ведь прорисовываю с поворотом на один и тотже угол верхнее и нижние основания.

Код:

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

 BT7		  (polar BT (* 1.5 pi) Sh)
		 BT8		  (polar BT7 (+ (* 2 pi) mu2) l2osngran)
		 BT9		  (polar BT7 (* 1.5 pi) Lrebra)
		 BT10		  (polar BT9 (+ (* 2 pi) mu2) L1osngran)

Гдето здесь видимо.


Решение,но 0.3 мм погрешность

Код:

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

 (defun c:razvertka ()
  (setq	H1	(getreal "\n Введите высоту элемента конструкции H1=")
	K1	(getreal
		  "\n Введите размер между внутренними поверхностями граней нижнего основания (диаметр для конуса) K1="
		) ;_ конец getreal
	k2	(getreal
		  "\n Введите размер между внутренними поверхностями граней верхнего основания (диаметр для конуса) k2="
		) ;_ конец getreal
	Udugokr	(getreal
		  "\n Введите в градусах значение угла дуги подлежащей развёртыванию Udugokr="
		) ;_ конец getreal
	ngran	(getint
		  "\n Введите количество граней элемента конструкции ngran="
		) ;_ конец getint
	rp	(getreal "\n Введите радиус инструмента (пуансона) rp=")
	tm	(getreal "\n Введите толщину изгибаемого материала tm= ")
	x	(getreal "\n Введите значение коэффициента изгиба x= ")
	BT	(getpoint
		  "\n Введите координаты базовой точки: [можно мышкой] "
		) ;_ конец getpoint
  ) ;_ конец setq
  (if (= 0 ngran)
    (progn (setq alfaradian (/ (* pi Udugokr) 180)
		 KK1	    (- K1 (* 2 (* tm (- 1 x))))
		 kk2	    (- k2 (* 2 (* tm (- 1 x))))
		 Ldug	    (* (* 0.5 kk2) alfaradian)
		 betta1	    (atan (/ (- KK1 kk2) (* 2 H1)))
		 r2	    (/ (* 0.5 kk2) (sin betta1))
		 R1	    (/ (* 0.5 KK1) (sin betta1))
		 betta2	    (* 0.5 (/ Ldug r2))
		 BT1	    (polar BT (- (* 1.5 pi) betta2) r2)
		 BT2	    (polar BT (* 1.5 pi) r2)
		 BT3	    (polar BT (+ (* 1.5 pi) betta2) r2)
		 BT4	    (polar BT (- (* 1.5 pi) betta2) R1)
		 BT5	    (polar BT (* 1.5 pi) R1)
		 BT6	    (polar BT (+ (* 1.5 pi) betta2) R1)
	   ) ;_ конец setq
	   (vl-cmdf "_.ARC" BT1 BT2 BT3 "_.ARC" BT4 BT5 BT6)
	   (vl-cmdf "_.line" BT1 BT4 "")
	   (vl-cmdf "_.line" BT3 BT6 "")
	   (vl-cmdf "_.zoom" "_E")
    ) ;_ конец command
    (progn (setq Y1		  (/ 360.0 (* 2.0 ngran))
		 Y1rad		  (/ (* Y1 pi) 180.0)
		 SS1		  (- K1 (* 2.0 (* tm (- 1 x))))
		 ss2		  (- k2 (* 2.0 (* tm (- 1 x))))
		 Rgib		  (+ rp (* tm x))
		 ost		  (- (/ Rgib (cos Y1rad)) Rgib)
		 Y2rad		  (* 2.0 Y1rad)
		 Lduggib	  (* (+ Rgib x) Y2rad)
		 Lgran1		  (- (* 2.0 (* (/ (* 0.5 SS1) (cos Y1rad)) (sin Y1rad)))
				     (* (+ rp x) Y2rad)
				  ) ;_ конец -
		 lgran2		  (- (* 2.0 (* (/ (* 0.5 ss2) (cos Y1rad)) (sin Y1rad)))
				     (* (+ rp x) Y2rad)
				  ) ;_ конец -
		 L1kraingran	  (+ Lgran1 (* 0.5 Lduggib))
		 l2kraingran	  (+ lgran2 (* 0.5 Lduggib))
		 L1osngran	  (+ Lgran1 Lduggib)
		 l2osngran	  (+ lgran2 Lduggib)
		 betta3		  (atan (/ (- SS1 ss2) (* 2.0 H1)))
		 Visotagrani	  (/ H1 (cos betta3))
		 Raznicakraingran (/ (- L1kraingran l2kraingran) 2.0)
		 Raznicaosngran	  (/ (- L1osngran l2osngran) 2.0)
		 Lrebra		  (sqrt	(+ (* Visotagrani Visotagrani)
					   (* Raznicaosngran Raznicaosngran)
					) ;_ конец +
				  )	; _
					; конец
					; sqrt
		 mu1		  (atan (/ Raznicakraingran Visotagrani))
		 mu2		  (atan (/ Raznicaosngran Visotagrani))
		 betta4		  (atan (/ (- D1 d2) (* 2.0 H1)))
		 Sh		  (/ (* 0.5 d2) (sin betta4))
		 BT7		  (polar BT (* 1.5 pi) Sh)
		 BT8		  (polar BT (+ (* 1.5 pi) (* 2 mu2)) Sh)
		 BT9		  (polar BT (* 1.5 pi) (+ Sh Lrebra))
		 BT10		  (polar BT (+ (* 1.5 pi) (* 2 mu2)) (+ Sh Lrebra))
;;;		 BT11		  (polar BT7 (- (+ pi (* 2.0 pi)) mu1) l2kraingran)
;;;		 BT12		  (polar BT9 (- (+ pi (* 2.0 pi)) mu1) L1kraingran)
	   ) ;_ конец setq
	   (vl-cmdf "_.pline" BT7 "_w" 0.1 0.1 BT8 BT10 BT9 BT7 "")
	   (setq ee1 (entlast))
;;;	   (vl-cmdf "_.pline" BT7 "_w" 0.1 0.1 BT11 BT12 BT9 BT7 "")
;;;	   (setq ee2 (entlast))
	   (setq obj (vlax-ename->vla-object ee1))
	   (setq
	     massiv1 (vla-arraypolar
		       obj
		       (- ngran 2.0)
		       (* (- (angle bt bt10) (angle bt bt9)) (- ngran 3.0))
		       (vlax-3d-point BT)
		     ) ;_ конец vla-arraypolar
	   ) ;_ конец setq
	   (vlax-safearray->list (vlax-variant-value massiv1))
	   (vl-cmdf "_.zoom" "_E")
    ) ;_ конец if
  ) ;_ конец defun  
) ;_ конец defun

[gomer]

ну вот наколдовали полтора землекопа

(- ngran 2.0)

У каждой грани есть есть ось симметрии, от нее и нужно откладывать симметрично половинки оснований

[Aminka]

Спасибо всем за ответы. Поделюсь результатами - мало ли, может кому будт интересно, хотя на форуме таких программулин наверянка уже тьма тьмущая. Ногами не бить, делала для своих скромных целей.
Это первичный вариант программки, которая чуточку упрощает работу по созданию кабельных журналов для адресных систем сигнализации.
Если будут какие комментарии и советы (кроме длины и разбиения на отдельные мелкие функции для удобочитаемости) - буду рада.



А еще у меня есть вопрос. Пыталась воспользоваться диалогом getfilеd. Решила поиграться с диалогом и вместо "Открыть" нажала "Отмена". Результат странный - лисп подвис. Почему такое может быть и чем лучше пользоваться?

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

Проверяй, что возвращет getfiled. У тебя нет этой проверки, поэтому лисп и "сошел с ума".

gomer

Вот как получается крайняя грань.Это правильно.Так и должно быть.Скриншот №1.
Но теперь я не знаю как сделать чтобы получилось как на скриншоте №2

[mix_75]

Здравствуйте! Я профан в ЛИСПЕ. У меня такая проблема: имеются два блока, в виде квадратиков с торчащими навстречу друг другу пририсованными каждому квадратику отрезками. Я рисую линию, либо полилинию от одного конца отрезка первого квадрата к концу отрезка второго. Далее, двигаю один из блоков в вертикальном направлении, причем выделяя его мышкой. Линия должна тянуться вслед блоку. Это для начала. Более сложная задача - линия должна тянуться в режиме "ortho", и "ломаться" с радиусами сама. Причем, изначально вертикальные координаты концов отрезков могут не совпадать.
Просьба: подскажите, пожалуйста, набор и последовательность функций, которыми мне гипотетически надо владеть для этой задачи. Код, пожалуйста, не пишите.

mix_75

Я тоже не опытный лиспер,но хочу поделиться рекомендациями,которые мне в своё время дал Кулик Алексей aka kpblc.Он посоветовал книгу AutoLISP и Visual LISP в среде AutoCAD.Автор Н.Полещук.Я не знаю какими сегодня можно обзавестись книгами.Я эту купл в 2006 году.
Заказывал в интернет магазине OZON.

[mix_75]

Да, такая книжка у меня имеется.

[gomer]

Сообщение от Владимир Егорьев Но теперь я не знаю как сделать чтобы получилось как на скриншоте №2

хм, судя по картинкам нужно зеркалить vla-Mirror относительно оси симметрии, как я понимаю она может быть либо на оси средней грани, либо на ребре граней, если их четное количество. Полярный массив не подойдет, ибо крайняя грань смещена относительно центра

gomer

А как-нибудь виртуальную биссектрису угла можно сделать,аналогично виртуальной точки BT?

[gomer]

Сообщение от Владимир Егорьев А как-нибудь виртуальную биссектрису угла можно сделать,аналогично виртуальной точки BT?

Для этого нужно вычислить виртуальный угол

Нет,ну это безусловно.А вот как задать виртуальную биссектрису относительно которой зеркалить?Или нарисовать линию с последующим её удалением?

Добавлено.

Угол то будет как раз между левой стороной первой основной грани и правой стороной последней основной грани.Отсчёт граней соответственно слева направо.

[gomer]

ну так сложите эти углы и разделите на два это будет нужный угол, расстояние любое больше нуля

[Елпанов Евгений]

Сообщение от gomer ну так сложите эти углы и разделите на два это будет нужный угол, расстояние любое больше нуля

Советую быть по аккуратнее с такими кодами! Допустим один угол равен 350 градусов, а второй 10. В данном случае, нужно получить угол без направления, в общем случае, все может быть сложнее...

[gomer]

Сообщение от Елпанов Евгений Советую быть по аккуратнее с такими кодами!

ну, так есть же еще опорные точки

Елпанов Евгений & gomer

Если я правильно понял Елпанов Евгений-он обратил внимание на то что алгоритм кода не исключает возможностей вводить в качестве исходных данных углы отличные от 360 градусов,которые подразумевают не только отрисовку развёрток закмкнутого многогранного профиля.
Это качественное замечание если я его всё таки правильно понял.
Действительно я предпологал ещё и этим же кодом выполнять развёртки так называемых обечаек из которых будут собираться замкнуты профиля.
Но я пока до этого не дошёл.

[Елпанов Евгений]

я только хотел показать:
(350 + 10) / 2 = 180
но если нарисовать две линии, одна под углом 350, а другая 10 градусов, то луч - вектор, будет направлен под углом 0 градусов.
Другими словами, в некоторых случаях, результат выдает угол для обратного вектора.

Подобная ошибка, очень часто сильно выматывает начинающих программистов - есть код, он почти всегда работает верно, но иногда дает совершенно не верные результаты. Ошибка в сравнении углов или получении направления (угла), после простейших математических действий не вызывающих сомнений!

[gomer]

Ошибка в сравнении углов или получении направления (угла), после простейших математических действий не вызывающих сомнений!

ну, да... тут подход индивидуальный...

Елпанов Евгений

Вы извините,но я не очень Вас понял.

Хотя.....
Вот появились первые признаки неправильности mirrora.Возможно это то что вы описывали.

[Елпанов Евгений]

Сообщение от Владимир Егорьев Вы извините,но я не очень Вас понял.

нарисовал, как смог...

180 не равно 0

Елпанов Евгений

Вы меня предостерегаите о том что угол в 10 градусов по часовой стрелки от оси Х-это ни есть 10 градусов,а 350?

[gomer]

как есть 24часовая система отсчета времени и 12часовая так и здесь нужно приводить все к диапазону [-пи +пи] тогда разногласий не возникнет...

gomer

Соответственно

Будем считать что я понял мысль Елпанов Евгений

[Елпанов Евгений]

пример задачи:

Код:

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

;; есть треугольник A B C
;; необходимо найти точку P
;; лежащую от вершины B на расстоянии 1 мм
;; и равноудаленную от сторон AB AC
;; есть треугольник A B C
;; необходимо найти точку P
;; лежащую от вершины B на расстоянии 1 мм
;; и равноудаленную от сторон AB AC

;; решение приведеным выше алгоритмом:
(defun test (a b c)
 (mapcar '(lambda (a b) (entmakex (list '(0 . "line") (cons 10 a) (cons 11 b))))
         (list a b c)
         (list b c a)
 )
 (entmakex (list '(0 . "point") (cons 10 (polar b (/ (+ (angle b a) (angle b c)) 2.) 1.))))
)

(test '(0 0) '(5 5)'(5 -5)) ;; точка внутри треугольника

(test '(5 5) '(0 0)'(5 -5)) ;; точка снаружи треугольника

[Ubivec81]

Здравствуйте!
Раз уж тут тема для чайников может кто то научит строить полилинию по списку? Везде где читал есть коды для этого но хочется понять как все это устроено. Скажем так: у меня есть список "i" с элементами типа ((100.0 10.0) (110.0 12.0) (120.0 13.0)) нужно нарисовать полилинию через три точки не замкнув ее. количество элементов в списке может меняться в зависимости от того сколько их будет вводить пользователь. Если есть возможность то в объяснении не применять "VL".

[TararykovDG]

Сообщение от Ubivec81 Здравствуйте! Раз уж тут тема для чайников может кто то научит строить полилинию по списку? Везде где читал есть коды для этого но хочется понять как все это устроено. Скажем так: у меня есть список "i" с элементами типа ((100.0 10.0) (110.0 12.0) (120.0 13.0)) нужно нарисовать полилинию через три точки не замкнув ее. количество элементов в списке может меняться в зависимости от того сколько их будет вводить пользователь. Если есть возможность то в объяснении не применять "VL".

Код:

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

 
(setq i (list '(100.0 10.0) '(110.0 12.0) '(120.0 13.0)))
(apply 'command (append (list "_.pline") i (list "")))

или так

Код:

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

 
(setq i (list '(100.0 10.0) '(110.0 12.0) '(120.0 13.0)))
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length i))) (mapcar '(lambda(x) (cons 10 x)) i)))

[Ubivec81]

TararykovDG, а как насчет научить?:-)
Все заработало отлично именно так как я хотел! но честно говоря сидел и разбирал код в первом примере и никак не могу своими мозгами дойти как это понять ....

Код:

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

 (apply 'command (append (list "_.pline") i (list "")))

вот это в целом я понял , НО если глядеть на него целиком а если рассмотреть

Код:

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

 (append (list "_.pline") i (list ""))

то тут я ни как не пойму что за запись. То что это сливание в один список понятно, но как туда попадают и что делают "List" "_.Pline" и ч то такое (list "") я понять не могу! Прошу пояснения.

[alex8888]

Прошу пояснения

Команда pline с клавиатуры работает примерно так: _pline точка1 точка2 .... точкаN "", где последние кавычки обозначают, что больше точек нет и можно завершить выполнение команды.
Append собирает в список последовательность для команды pline, т.е получаем тоже, что и выше но в виде списка.
Apply заставляет применить функцию (у нас это Command) к списку, который был получен выше.

[Ubivec81]

alex8888, а list тут зачем да при чем 2 раза?

[alex8888]

С помощью list мы даем указание на то, что все, что стоит после него считается списком. Не беда, что это всего лишь название команды или двойные кавычки. В целом получится именно тот список, что нам нужен.
Если бы в условии было определенное количество точек для полилинии, то выражение упростилось бы до одного list, хотя там вообще все будет просто и без наворотов типа append и apply.

[Ubivec81]

Честно Говоря не совсем понятно. "Список команды" - как то в голове не укладывается! Тогда подскажите а вставка на чертеж текста значения какой то переменной тоже будет таким методом? Если да то как?

[alex8888]

Для вставки текста значения нужно будет само значение перевести в строку, смотри команды itoa, rtos
Типа так:
(command "_text" точка_вставки_текста "высота_текста" "угол_поворота_текста" (rtos text))
где вместо слов в кавычках подставляешь нужные величины - "100" например для высоты текста, "0" - 0 градусов - угол поворота текста, точка вставки может быть получена так: (getpoint "Укажите точку вставки текста")

[Ubivec81]

(command "_.dtext" (list (+ (* (car (car r)) 10) 1.25) -85) 2.5 90 (rtos x 2 0))
не работает. Она просит вводить данные вручную хотя отдельно (rtos x 2 0) выдает правельно. есть ощущение что все это далжно как то делаться через entget и entlast.

[alex8888]

Возьми просто команду _text
Она сработает

Вместо (car (car r)) можно (caar r) использовать - эффект тот же

[Ubivec81]

Да заработала. А в чем разница между dtext и text? вроде все точно так же рисуется...

[alex8888]

По dtext смотри тут:
http://www.itstan.ru/autocad/sozdani...nde-dtext.html
Как я понял dtext -динамический текст, который может создавать многострочные тексты, но не как mtext. А простой text - он и в Африке текст. Просто примитив типа текст.

[mix_75]

А мне тоже помогите, плиз.

[Лиспер]

В чем помочь-то?

[mix_75]

Сообщение от mix_75 Здравствуйте! Я профан в ЛИСПЕ. У меня такая проблема: имеются два блока, в виде квадратиков с торчащими навстречу друг другу пририсованными каждому квадратику отрезками. Я рисую линию, либо полилинию от одного конца отрезка первого квадрата к концу отрезка второго. Далее, двигаю один из блоков в вертикальном направлении, причем выделяя его мышкой. Линия должна тянуться вслед блоку. Это для начала. Более сложная задача - линия должна тянуться в режиме "ortho", и "ломаться" с радиусами сама. Причем, изначально вертикальные координаты концов отрезков могут не совпадать. Просьба: подскажите, пожалуйста, набор и последовательность функций, которыми мне гипотетически надо владеть для этой задачи. Код, пожалуйста, не пишите.

вот в этом. Пост #1496

[Лиспер]

На лиспе замучаешься делать. Бери в руки ElectiCS, или AutoCAD Electrical, или Visio - и вперед. В "чистом" AutoCAD подобное реализовать ИМХО будет весьма трудно.
А так - смотри объектные реакторы, расширенные данные или словари, командные реакторы и т.п.

[Ubivec81]

А вот еще вопрос с которым никак не могу разобраться!

Код:

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

 

(initget (+ 2 4))
              (setq X (getreal"\nПикет<Пустой ввод конец ввода>-"))
          
          (if (and (/= x nil) (= (car (member x piket)) nil)) (setq piket (cons x piket))
                   ;Если X не равен nil и его значения нет в списке piket то добавить значение X в список PIKET
          );_End IF
          (if (= (car (member x piket)) nil) (***); Если значение X есть в списке PIKET то нужно (***) повторить ввод занова
           )

А вот как это реализовать никак не пойму!!! Прошу помочь!

[TararykovDG]

Код:

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

 
(while (setq X (getreal"\nПикет<Пустой ввод конец ввода>-"))
    (if (not (member x piket))
      (setq piket (cons x piket))
      (princ "Этот пикет уже задан. Повторите ввод!!!")
      )
    )

[Do$]

TararykovDG, INITGET потерял

Код:

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

 (while (and (setq X (progn (initget 6 "Выход _Exit")
               (getreal "\nПикет[Выход]:")
            ) ;_ end of progn
        ) ;_ end of setq
        (/= X "Exit")
       ) ;_ end of and
  (if (not (member x piket))
    (setq piket (cons x piket))
    (princ "Этот пикет уже задан. Повторите ввод!!!")
  ) ;_ end of if
) ;_ end of while

[Ubivec81]

Код:

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

 (while (/= x nil)
	          (setq X (getreal"\nПикет<Пустой ввод: окончание>-"))
		  
                 (while (/= (member x piket) nil)                                 ;Контроль
		            (princ "Этот пикет уже задан. Повторите ввод!!!")     ;ввода
		            (setq X (getreal"\nПикет<Пустой ввод: окончание>-"))  ;
		                                                                 ;
		 );Конец WHILE                                                    ;
		 (if (and (/= x nil) (= (member x piket) nil))                    ;дублирующих
		     (setq piket (cons x piket))                                  ;пикетов
		  );конец IF

Вот что у меня получилось на основе ваших подсказок. ОГРОМНОЕ спасибо!

[Do$]

Жуть

[Ubivec81]

Почему жуть? может что подскажите?

[TararykovDG]

Сообщение от Do$ TararykovDG, INITGET потерял

Do$, спасибо за верное замечание

Сообщение от Ubivec81 Почему жуть? может что подскажите?

Ubivec81, просто раpбери и стравни свой код и код Do$. Задача-то элементарная, я понимаю, что Ты наверное еще не особо усвоил лисп (впрочем как и я), но все-таки посмотри чем оличается Твой вариант решения от других (начни хотябы с того что у Тебя два цикла while, а у других он один + не нужные проверки на равенсто nil и т. д. и т. п.)

[gomer]

Сообщение от TararykovDG спасибо за верное замечание

Неверное замечание! Do$, вот если б вы добавили единичку к инитгету... тогда было б верное...

[TararykovDG]

Сообщение от gomer если б вы добавили единичку к инитгету...

gomer я не понял, зачем единица в initget, наоборот нужно оставить возможность пустого ввода, по нему и проиходит выход иначе цикл будет быконечным.

[gomer]

Сообщение от TararykovDG иначе цикл будет быконечным

вот тогда и нужно выводить выход в опции как у Do$, но это моветон в программировании интерфейсов... По хорошему... сначала (при выборе первого пикета) нужно давать юзеру возможность <Выход>а, при выборе последующих пикетов дать возможность <Завершить> выбор
как-то так:

Код:

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

 (defun GetPiketList ( / piket piket_list)
  (initget (+ 2 6))
  (if (setq piket (getreal "\nУкажите пикет <Выход>: "))
	(progn
	  (setq piket_list (cons piket '()))
	  (while (setq piket (progn (initget (+ 2 6))
							(getreal "\nУкажите пикет <Завершить>: ")))
		(if (member piket piket_list)
		  (princ "\nПикет уже задан!")
		  (setq piket_list (cons piket piket_list)))))
	(princ "\nНе выбрано ни одного пикета!"))
  piket_list)

[Do$]

Сообщение от Ubivec81 Почему жуть? может что подскажите?

TararykovDG уже объяснил, немного дополню:
В лиспе вот это (/= <выражение> nil) в функциях проверки можно заменять на просто <выражение>:
(if (/= x nil) (alert "a") (princ "b")) то же самое, что (if x (alert "a") (princ "b")).

Сообщение от gomer По хорошему... сначала (при выборе первого пикета) нужно давать юзеру возможность <Выход>а, при выборе последующих пикетов дать возможность <Завершить> выбор

Да, эта логика работы получше. У меня была цель в коде из #1533 показать более полно возможности INITGET. Ведь вместо "Выход" там можно разместить "Настройки" и другие опции. В своих же программах я, как правило, выход делаю по "холостому" нажатию Enter (потому и единичку в INITGET не ставлю) или Esc. Что лично мне сильно не нравится - это когда в коде дважды один и тот же запрос повторяется. К примеру: если в будущем придется править программу, нужно будет отыскивать все дублирующиеся запросы. Я б лучше как-то так сделал:

Код:

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

 (defun GetPiketList (/ piket piket_list)
  ;;(GetPiketList)
  (while (setq piket (progn (initget 6)
                (getreal (strcat "\nВведите пикет <"
                         (if piket_list
                           "Завершить"
                           "Выход"
                         ) ;_ end of if
                         ">: "
                     ) ;_ end of strcat
                ) ;_ end of getreal
             ) ;_ end of progn
     ) ;_ end of setq
    (if    (member piket piket_list)
      (prompt "\nПикет уже задан!")
      (setq piket_list (cons piket piket_list))
    ) ;_ end of if
  ) ;_ end of while
  (cond    (piket_list)
    ((prompt "\nНе задано ни одного пикета!"))
  ) ;_ end of cond
) ;_ end of defun

[Дима_]

Сообщение от Do$ В лиспе вот это (/= <выражение> nil) в функциях проверки можно заменять на просто <выражение>: (if (/= x nil) (princ "a") (princ "b")) то же самое, что (if x (princ "a") (princ "b")).

Я бы написал (princ (if x "a" "b"))

[Do$]

Да елы-палы Исправил.

[gomer]

Сообщение от Do$ Ведь вместо "Выход" там можно разместить "Настройки" и другие опции.

Какие такие настройки? Мы выбираем пикеты... все... Вообще лучше в данном случае применить диалог... вдруг у меня плохая память.. и я ввел 1000 раз тот же самый пикет...

[Do$]

Я вставил initget и добавил в него ключевое слово, просто для примера - показать, что есть такая возможность. Чтобы подчеркнуть важность этой функции. Что ее очень полезно использовать перед вызовом get-функций. В ключевых словах может быть все что угодно: выход, настройки, последнее значение, удаление последнего введеного значения, очистка списка и ввод сначала, показать промежуточный список и пр... Словом, на что фантазии хватит. И не так уж важно: выбираем мы пикеты (точнее, не выбираем, а вводим) иль еще что-то делаем. Человек только учится программировать на автолиспе, возможно он не знает о такой возможности, потому я и показал ее, так как считаю ее очень полезной.

Сообщение от gomer вдруг у меня плохая память.. и я ввел 1000 раз тот же самый пикет...

Память надо развивать, или лечить (в зависимости от обстоятельств). Но даже на такой запущенный случай в коде уже есть соответствующая проверка введеного значения на нахождение в списке. Программа 1000 раз выдаст подсказку "Пикет уже задан!".

[Ubivec81]

TararykovDG,

Сообщение от TararykovDG я понимаю, что Ты наверное еще не особо усвоил лисп

Да я только начал все это постигать потому пишу как моей практики и ума хватает. Спасибо за помощь.
Вот только тут немного задача усложнилась:

Код:

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

 (setq X (+(*(getreal"\nПикет<Выход>-")10) (/(getreal "\nПлюс-")10)))

С вашим кодом Do$, я разобрался и понял что раньше просто не знал про эти связки, но прошу помочь все это применить к выше изложенному... Тут у меня при нажатии пустого ввода выходит что нету расчета X и программа на этом останавливается! Жду разъяснений.

[gomer]

Сообщение от Do$ Я вставил initget и добавил в него ключевое слово, просто для примера - показать, что есть такая возможность. Чтобы подчеркнуть важность этой функции. Что ее очень полезно использовать перед вызовом get-функций. В ключевых словах может быть все что угодно: выход, настройки, последнее значение, удаление последнего введеного значения, очистка списка и ввод сначала, показать промежуточный список и пр...

я ж говорю диалог...

Сообщение от Do$ Программа 1000 раз выдаст подсказку "Пикет уже задан!".

я говорю об отсутствии наглядности процесса...
код в #1541 на вид уж совсем оптимальный... и с точки зрения программиста и с точки зрения юзер... одно но... небольшая логическая ошибка... только выйти юзер может только первый раз, когда уже выбран хотя бы один пикет, можно либо выйти, либо завершить... По правилам хорошего тона Выход нужно перенести в опции, а Завершить оставить по умолчанию...
зы.. никаких промежуточных вычислений... ввел данные - считай, рисуй... не ввел... жуй кофе...

[Ubivec81]

Я жутко извиняюсь. Но сейчас пытался как то все то что вы советовали применить на практике и понял что никак не пойму как это работатет

Код:

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

 (setq piket (progn (initget 6)
04	                (getreal (strcat "\nВведите пикет <"
05	                         (if piket_list
06	                           "Завершить"
07	                           "Выход"
08	                         ) ;_ end of if
09	                         ">: "
10	                     ) ;_ end of strcat
11	                ) ;_ end of getreal
12	             ) ;_ end of progn
13	     ) ;_ end of setq

можно на пальцах? лучше с расшифровкой по строкам! не понятно что есть "IF PIKET_LIST"это как читать??? и куда "Выход" девается при запуске кода?

[Do$]

Сообщение от Ubivec81 Жду разъяснений.

Да тут разъяснять нечего - при пустом вводе getreal возвращает nil, а математические функции * и / в качестве аргументов принимают только числа. А тут им nil подсовывают. Они дико обижаются и выдают ошибку
Тут надо сперва получить оба значения, потом их проверить, и, если оба являются числом (есть такая полезная функция numberp), проводить математические операции.
Как-то так:

Код:

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

 (if (numberp
      (setq x (progn (initget 4) (getreal "\nПикет<Выход>:")))
    ) ;_ end of numberp
  (if (numberp
    (setq y (progn (initget 6) (getreal "\nПлюс<Выход>:")))
      ) ;_ end of numberp
    (setq x (+ (* x 10.0) (/ y 10)))
  ) ;_ end of if
) ;_ end of if

Сообщение от Ubivec81 не понятно что есть "IF PIKET_LIST"это как читать???

С лиспа это переводится так: "если piket_list не является пустым списком (nil) ..."
Код, надеюсь, пишешь во VLIDE? Если так, то в нем можно выражения отдельно запускать и смотреть, что будет получаться. Благодаря Кулик Алексею, об этом можно довольно доступно почитать тут http://autolisp.ru/category/ide/
Выражение (if piket_list "Завершить" "Выход") вернет строку "Завершить", если список piket_list непустой или "Выход", если наоборот.

[alex8888]

что есть "IF PIKET_LIST"

,
Если список с именем piket_list уже есть, то выполняется выражение "Завершить", если его нет, то "Выход".
Здесь показана синтаксическая запись оператора if:
(if <условие> <выражение1> <выражение2>)
Если условие истинно, то выполняется выражение1, если ложно - то выражение2.
Поскольку при первом вызове список пикетов еще не создан, то можно выйти из программы - поэтому написан Выход,
когда список из пикетов уже есть и заполняется(-нен), то программу можно завершить - написано Завершить.

[Дима_]

Сообщение от Do$ С лиспа это переводится так: "если piket_list не является пустым списком (nil) ..."

Опять я влезаю (nil) это не пустой список, а волне себе список с пустым списком внутри - пустой список это nil либо () либо '().

[Ubivec81]

Do$,

Сообщение от Do$ Да тут разъяснять нечего - при пустом вводе getreal возвращает nil, а математические функции * и / в качестве аргументов принимают только числа. А тут им nil подсовывают. Они дико обижаются и выдают ошибку

Это я и сам понял, только не сообразил как все это провернуть. Спасибо за совет! помогло и вот что получилось

Код:

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

 (setq x t)
(while (/= x nil) (if (numberp
      (setq x (progn (initget 4) (getreal "\nПикет<Выход>:")))
    ) ;_ end of numberp
  (if (numberp
    (setq y (progn (initget 4) (getreal "\nПлюс<Выход>:")))
      ) ;_ end of numberp
    (setq x (+ (* x 10.0) (/ y 10)))
  ) ;_ end of if
) ;_ end of if
(if (/= x nil)
(setq w (cons x w))
)
)

Но остается вопрос: в последнем IF в моем коде можно как то по другому без nil? если просто писать

Код:

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

 (setq w (cons x w))

то в результате появляется список

(110.0 105.0 100.0 nil 127.0 120.0 110.0 105.0 100.0 nil 101.0 nil 105.0 101.0)

что ни есть ХОРОШО!

[gomer]

Сообщение от Ubivec81 что ни есть ХОРОШО!

это очень не хорошо...
для кого #1541??????????????????????????????????????

[Ubivec81]

Код:

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

 (defun GetPiketList (/ piket piket_list)
	  ;;(GetPiketList)
	  (while (setq piket (progn (initget 6);цикл ввода данных пользователем
	                (getreal (strcat "\nВведите пикет <"
	                         (if piket_list; Если piket_list не имеет элементов то
	                           "Завершить";Введите пикет <Завершить>:
	                           "Выход";Иначе Введите пикет <Выход>:
	                         ) ;_ end of if
	                         ">: "
	                     ) ;_ end of strcat
	                ) ;_ end of getreal
	             ) ;_ end of progn
	     ) ;_ end of setq
	    (if    (member piket piket_list); если значение элемента в списке piket_list уже есть
	      (prompt "\nПикет уже задан!");то это сообщение и пользователь вводит занова
	      (setq piket_list (cons piket piket_list));Значение пикета добавляется в список piket_list
	    ) ;_ end of if
	  ) ;_ end of while
	  (cond    (piket_list); при условии что piket_list пуст
	    ((prompt "\nНе задано ни одного пикета!"));это сообщение
	  ) ;_ end of cond
	) ;_ end of defun

вот так я это понимаю! но в случае с заплюсовкой если с nil не сравнивать то в список добавляется nil то есть пустой элемент списка.

[Лиспер]

Может, стоит ввести дополнительную проверку?

Код:

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

 (defun get-picket (/ picket lst)
  (while (= (type (setq picket (vl-catch-all-apply
                                 (function
                                   (lambda ()
                                     (initget 6)
                                     (getreal (strcat "\nВведите пикет <"
                                                      (if lst
                                                        "Завершить"
                                                        "Выход"
                                                        ) ;_ end of if
                                                      ">: "
                                                      ) ;_ end of strcat
                                              ) ;_ end of getreal
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                 ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'real
            ) ;_ end of =
    (if (member picket lst)
      (princ "\nПикет уже задан!")
      (setq lst (cons picket lst))
      ) ;_ end of if
    ) ;_ end of while
  lst
  )

P.S. Код не проверял.

[gomer]

Сообщение от Лиспер Может, стоит ввести дополнительную проверку?

Да не нужна тут проверка... Опций нет, проверять нечего... Считаю свой код в #1540 наиболее адекватным...

[Лиспер]

Даже на нажатие Esc корректно сработает?

[Do$]

Сообщение от Ubivec81 Но остается вопрос: в последнем IF в моем коде можно как то по другому без nil?

Это исходный код:

Код:

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

  (setq x t)
(while (/= x nil) (if (numberp
      (setq x (progn (initget 4) (getreal "\nПикет<Выход>:")))
    ) ;_ end of numberp
  (if (numberp
    (setq y (progn (initget 4) (getreal "\nПлюс<Выход>:")))
      ) ;_ end of numberp
    (setq x (+ (* x 10.0) (/ y 10)))
  ) ;_ end of if
) ;_ end of if
(if (/= x nil)
(setq w (cons x w))
)
)

Тут хромает логика. Смотри что получается: проверка x на nil и формирование результирующего списка стоит вне двух проверок вводимых значений. Попробуй вводить только X, а Y не вводить - список все равно будет формироваться. Плюс к тому, пустой ввод во втором запросе к выходу из цикла не приведет. Исправляем:

Код:

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

 
(while (and (numberp
       (setq x (progn (initget 4) (getreal "\nПикет<Выход>:")))
     ) ;_ end of numberp
     (numberp
       (setq y (progn (initget 4) (getreal "\nПлюс<Выход>:")))
     ) ;_ end of numberp
       ) ;_ end of and
  (setq w (cons (+ (* x 10.0) (/ y 10)) w))
) ;_ end of while

Код:

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

 ;;;Поэтапная модернизация кода:
;;;Этап1: убираем проверки вида (/= x nil)
(setq x t)
(while x (if (numberp ;просто x вместо (/= x nil)
      (setq x (progn (initget 4) (getreal "\nПикет<Выход>:")))
    ) ;_ end of numberp
  (if (numberp
    (setq y (progn (initget 4) (getreal "\nПлюс<Выход>:")))
      ) ;_ end of numberp
    (setq x (+ (* x 10.0) (/ y 10)))
  ) ;_ end of if
) ;_ end of if
(if x ;просто x вместо (/= x nil)
(setq w (cons x w))
)
)
 
;;;Этап2: Переносим формирование списка внутрь 2-х if
(setq x t)
(while x (if (numberp
      (setq x (progn (initget 4) (getreal "\nПикет<Выход>:")))
    ) ;_ end of numberp
  (if (numberp
    (setq y (progn (initget 4) (getreal "\nПлюс<Выход>:")))
      ) ;_ end of numberp
    (progn ;;Добавляем progn, так как у нас 2 функции в одном аргументе if
    (setq x (+ (* x 10.0) (/ y 10)))
    ;;Теперь эта проверка не нужна (if x
    (setq w (cons x w))
    ;;)
    )
  ) ;_ end of if
) ;_ end of if
;;Здесь было формирование списка
  w ;Добавляем, чтобы при завершении цикла возвращался список
)
 
;;;Этап3: Убираем лишние присвоения значений
(setq x t)
(while x (if (numberp
      (setq x (progn (initget 4) (getreal "\nПикет<Выход>:")))
    ) ;_ end of numberp
  (if (numberp
    (setq y (progn (initget 4) (getreal "\nПлюс<Выход>:")))
      ) ;_ end of numberp
    ;;Вместо всего того, что ниже:
    ;;(progn
    ;;(setq x (+ (* x 10.0) (/ y 10)))
    ;;(setq w (cons x w))
    ;;Пишем такую строку:
    (setq w (cons (+ (* x 10.0) (/ y 10)) w))
    ;;)
  ) ;_ end of if
) ;_ end of if
  w
)
 
;;;Этап4: Изменяем условие while таким образом, чтобы пустой ввод второго
;;;      значения тоже приводил к завершению цикла
;;(setq x t) теперь это лишнее
(while (if (numberp ;Тут просто убираем x
      (setq x (progn (initget 4) (getreal "\nПикет<Выход>:")))
    ) ;_ end of numberp
  (if (numberp
    (setq y (progn (initget 4) (getreal "\nПлюс<Выход>:")))
      ) ;_ end of numberp
    (setq w (cons (+ (* x 10.0) (/ y 10)) w))    
  ) ;_ end of if
) ;_ end of if
  w
)
 
;;Этап5: Убираем if, т.к. если мы используем while, они не особо-то нужны
(while (and (numberp
       (setq x (progn (initget 4) (getreal "\nПикет<Выход>:")))
     ) ;_ end of numberp
     (numberp
       (setq y (progn (initget 4) (getreal "\nПлюс<Выход>:")))
     ) ;_ end of numberp
       ) ;_ end of and
  (setq w (cons (+ (* x 10.0) (/ y 10)) w))
) ;_ end of while

P.S. В этом конкретном случае, когда мы не задаем ключевых слов в initget, getreal может вернуть либо nil, либо число. Поэтому, проще проверять на nil, а проверку на число убрать. В итоге получается такая простая конструкция:

Код:

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

 
(while (and 
       (setq x (progn (initget 4) (getreal "\nПикет<Выход>:")))     
       (setq y (progn (initget 4) (getreal "\nПлюс<Выход>:")))     
       ) ;_ end of and
  (setq w (cons (+ (* x 10.0) (/ y 10)) w))
) ;_ end of while

[gomer]

Сообщение от Лиспер Даже на нажатие Esc корректно сработает?

Сработает, если обработчик ошибок создать на стадии инициализации...

[Ubivec81]

Доброго времени суток! Нужно рисовать вручную полилинию в цикле при чем каждый раз проходящую через разное количество точек. в дальнейшем нужна будет площадь этой полилинии, но это я уже разобрался как сделать а вот полилинию вручную в код поставить не получается!
Прошу помощи.

[TararykovDG]

Сообщение от Ubivec81 Нужно рисовать вручную полилинию в цикле при чем каждый раз проходящую через разное количество точек. в дальнейшем нужна будет площадь этой полилинии, но это я уже разобрался как сделать а вот полилинию вручную в код поставить не получается! Прошу помощи.

Код:

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

 
(defun manual-draw-pline()
  (vl-cmdf "_.pline")
  (while (= (getvar "CMDACTIVE") 1) (vl-cmdf pause))
  (entlast)
  ); end manual-draw-pline

В своем цикле вызывай (manual-draw-pline)

[Ubivec81]

надо поглядеть что такое vl-cmdf

[gomer]

Сообщение от Ubivec81 Нужно рисовать вручную полилинию в цикле при чем каждый раз проходящую через разное количество точек.

Код:

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

 (defun draw_pline (lst / templst)
;;; Добавляет 3М полилнию
;;;(draw_pline (list '(0 0) '(100 200) '(300 300 300)))
  (vla-AddPolyline
	(vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object))))
	(vlax-safearray-fill
	  (vlax-make-safearray
		vlax-vbDouble
		(vl-list* 0 (1- (length (setq templst
		  (apply 'append (mapcar (function
			(lambda (x)
			  (cond
				((= 2 (length x)) (list (car x) (cadr x) 0.0))
				(T x))))
			  lst)))))))
	  templst
	)
  )
)

(defun draw_lpline (lst / templst)
;;; Добавляет легкую полилнию
;;;(draw_lpline (list '(0 0) '(100 200) '(300 300 300)))
  (vla-AddLightWeightPolyline
	(vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object))))
	(vlax-safearray-fill
	  (vlax-make-safearray
		vlax-vbDouble
		(vl-list* 0 (1- (length (setq templst
		  (apply 'append (mapcar (function
			(lambda (x)
			  (cond
				((= 3 (length x)) (reverse (cdr (reverse x))))
				(T x))))
			  lst)))))))
	  templst
	)
  )
)

[Ubivec81]

Сообщение от Дима_ Код: (vl-load-com) (defun maketable (pt nr nc rh cw) (vla-addtable (vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'Modelspace) (vlax-3d-point pt) nr nc rh cw );end of addtable );end of maketable Запускать (maketable точка_вставки количество_сток количество_колнок высота_строки ширина_колонки) например (maketable (getpoint) 5 5 5 5)

А можно все это растолковать на пальцах. Что то не получается мозгу без помощи опытных людей освоить vl
В этом коде понятно что
vla-addtable
создается таблица с переменными (pt nr nc rh cw)
А вот дальше темный лес
(vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'Modelspace)
(vlax-3d-point pt)
Прощу помощи в изучении vl и по возможности с самого начала!

[Дима_]

Сообщение от Ubivec81 создается таблица с переменными (pt nr nc rh cw)

с какими еще переменными - это параметры таблицы, "Темный лес" - описан в справке автокада - это встроенные лисп функции, справку по объектной модели - см. справку по VB (парадокс - vb уже нету - а справка осталась ). Как вызывать COM методы (vl-...) из lisp - поищи по форуму - где-то дано хорошее описание с картинками.

[Ubivec81]

Сообщение от Дима_ с какими еще переменными - это параметры таблицы, "Темный лес" - описан в справке автокада - это встроенные лисп функции, справку по объектной модели - см. справку по VB (парадокс - vb уже нету - а справка осталась ). Как вызывать COM методы (vl-...) из lisp - поищи по форуму - где-то дано хорошее описание с картинками.

Ну да я не правельно написал! конечно с параметрами. Подскажите а есть эта справка на русском языке? никак не могу найти.

[Дима_]

Если только по лисп функциям (в учебниках по автолиспу поискать), по объектной модели (да еще и полная) вряд-ли найдется.

[Disney]

Сообщение от Дима_ Как вызывать COM методы (vl-...) из lisp - поищи по форуму - где-то дано хорошее описание с картинками.

Четыре правила для работы с ActiveX в Visual Lisp

Сообщение от Ubivec81 Подскажите а есть эта справка на русском языке?

Есть AutoCAD Объектная модель

[Ubivec81]

Сообщение от Disney Четыре правила для работы с ActiveX в Visual Lisp Есть AutoCAD Объектная модель

все это сижу читаю. вроде все понятно но не могу сделать простейшего, нарисовать линию. (vl-addline....) а вот как дальше вставлять параметры я не понимаю.

[Дима_]

ну попробуй разберись:

Код:

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

 (vla-addline 
  (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object)))
  (vlax-3d-point '(0 0 0))
  (vlax-3d-point '(100 100 0)))

p.s. - с тебя два круга с однинаковыми центрами и радиусами 100 и 200 соответственно.

[Ubivec81]

Код:

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

 (vla-addline ;создать линию через 2 точки
    (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))) ;  Получает коллекцию ModelSpace документа 
;Определяет активный документ (файл рисунка), но как это перевести мне не понятно (прошу пояснить)
    (vlax-3d-point '(0 0 0));точки линии должны быть 3-х мерные но откуда берется vlax я в литературе не нашел
    (vlax-3d-point '(100 100 0)))

Все дело в том что пока я с Вашей помощью и при помощи книг разбирался с командным методом то это было как то проще, а тут я не могу все это увязать ежду собой да и литературы которая описывает все это более подробно не нашел.

[dirge]

Всем привет! Ребят подскажите, а как можно проверить определённый блок на существование в листе?

[Дима_]

Как это не странно звучит - посмотреть все объекты листа - нет-ли там вхождения нужного блока.

[Do$]

Для обычного блока, если не nil вот это выражение: (ssget "_X" '((0 . "INSERT") (2 . "<block name>") (67 . 1) (410 . "<layout name>"))), тогда блок(или блоки) с именем "<block name>" есть на листе с именем "<layout name>".
Для динамических немного сложнее будет...

[VVA]

Сообщение от Do$ Для динамических немного сложнее будет...

Для динамических есть решение от Lee-MAC

Код:

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

;;;http://www.cadtutor.net/forum/showthread.php?56447-Automatically-filling-out-the-Drawing-Property-from-Titleblock-Information&p=382978&viewfull=1#post382978
;;; http://www.cadtutor.net/forum/showthread.php?62294-Select-Dynamic-Blocks-By-Name
;; Returns list of the Anonymous names taken by a Dynamic Block (if any)  -  Lee Mac 2011  -  www.lee-mac.com
;; Arguments:  block  - name of Dynamic Block.

(defun AnonymousInstancesof ( block / def rec nme ref lst )
  (while (setq def (tblnext "BLOCK" (null def)))
    (if (= 1 (logand 1 (cdr (assoc 70 def))))
      (progn
        (setq rec
          (entget
            (cdr
              (assoc 330
                (entget
                  (tblobjname "BLOCK" (setq nme (cdr (assoc 2 def))))
                )
              )
            )
          )
        )
        (while (setq ref (assoc 331 rec))
          (if
            (and
              (eq block (vla-get-effectivename (vlax-ename->vla-object (cdr ref))))
              (not (member nme lst))
            )
            (setq lst (cons nme lst))
          )
          (setq rec (cdr (member (assoc 331 rec) rec)))
        )
      )
    )
  )
  (reverse lst)
)

(defun LM:BlockList->Str ( lst del / f )
  ;; © Lee Mac 2011

  (defun f ( s ) (if (wcmatch s "`**") (strcat "`" s) s))
  
  (if (cdr lst)
    (strcat (f (car lst)) del (LM:BlockList->Str (cdr lst) del))
    (f (car lst))
  )
)
;;; USE
;;;(setq DynBlockName "TITLEBLOCK") ;_Имя ДИНАМИЧЕСКОГО блока
;;;(setq ss
;;;(ssget "_X"
;;;(list
;;;    (cons 0 "INSERT")
;;;    (cons 2 (LM:BlockList->Str (cons DynBlockName (AnonymousInstancesof DynBlockName)) ","))
;;;(cons 66 1)
;;;  )
;;;)
;;;      )

Ф-ция AnonymousInstancesof возвращает список всех возможных имен блоков, включая не именованные, например ("MIP_Формат" "*U33" "*U41" "*U42" "*U44" "*U45")
Дальше нужно лишь сформировать строку-шаблон для ssget (2 . "MIP_Формат,`*U33,`*U41,`*U42,`*U44,`*U45"). В примере все это есть

[Disney]

Сообщение от Ubivec81 (vlax-3d-point '(0 0 0));точки линии должны быть 3-х мерные но откуда берется vlax я в литературе не нашел

я сам долго и упорно ломал мозг с этими vla, поэтому попробую...

Список это чисто LISP-овский тип данных, в VBA его нет, поэтому в ActiveX вместо списков используются варианты с безопасным массивом
(vlax-3d-point '(2.236 23.548 0.0))) - создаёт вариант из безопасного массива, который в свою очередь состоит из трёх элементов являющихся вещественными числами двойной точности.
Варианты - это структура, которая может хранить объекты разных типов. (vlax-make-variant)
Безопасный массив - массив понятно, безопасный - потому что система постоянно контролирует тип и количество элементов (vlax-make-safearray- создаёт vlax-safearray-fill - заполняет)
Т.е. получаем:
(vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 2)) '(2.236 23.548 0.0)))
получилась немного громоздкая запись, а так как довольно таки часто приходиться её использовать, создали функцию

Код:

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

 (defun vlax-3d-point (_list_)
... ; ну тут всякие проверки для _list_ 
  (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 2)) _list_)))

Если я в чём-то ошибаюсь, буду признателен если меня поправят.

[dirge]

Всем большое, спасибо!

Ребят, извините за неудобства.

Как этот код можно переписать на LISP?

Sub DwgProps()
Dim NewText1 As String
Dim NewText2 As String
Dim oFS
Dim Fold
Dim Slesh1, Slesh2, Slesh3
Dim Konec, Zona, Papka, Hvost
Set oFS = CreateObject("Scripting.FileSystemObject")
Fold = ThisDrawing.Path

Konec = Len(Fold)
Papka = "215-GMC-01-EOM2."
Slesh1 = InStr(Fold, Papka)
Hvost = Mid(Fold, Slesh1, Konec)
Slesh2 = InStr(Hvost, ".")
Slesh3 = InStr(Hvost, "\")
If Slesh3 <> 0 Then
Zona = Mid(Hvost, Slesh2 + 1, Slesh3 - Slesh2 - 1)
Else
Zona = Mid(Hvost, Slesh2 + 1, Konec - Slesh2 - 1)
End If
NewText1 = Zona
NewText2 = "Ãëàâíûé ìåäèàöåíòð ôóíêöèîíàëüíàÿ çîíà " & NewText1 & " Ýëåêòðîîáîðóäîâàíèå è ýëåêòðîîñâåùåíèå"
changeCustDwgProp ThisDrawing, "Äîïîëíèòåëüíûé Øèôð ðàçäåëà", NewText1
changeCustDwgProp ThisDrawing, "Íàèìåíîâàíèå êîìïëåêòà", NewText2

End Sub

Private Function changeCustDwgProp(docName As AcadDocument, fldName As String, newVal As String)
On Error GoTo createIt
Dim custProps As AcadSummaryInfo
Set custProps = docName.SummaryInfo
custProps.SetCustomByKey fldName, newVal
Set custProps = Nothing
Exit Function
createIt:
custProps.AddCustomInfo fldName, newVal
Set custProps = Nothing
End Function

Private Function getCustDwgProp(docName As AcadDocument, fldName As String) As String
'KEY IS CASE SENSITIVE
On Error GoTo notFound
Dim custProps As AcadSummaryInfo
Set custProps = docName.SummaryInfo
custProps.GetCustomByKey fldName, getCustDwgProp
Set custProps = Nothing
Exit Function
notFound:
getCustDwgProp = ""
Set custProps = Nothing
End Function

[Дима_]

Сообщение от dirge NewText2 = "Ãëàâíûé ìåäèàöåíòð ôóíêöèîíàëüíàÿ çîíà " & NewText1 & " Ýëåêòðîîáîðóäîâàíèå è ýëåêòðîîñâåùåíèå" changeCustDwgProp ThisDrawing, "Äîïîëíèòåëüíûé Øèôð ðàçäåëà", NewText1 changeCustDwgProp ThisDrawing, "Íàèìåíîâàíèå êîìïëåêòà", NewText2

Offtop: прям так и писать?

[dirge]

Сообщение от Дима_ Offtop: прям так и писать?

Да, можно так, я потом подставлю текст. Буду дико признателен.

[baaba]

Не совсем понятно мне. Когда мы объявляем функцию, локальные переменные функции мы должны вручную "убить", что бы освободить память. Например:
[code]

Код:

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

 (defun nfun (/ var1)
(setq var1 5)
var1
)

То есть за пределами функции переменной var1 не существует. Хорошо, но функция nfun в загруженном рисунке осталась. Цель ручной чистки переменных, как я понял - освободить память от мусора (странно, но в Common Lisp такой необходимости в ручной чистке нету, как в прочим и во многих других диалектах). Тогда почему остаются функции в памяти, после выполнения программы? Ведь они занимают больше места чем переменные.

И всё-таки, зачем "ручная" чистка переменных, это какой то атавизм (этот вопрос волнует даже больше)?

[Дима_]

Это делаеться для того, чтобы, как раз НЕ затереть возможно существующие переменную var1. Подобный вывод переменных есть во всех диалектих лиспа (и не только) - с разным синаксисом - это так называемые локальные переменные. А функция для того и объявляется чтоб она осталась в памяти - если она больше не нужна - то не надо ее и объявлять (для многоразового, но конечного числа вызывов есть lambda).

[baaba]

Сообщение от Дима_ А функция для того и объявляется чтоб она осталась в памяти - если она больше не нужна - то не надо ее и объявлять (для многоразового, но конечного числа вызывов есть lambda).

Значит с функциями злоупотреблять не надо?
А можно как то "прибить" ставшие ненужными функции?

[Дима_]

"Прибить" можно - (setq имя_функции nil), но делать так не нужно - если функция не будет нужна - не надо ее объявлять в глобальном пространстве имен (ее можно объявить локально внутри другой функции) - но повторю еще раз - в лиспе(ах - тем паче что ты про Common Lisp "заикался") для этого есть ЛЯМБДА - а про место переменных в лиспе я вобще лучше помолчу - чтоб никого не расстраивать.

[baaba]

Сообщение от Дима_ ее можно объявить локально внутри другой функции

Функция внути функции .. мм, так разве делают? А что вообще почитать про Автолисп порекомендуешь?

Сообщение от Дима_ для этого есть ЛЯМБДА - а про место переменных в лиспе я вобще лучше помолчу - чтоб никого не расстраивать.

Да, но код должен быть "читаем" (в том числе для многократного повторного использования), не должно быть "магических чисел", в ANSI C, к примеру, для этого есть константы. Я поневоле сравниваю с Си, и Коммон Лиспом, так как про них параллельно читаю. И потом в "Сапр на базе Автокад" даётся целая библиотека функций. Что эти функции то же запрятаны в какую-то одну функцию? (да, я книгу читал фрагментарно).

[Дима_]

Сообщение от baaba Я поневоле сравниваю с Си, и Коммон Лиспом, так как про них параллельно читаю.

Бросьте это дело немедленно - изучайте что-то одно и когда ХОРОШО будете разбираться, возьмитесь за другое. Это две абсолютно разные прагмиды - функциональная и императивная, статическая и динамическая. Понятия "читаемости" в Си и Лиспе радикально противоположны. Поймите правильно - у Вас сейчас "на лицо" полная каша в голове - многие хорошо знающие одно из "этих двух" другое понять не могут (там подходы реально совсем разные), а Вы хотите сразу оба "паралельно".
Что почитать по автолисп - я, честно говоря, сам толком кроме справочника autocad'а ничего не читал, но "Сапр на базе автокад" - это вроде как классика (хотя меня она так-же стороной обошла) - а рекомендовать литературу под другие диалекты не буду - т.к. они полезны для понятия принципов лиспа, но автолисп это такой "недолисп" который не имеет некоторых БАЗОВЫХ вещей современных функциональных диалектов.
p.s. своим личным "идеалом языков" считаю Scheme.

[baaba]

Сообщение от Дима_ Это две абсолютно разные прагмиды - функциональная и императивная, статическая и динамическая.

То есть Лисп - императивный, динамический, я правильно понимаю?
Совет понял - думаю сконцентрироваться на Автолисп, т. к. он ближе к работе.

[gomer]

Сообщение от baaba Функция внути функции .. мм, так разве делают?

Так делали еще в турбо паскале...

[Дима_]

Сообщение от baaba То есть Лисп - императивный, динамический, я правильно понимаю?

Нет - это я увлекся и написал в "нелогичном" порядке - лисп функциональный, динамический. Про другие "показатели" лучше сюда, хоть автолиспа там и нет (не вздумайте делать выводы о Автолисп из Комонлиспа).

Так делали еще в турбо паскале...

Более того даже в ассемблере есть "синтетический сахар" для объявления имен действующих (распознаваемых компилятором) в пределах одного (первого вышестоящего) имени (физического адреса). Там к ним правда конечно можно обратиться (все-таки это ассемблер), но вначале "четко" объявив первичный адрес.

[baaba]

Подскажите пожалуйста простой способ читать данные автолиспом из *.xls. Сейчас пользуюсь *.csv, но не очень удобно (спецификации то всё равно в Excell). Пока у меня примерно так сделано:

Код:

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

 
(setq f (open (getfiled "Select a spreadsheet file" "c:/tmp/" "csv;xls" 8) "r"))
(setq dataline (read-line f))
(close f)

Может быть есть готовая простенькая функция для высасывания данных из excell так же как и из *.csv (только что бы можно было выбирать закладку)?

[gomer]

Сообщение от baaba Подскажите пожалуйста простой способ читать данные автолиспом из *.xls. Сейчас пользуюсь *.csv, но не очень удобно (спецификации то всё равно в Excell). Пока у меня примерно так сделано:

есть и много в параллельных ветках и у Полещука пример есть... "Как у вас" не пройдет с экселевскими таблицами для них нужно иметь установленный эксель и создавать COM-связку (см. предыдущее предложение)

[Лиспер]

Offtop: Так и хочется отправиться к http://autolisp.ru/2011/06/08/functi...bility-region/

[VVA]

Сообщение от baaba Может быть есть готовая простенькая функция для высасывания данных из excell

Есть и не одна
Построение чертежа по данным Excel

[Ubivec81]

А подскажите где найти расшифровку ключей любого из примитивов?

[Oliver_88]

Сообщение от Ubivec81 А подскажите где найти расшифровку ключей любого из примитивов?

http://usa.autodesk.com/adsk/servlet...&siteID=123112

[Ubivec81]

Сообщение от Oliver_88 http://usa.autodesk.com/adsk/servlet...&siteID=123112

не получается поглядеть там! может у кого есть своя для 2009 года

[VVA]

Поиском поищи файл на C: acad_dxf.chm Для 2009 должен лежать в C:\Program Files\AutoCAD 2009\Help\acad_dxf.chm

[aleksandr1981]

В коде всё работает но нехватает внутреннего угла. Запуск кода geo_table

Код:

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

 (vl-load-com)


(defun *error* (msg)
  (princ)
)



(defun c:geo_table ()
   (initget 1 "Полилиния Точки")
   (setq x (getkword "\nПостроить ведомость по [Полилиния/Точки]: ")) 
   (if (= x "Полилиния") (ExportInExcel) (geo_point_table)) 
);_end defun



(defun geo-create-object (AppString)  
  (vlax-create-object AppString)
);_end defun






(defun geo_get_distance (pnt1 pnt2) 
   (setq pnt1 (list (car pnt1) (cadr pnt1)))
   (setq pnt2 (list (car pnt2) (cadr pnt2)))
   (distance pnt1 pnt2) 
);_end defun


(defun geo_get_angle (pnt1 pnt2) 
   (setq pnt1 (list (car pnt1) (cadr pnt1)))
   (setq pnt2 (list (car pnt2) (cadr pnt2)))
   (angle pnt1 pnt2) 
);_end defun






(defun geo-add-text (TextString InsertionPoint Height Alignment Rotation / obj)
  (if (null Alignment) (setq Alignment acAlignmentLeft))
  (setq obj (vla-addtext 
                (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))) TextString 
    (if (or (= Alignment acAlignmentAligned)  
            (= Alignment acAlignmentFit))          
        (vlax-3d-point (car InsertionPoint)) 
        (vlax-3d-point InsertionPoint)
     ) Height))
  (cond
    ((= Alignment acAlignmentLeft) (vla-put-rotation obj Rotation))
    ((or (= Alignment acAlignmentAligned)
         (= Alignment acAlignmentFit))
     (vla-put-alignment obj Alignment)
     (vla-put-textalignmentpoint obj (vlax-3d-point (cadr InsertionPoint)))
    )
    (T
      (vla-put-alignment obj Alignment)
      (vla-put-textalignmentpoint obj (vlax-3d-point InsertionPoint))
      (vla-put-rotation obj Rotation)
    )
    (vla-update obj)
  );_end cond
      
);_end defun





(defun geo-add-line (StartPoint EndPoint Lineweight / obj)
  (setq obj (vla-addline 
                (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))) 
            (vlax-3d-point StartPoint) (vlax-3d-point EndPoint)))

  (cond
    ((vlax-write-enabled-p obj)
      (if Lineweight (vla-put-lineweight obj Lineweight)) 
      (vla-update obj)
  ))         
);_end defun





(defun list-massoc (key alist)
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist))
) 



(defun pline-list-vertex (ent / list_vertex tmp_ent type_ent)
    (setq tmp_ent  ent
          ent      (entget ent)
          type_ent (cdr (assoc 0 ent))
    ) ;_ end of setq
    (cond
        ((= "LWPOLYLINE" type_ent)
         (list (list-massoc 10 ent) (= 1 (logand 1 (cdr (assoc 70 ent)))))
        )
        ((= "POLYLINE" type_ent)
         (reverse
             (cons (= 1 (logand 1 (cdr (assoc 70 ent))))
                   (while (and (setq tmp_ent (entnext tmp_ent))
                               (/= (cdr (assoc 0 (setq ent (entget tmp_ent))))
                                   "SEQEND"
                               ) ;_ end of =
                          ) ;_ end of and
                       (setq list_vertex (cons (cdr (assoc 10 ent)) list_vertex))
                   ) ;_ end of while
             ) ;_ end of cons
         ) ;_ end of reverse
        )
        ((= "LINE" type_ent)
         (list (cons (cdr (assoc 10 ent)) (cons (cdr (assoc 11 ent)) nil)) nil)
        )
        (t nil)
    ) ;_ end of cond
) ;_ end of defun



(defun ExportInExcel ()

    (setq ent (car (entsel "\nУкажите полилинию: "))) 
    (setq lst (car (pline-list-vertex ent)))
    (setq point_count (length lst))
    (setq point_number 0)
    
    
    ;(vl-load-com)
    (setq g_oex (vlax-get-or-create-object "Excel.Application"))
    (vlax-put-property g_oex 'SheetsInNewWorkbook 1)
    (vlax-put-property g_oex 'Visible :vlax-true)
    (setq g_wbs (vlax-get-property g_oex 'Workbooks))
    (setq g_cb (vlax-invoke-method g_wbs 'Add))
    (setq g_shs (vlax-get-property g_cb 'Sheets))
    (setq g_csh (vlax-get-property g_shs 'Item 1))
    (vlax-put-property g_csh 'Name "Координаты")


    (repeat point_count
       (setq pt (nth point_number lst));координаты текущей узловой точки
       (setq pt_next (nth (rem (1+ point_number) point_count) lst));координаты следующей узловой точки (по кругу)
       (setq X (car pt));координата X точки
       (setq Y (cadr pt));кооордината Y точки
       (setq X_next (car pt_next));координата X следующей точки
       (setq Y_next (cadr pt_next));координата Y следующей точки
       (setq Dist (geo_get_distance pt pt_next));расстояние между двумя координатами
       (setq Ang (geo_get_angle (list Y X) (list Y_next X_next)));угол между двумя координатами
       (setq StAng (angtos ang 1 3));Преобразовываем в строку
       (setq StAng (vl-string-subst "° " "d" StAng));Заменяем символ d(град) на символ '° '
       (setq StAng (vl-string-subst "' " "'" stang));Заменяем символ '(мин) на символ '' '    


       (setq RangeN (strcat "A" (itoa (1+ point_number))));Диапазон ячеек для номера точки
       (setq RangeX (strcat "B" (itoa (1+ point_number))));Диапазон ячеек для координаты X
       (setq RangeY (strcat "C" (itoa (1+ point_number))));Диапазон ячеек для координаты Y
       (setq RangeD (strcat "D" (itoa (1+ point_number))));Диапазон ячеек для расстояния  
       (setq RangeA (strcat "E" (itoa (1+ point_number))));Диапазон ячеек для угла        

       (setq g_r0 (vlax-get-property g_oex "Range" RangeN))
       (setq g_r1 (vlax-get-property g_oex "Range" RangeX))
       (setq g_r2 (vlax-get-property g_oex "Range" RangeY))
       (setq g_r3 (vlax-get-property g_oex "Range" RangeD))
       (setq g_r4 (vlax-get-property g_oex "Range" RangeA))

       (vlax-put-property g_r0 "value2" (1+ point_number))
       (vlax-put-property g_r1 "value2" (rtos Y 2 3))
       (vlax-put-property g_r2 "value2" (rtos X 2 3))
       (vlax-put-property g_r3 "value2" (rtos Dist 2 2))
       (vlax-put-property g_r4 "value2" StAng)

       (setq point_number (1+ point_number))
    );end of repeat
    

    (if (and g_r0 (not (vlax-object-released-p g_r0)))
        (vlax-release-object g_r0))
    
    (if (and g_r1 (not (vlax-object-released-p g_r1)))
        (vlax-release-object g_r1))
    
    (if (and g_r2 (not (vlax-object-released-p g_r2)))
        (vlax-release-object g_r2))

    (if (and g_r3 (not (vlax-object-released-p g_r3)))
        (vlax-release-object g_r3))

    (if (and g_r4 (not (vlax-object-released-p g_r4)))
        (vlax-release-object g_r4))

    (if (and g_csh (not (vlax-object-released-p g_csh)))
        (vlax-release-object g_csh))

    (if (and g_shs (not (vlax-object-released-p g_shs)))
        (vlax-release-object g_shs))

    (if (and g_cb (not (vlax-object-released-p g_cb)))
        (vlax-release-object g_cb))

    (if (and g_wbs (not (vlax-object-released-p g_wbs)))
        (vlax-release-object g_wbs))
    
    (if (and g_oex (not (vlax-object-released-p g_oex)))
        (vlax-release-object g_oex))
    ;Обнуление использованных глобальных переменных
    (setq g_r0 nil g_r1 nil  g_r2 nil g_r3 nil g_r3 nil g_csh nil g_shs nil g_cb nil g_wbs nil g_oex nil)
    ;Сборка мусора
    (gc)
    
)





(defun geo_point_table ()
  (setq pnt nil)
  (setq nline 0)
  (setq rows nil);список для всех координат типа: ((x,y,z)(x,y,z)...)
  
  ;Запрос на ввод точек
  (while 
    (setq pnt (getpoint "\nУкажите координату: "))
    (setq nline (1+ nline));увеличиваем количество строк на 1
    ;формируем список с координатами
    (setq row pnt);списку row присваеваем список pnt с координатами выбранной точки
    (setq rows (append rows (list row) ));добавляем список row c коорд. выбранной точки в список со всеми коорд. rows    
  );while  

  ;Запрос на ввод коорд. левого верхнего угла таблицы  
  (setq InsertionPoint nil)                  
  (setq InsertionPoint (getpoint "\nУкажите координаты левого верхнего угла таблицы: "))

  ;Запоминаем значения сист.переменных                   
  (setq ORT (getvar "ORTHOMODE"));ORTHO                  
  (setq SN (getvar "SNAPMODE"));SNAP                     
  (setq OSN (getvar "OSMODE"));OSNAP
  (setq DIMZ (getvar "DIMZIN"));DIMZIN
  (setq TEXT (getvar "TEXTSTYLE"));TEXTSTYLE
  (setq COLOR(getvar "CECOLOR"));CECOLOR
  ;Задаём значения сист.переменным                       
  (setvar "ORTHOMODE" 0);ORTHO                           
  (setvar "SNAPMODE" 0);SNAP                             
  (setvar "OSMODE" 0);OSNAP                              
  (setvar "DIMZIN" 0);DIMZIN
  (setvar "CECOLOR" "251");CECOLOR

  (DrawLines InsertionPoint nline);создаём линии таблицы
  (setvar "CECOLOR" COLOR);CECOLOR
  (DrawText InsertionPoint nline 2.0 rows);создаём текст в таблице

  ;возвращаем знач. сист.переменных в начальное состояние
  (setvar "ORTHOMODE" ORT);ORTHO                         
  (setvar "SNAPMODE" SN);SNAP                            
  (setvar "OSMODE" OSN);OSNAP                            
  (setvar "DIMZIN" DIMZ);DIMZIN
  (setvar "TEXTSTYLE" TEXT);TEXTSTYLE

);_end defun geo-draw-table



(
defun DrawLines(InsertionPoint nline)
  ;InsertionPoint - точка вставки
  ;nline - количество строк
  (setq width 104 h 4);ширина таблицы\высота строк\
  
  ;чертим гор.линии шапки таблицы
  (setq xx (car InsertionPoint) yy (cadr InsertionPoint))
  (geo-add-line (list xx yy) (list (+ xx width) yy) acLnWtByLayer);первая линия, с началом в точке InsertionPoint
  (geo-add-line (list (+ xx 13) (- yy h)) (list (+ xx 57) (- yy h)) acLnWtByLayer);вторая линия  
  (geo-add-line (list xx (- yy 8)) (list (+ xx width) (- yy 8)) acLnWtByLayer);третья линия

  ;чертим гор. линии таблицы
  (setq yy (- yy 12))
  (repeat nline
    (geo-add-line (list xx yy) (list (+ xx width) yy) acLnWtByLayer)
    (setq yy (- yy h))
  );_end repeat

  ;чертим вертикальные линии таблицы
  (setq xx (car InsertionPoint) yy (cadr InsertionPoint))
  (geo-add-line (list xx yy) (list xx (- yy 8 (* h nline))) acLnWtByLayer);первая линия  
  (geo-add-line (list (+ xx 13) yy) (list (+ xx 13) (- yy 8 (* h nline))) acLnWtByLayer);вторая линия
  (geo-add-line (list (+ xx 35) (- yy h)) (list (+ xx 35) (- yy 8 (* h nline))) acLnWtByLayer);третья линия
  (geo-add-line (list (+ xx 57) yy) (list (+ xx 57) (- yy 8 (* h nline))) acLnWtByLayer);четвёртая линия 
  (geo-add-line (list (+ xx 74) yy) (list (+ xx 74) (- yy 8 (* h nline))) acLnWtByLayer);пятая линия
  (geo-add-line (list (+ xx 91) yy) (list (+ xx 91) (- yy 8 (* h nline))) acLnWtByLayer);шестая линия
  (geo-add-line (list (+ xx 104) yy) (list (+ xx 104) (- yy 8 (* h nline))) acLnWtByLayer);седьмая линия    

);_end defun DrawLines



(
defun DrawText(InsertionPoint nline h rows)
  ;InsertionPoint - коорд. левого верхнего угла таблицы
  ;nline - количество строк
  ;h - высота текста
  ;rows - список со всеми координатами типа: ((x,y,z)(x,y,z)...)
  
  ;Шапка таблицы
  ;(command "_STYLE" "Table(Geocad)" "Times New Roman" 0.0 1.0 0.0 "N" "N");создаём новый текст.стиль "Table(Geocad)"
  ;(setvar "TEXTSTYLE" "Table(Geocad)");TEXTSTYLE

  (setq xx (car InsertionPoint) yy (cadr InsertionPoint))
  (geo-add-text "Номер" (list (+ xx 2.5) (- yy 3)) h acAlignmentLeft 0)
  (geo-add-text "точки" (list (+ xx 3) (- yy 6)) h acAlignmentLeft 0)
  (geo-add-text "К О О Р Д И Н А Т Ы" (list (+ xx 21) (- yy 3)) h acAlignmentLeft 0)
  (geo-add-text "X" (list (+ xx 23) (- yy 7)) h acAlignmentLeft 0)
  (geo-add-text "Y" (list (+ xx 44.5) (- yy 7)) h acAlignmentLeft 0)
  (geo-add-text "Дир.углы" (list (+ xx 60) (- yy 4.5)) h acAlignmentLeft 0)
  (geo-add-text "Меры" (list (+ xx 79) (- yy 3)) h acAlignmentLeft 0)
  (geo-add-text "линий,м" (list (+ xx 77.5) (- yy 6)) h acAlignmentLeft 0)
  (geo-add-text "На" (list (+ xx 96) (- yy 3)) h acAlignmentLeft 0)
  (geo-add-text "точку" (list (+ xx 94) (- yy 6)) h acAlignmentLeft 0)

  ;Таблица
  (setq i 1);счётчик
  (setq nlist 0);список с коорд.(x,y,z) в списке со всеми коорд. 
  (repeat nline
    ;номера точек
    (geo-add-text (rtos i 2 0) (list (+ xx 6.5) (- yy 11)) h acAlignmentCenter 0);выводим в перв. столбец номер точки

    (if (= i nline) (setq i 0));если последняя точка, в последнем столбце для точек пишем начальную точку
    (geo-add-text (rtos (1+ i) 2 0) (list (+ xx 97.5) (- yy 11)) h acAlignmentCenter 0);выводим в последний столбец номер точки

    ;координаты X и Y
    (setq kx (nth 0 (nth nlist rows)));коорд. X
    (setq ky (nth 1 (nth nlist rows)));коорд. Y
    (geo-add-text (rtos ky 2 3) (list (+ xx 24) (- yy 11)) h acAlignmentCenter 0);выводим X\переворачиваем координаты
    (geo-add-text (rtos kx 2 3) (list (+ xx 46) (- yy 11)) h acAlignmentCenter 0);выводим Y\переворачиваем координаты
     
    ;Дир.углы
    (setq a1 (nth nlist rows));первая координата
    (setq a2 (nth (rem (1+ nlist) nline) rows));вторая координата
    
    (setq x1 (car a1) y1 (cadr a1));выбираем из списка координат а1 x и y
    (setq x2 (car a2) y2 (cadr a2));выбираем из списка координат а2 x и y    
    (setq k1 (list y1 x1));меняем x и y и заносим в список 
    (setq k2 (list y2 x2));меняем x и y и заносим в список 


    (setq ang (geo_get_angle k1 k2));вычисляем угол\переворачиваем координаты
    (setq stang (angtos ang 1 3));преобразуем угол в стороку с точностью 3
    (setq stang (vl-string-subst "° " "d" stang));заменяем символ d(град) на символ '° '
    (setq stang (vl-string-subst "' " "'" stang));заменяем символ '(мин) на символ '' '(c пробелом)
    (geo-add-text stang (list (+ xx 65.5) (- yy 11)) h acAlignmentCenter 0);выводим угол в град,мин,сек. 

    ;Расстояние
    (setq pnt1 (nth nlist rows));первая координата
    (setq pnt2 (nth (rem (1+ nlist) nline) rows));вторая координата
    (setq dist (geo_get_distance pnt1 pnt2))
    (geo-add-text (rtos dist 2 2) (list (+ xx 82.5) (- yy 11)) h acAlignmentCenter 0);выводим расстояние
  
    (setq i (1+ i));увеличиваем i на 1
    (setq yy (- yy 4));уменьшаем yy на 4
    (setq nlist (1+ nlist));увеличиваем nlist на 1
  )

  
);_end defun DrawText
;----------------------------------------------------------------------------------------------------------------------------

[Ubivec81]

Создал простейшую таблицу и получил вот такой DXF-список данных примитива

Код:

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

 ((-1 . <Имя объекта: 786250f8>) (0 . "ACAD_TABLE") (330 . <Имя объекта: 
7dc43cf8>) (5 . "54F") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") 
(100 . "AcDbBlockReference") (2 . "*T11") (10 2504.03 1052.2 0.0) (41 . 1.0) 
(42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 
0.0 0.0 1.0) (100 . "AcDbTable") (342 . <Имя объекта: 7dc43e38>) (343 . <Имя 
объекта: 78625100>) (11 1.0 0.0 0.0) (90 . 22) (91 . 3) (92 . 1) (93 . 0) (94 . 
0) (95 . 0) (96 . 0) (141 . 43.0) (141 . 33.0) (141 . 33.0) (142 . 20.0) (171 . 
1) (172 . 0) (173 . 0) (174 . 0) (175 . 1) (176 . 1) (91 . 0) (178 . 0) (145 . 
0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 7) (90 . 0) (94 . 0) (300 . "") (302 . 
"") (304 . "ACVALUE_END") (171 . 1) (172 . 0) (173 . 0) (174 . 0) (175 . 1) 
(176 . 1) (91 . 0) (178 . 0) (145 . 0.0) (92 . 0) (301 . "CELL_VALUE") (93 . 7) 
(90 . 0) (94 . 0) (300 . "") (302 . "") (304 . "ACVALUE_END") (171 . 1) (172 . 
0) (173 . 0) (174 . 0) (175 . 1) (176 . 1) (91 . 0) (178 . 0) (145 . 0.0) (92 . 
0) (301 . "CELL_VALUE") (93 . 7) (90 . 0) (94 . 0) (300 . "") (302 . "") (304 . 
"ACVALUE_END"))

Теперь хочу заменить один элемент списка (300 . "") на (300 . "XXX")

Код:

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

 (setq sps_dxf (entget(entlast)))
(setq qwe (assoc 300 sps_dxf))
(setq sps_dxf (subst '(300 . "XXX") 'qwe sps_dxf))

Но после этого список не меняется. Что я не так делаю?

[VVA]

посчитай, сколько полей с кодом 300 в твоем листинге

[Ubivec81]

3 так как три строки (как я понимаю). а что делать тогда с этим?

[Oliver_88]

Ubivec81, спасибо за интересную (для меня) задачку.

Код:

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

 (mapcar
  '(lambda (x)
     (if (= 300 (car x))
       '(300 . "XXX")
       x
       )
     )
  sps_dxf
  )

Или

Код:

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

 ;(test sps_dxf)
(defun test (sps_dxf)
  (cond
    (
     (= 300 (setq a (caar sps_dxf)))
     (cons '(300 . "XXX")
	   (test (cdr sps_dxf))
	   )
     )
    (
     sps_dxf
     (cons (car sps_dxf) (test (cdr sps_dxf)))
     )
    )
  )

[dirge]

Всем привет! Появилась необходимость реализовать такой сетап. В чертеже есть несколько лэйаутов, в каждом лэйауте есть два блока, один обычный и динамический. Нужно процедурно в каждом листе изменить динамический параметр блока в зависимости от размеров блока или имени. Не знаю как даже лучше будет, обращаться либо к имени блока или вычислять его размеры? Подскажите пожалуйста как подступиться к этому вопросу.

[VVA]

динамический параметр и имя блока

[dirge]

Ребят, подскажите пожалуйста! Сделал вставку во все листы динамического блока поверх старых блоков и нужно теперь изменить динамическое свойство блока в зависимости от имени старого блока.

(setq ss1 (ssget "_x" '((0 . "INSERT") (100 . "AcDbBlockReference"))))

(setq i 0)

(while (< i (SSLENGTH ss1))

(setq name (ssname ss1 i))

(setq conv (vlax-ename->vla-object name))


(if (= (vla-get-name conv) "Mp.Stamp")

(vla-put-value
(car (vlax-safearray->list
(vlax-variant-value
(vla-getdynamicblockproperties conv)
)
)
)
"Mp.StampSmall"
)
)

(setq i (1+ i))
)

Никак не могу додуматься как сделать так чтобы штамп менялся не во всех листах, а только в тех где есть нужный элемент. Дико, буду признателен.

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

Так у тебя и так проверяется имя блока. Правда, куда выполняется вставка, не очень понятно...

[dirge]

Сообщение от Кулик Алексей aka kpblc Так у тебя и так проверяется имя блока. Правда, куда выполняется вставка, не очень понятно...

Во всех листах вставлены два вида блоков динамический и обычный, нужно как то процедурно изменить динамическое свойство блока по имени старого блока. У меня только срабатывает на всех листах, я не пойму как написать условие сравнения имени двух блоков для какого-то листа и если имена имена в списке совпадают и совпадают листы, то выполнить выражение. Может путанно достаточно, но как-то так.

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

Как один из вариантов (сейчас лично мне приходится много работать с неактивными документами, так что от ssget я пока отказываюсь. Что не может не отражаться на кодах )

Код:

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

(vl-load-com)

(defun test (/ adoc blk old_name)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for layout (vla-get-layouts adoc)
    (vlax-for ent (vla-get-block layout)
      (if (= (vla-get-objectname ent) "AcDbBlockReference")
	(cond
	  ((= (vla-get-name ent) "Mp.Stamp")
	   (vlax-for ent1 (vla-get-block layout)
	     (if (and (= (vla-get-objectname ent) "AcDbBlockReference")
		      (= (vla-get-effectivename ent) "Mp.StampSmall")
		      ) ;_ end of and
	      ) ;_ end of if
	     ;; И здесь установка значения
	     ) ;_ end of vlax-for
	   )
	  ) ;_ end of cond
	) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Сам понимаешь, код не проверял

[dirge]

Кулик Алексей aka kpblc, отличный сетап, всё работает как часы! Ты так просто решил проблему над которой я неделю сидел. Огромная благодарность!

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

На самом деле логика элементарна Проходим по всем пространствам листов и модели (layouts). Из указателя на пространство извлекаем указатель на блок этого пространства (vla-get-block). Потом проходим по всем примитивам блока.
Не самое лучшее решение, если честно. Времени нормально посидеть не было, выдал только то, что в голову пришло. Если подключится VVA, код наверняка получится более компактным и быстрым.

[dirge]

Сообщение от Кулик Алексей aka kpblc На самом деле логика элементарна Проходим по всем пространствам листов и модели (layouts). Из указателя на пространство извлекаем указатель на блок этого пространства (vla-get-block). Потом проходим по всем примитивам блока. Не самое лучшее решение, если честно. Времени нормально посидеть не было, выдал только то, что в голову пришло. Если подключится VVA, код наверняка получится более компактным и быстрым.

Всё хорошо, но пока есть трудности с пониманием такого количества вложенных циклов. Для меня пока это высшая математика.

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

Ох, как не хочется разбирать изначально порочный код... Ну да ладно, корифеи (надеюсь!) простят...

Код:

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

 (vl-load-com)

(defun test (/ adoc blk old_name)
  (vla-startundomark
    (setq adoc ; Присвоение переменной adoc значения
           (vla-get-activedocument ; активного документа
             (vlax-get-acad-object) ; объекта AutoCAD.
             ) ;_ end of vla-get-activedocument
          ) ;_ end of setq
    ) ;_ end of vla-startundomark
  (vlax-for layout ; для каждого объекта
            (vla-get-layouts adoc); в коллекции Layout активного документа
    (vlax-for ent ; Перебираем все примитивы
              (vla-get-block layout) ; входящие внутрь блока, связанного с текущим Layout
      (if (= (vla-get-objectname ent) "AcDbBlockReference") ; Если объект - вхождение блока
        (cond ; то
          ((= (vla-get-name ent) "Mp.Stamp") ; Если его имя Mp.Stamp, то
           (vlax-for ent1 ; Повторно перебираем все примитивы
                     (vla-get-block layout) ; входящие внутрь блока, связанного с текущим Layout
             (if (and (= (vla-get-objectname ent) "AcDbBlockReference") ; Если примитив - вхождение блока
                      (= (vla-get-effectivename ent) "Mp.StampSmall"); и его эффективное имя Mp.StampSmall
                      ) ;_ end of and
              ) ;_ end of if
             ;; И здесь установка значения
             ) ;_ end of vlax-for
           )
          ) ;_ end of cond
        ) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Разницу между эффективным и обычным именем блока можно прочувствовать так: вставляем в файл любой динамический блок и меняем ему хотя бы один из дин.параметров. После этого запускаем такой лисп:

Код:

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

 (vl-load-com)

(defun c:names (/ ent)
  (if (and (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (car (entsel "\nУкажи блок <Отмена> : "))
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (= (cdr (assoc 0 (entget ent))) "INSERT")
           ) ;_ end of and
    (alert (strcat "Имя блока: "
                   (vla-get-name (setq ent (vlax-ename->vla-object ent)))
                   "\nЭффективное имя блока : "
                   (vla-get-effectivename ent)
                   ) ;_ end of strcat
           ) ;_ end of alert
    ) ;_ end of if
  ) ;_ end of defun

[dirge]

Кулик Алексей aka kpblc, спасибо огромное ещё раз подробный разбор полётов! Буду разбираться потихоньку!

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

Да, совсем забыл написать... Конструкцию cond я использовал, чтобы код можно было масштабировать - например, для другого имени дин.блока надо менять другой параметр. А связь все равно со старым блоком. Если этого не надо, то cond безболезненно можно заменить на if. Или (что лучше) - объединить с предыдущим if.

[Ubivec81]

Сообщение от Дима_ ну попробуй разберись: Код: [Выделить все] (vla-addline (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))) (vlax-3d-point '(0 0 0)) (vlax-3d-point '(100 100 0))) p.s. - с тебя два круга с однинаковыми центрами и радиусами 100 и 200 соответственно.

Долго все это пытался понять. Кое что стало доходить

Код:

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

 (vla-addcircle
 	(vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object)))
 	(setq stpt(vlax-3d-point '(0 0 0)))
 	200 
 
   )
(vla-addcircle
 	(vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object)))
 	stpt
 	300 
 
   )

Только так у меня 2 круга получаются, а вот как правильно не знаю . И еще

Код:

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

 (vla-addline 
  (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object)))

читать как создание линии в модели листа активного документа Акада?

[dirge]

Всем привет, уважаемые форумчане! Ребята, подскажите как можно прервать цикл выбора объектов клавишей Esc?

[gomer]

Сообщение от dirge как можно прервать цикл выбора объектов клавишей Esc?

Нажать Esc

[dirge]

Сообщение от gomer Нажать Esc

прикольно, но мне нужен корректный выход, а так выдаётся ошибка

[gomer]

Сообщение от dirge мне нужен корректный выход, а так выдаётся ошибка

и правильно выдается... фашисты вообще за побег расстреливали... Ескейп - кнопка выхода, а не прекращения... просто программа не может понять чего вам надо и считает такое нажатие ошибкой пользователя... о чем ему и сообщает а вам как программисту полезно знать о vl-catch-all-apply и иже с ней...
Здесь крыс уже настолько пропиарил свой сайт, что не наткнуться на него уже проблематично, а там все хорошенько разжевано. за что ему и реверанс

[Ubivec81]

Подскажите пожалуйста!
На чертеже созданы 2 таблицы и надо значение одной ячейки (F2) первой таблицы перенести в ячейку второй таблицы (tabl 5 4).
Делаю это через

Код:

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

 vla-settext tabl 5 4 (STRCAT "=Table("(itoa(vla-get-objectid tblsn))").F2"))

Все работает хорошо.
Далее в первой таблице меняю какие то цифры и согласно формуле в первой таблице значение F2 меняется а вот значение (tabl 5 4) почему то остается таким же как и было. В EXCEL это все вроде работает,а в АКАДЕ? Или нет вариантов это победить?

[TararykovDG]

Ubivec81, _regen или _updatefield

[Ubivec81]

TararykovDG, спасибо. Работает. НО, это я знаю что после изменения нужно будет дать данную команду. А если этого не будет знать тот что загрузит данный код?

[Дима_]

Ему надо будет об этом сказать.

[Oliver_88]

Ubivec81, наверное забыл про command.

Код:

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

 (command "_regen")

А с vla-Regen еще не сталкивался.

Код:

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

 (vla-Regen
  (vla-get-activedocument
    (vlax-get-acad-object)
    )
  0
  )

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

vla-regen получает 2 аргумента: указатель на обрабатываемый документ и "чего обновлять": acAllViewports | acactiveviewport и чего-то там еще. Короче, в справке надо посмотреть...

[Ubivec81]

Я наверное не правильно вопрос сформулировал. Пользователь померил площади, создалась таблица и эти площади все попали в нее. Далее вычисляются объемы в зависимости от расстояний. Так вот пользователь может и БУДЕТ изменять эти расстояния но уже после того как код будет выполнен. А эти объемы формируют вторую таблицу. Вот и получается при изменении расстояний в первой таблице значения объемов меняются, а во второй меняются только после регенерации. Но чует мое слабое сердце что вариант только ручками заставить его это делать.

[TararykovDG]

Сообщение от Ubivec81 Но чует мое слабое сердце что вариант только ручками заставить его это делать.

Моё скромное мнение, что лучше именно так и делать, хотя есть варианты обновления полей (а в данном случае к этому всё и сводиться) с помощью реакторов. Здесь это обсуждалось Как автоматически обновлять поля блока
Ubivec81 в Твое случае можно сделать так

Код:

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

 
; Функция действия
(defun commandEnded(reac data / ) ; конец какой-то комады ACad
  (if (= (car data) "TABLEDIT") ; если это была команда редактирования таблицы
    ; посылаем в ком. строку AutoCAD'а команду обновления полей
    ; "_.updatefield _all  " - здесь обязательно должно быть так "_.updatefield<пробел>_all<пробел><пробел>"
    (vla-SendCommand (vla-get-activedocument (vlax-get-acad-object)) "_.updatefield _all  ")
    )
)


; Создаем реактор
(setq Cmnd_Reac (vlr-command-reactor "Реактор команд: "
          (list '(:VLR-commandEnded . commandEnded))
          )
      )

P.S. Это лисп нужно добавить в автозагрузку.

[VVA]

Сообщение от TararykovDG ; "_.updatefield _all* " - здесь обязательно должно быть так "_.updatefield<пробел>_all<пробел><пробел>"

Я заключительный Enter в Sendcommand делаю не пробелом, а "\n" (так же срабатывает). Зато в редакторе удобней, виден конец команды.

Код:

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

(vla-SendCommand (vla-get-activedocument (vlax-get-acad-object)) "_.updatefield _all \n")

Так вот пользователь может и БУДЕТ изменять эти расстояния но уже после того как код будет выполнен

Пользователя лучше всего все-же просветить насчет полей, и методов их обновления и системной переменной FIELDEVAL.

[Ubivec81]

TararykovDG, спасибо помог твой код. Правда я не особо понял как это работает, вернее не знаю как с data это получается.
Прошу помочь вот в чем.
В таблице несколько столбцов (на различных километрах в моей таблице) в которых нужно сложить определенные строки которые записать в отдельную строку. И так надо пройти по всем столбцам.
У меня получается вот такой цикл:

Код:

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

 (setq u 4)
  (repeat (- km 1)
	(vla-settext tabl  20 u (rtos(+(atof(vla-gettext tabl 9 u)) (atof(vla-gettext tabl 10 u))(atof(vla-gettext tabl 15 u))(atof(vla-gettext tabl 16 u))(atof(vla-gettext tabl 17 u)))2 2) )
    	(setq u (+ u 1))
  )

Считает это все правильно, вот только нужно поставить сюда формулы чтоб при изменении каких либо данных изменялась и эта величина. А вот так эти формулы записать я не пойму. Вернее не пойму как перебираться с A на B потом на C и т.д.

[VVA]

Сообщение от Ubivec81 Вернее не пойму как перебираться с A на B потом на C и т.д.

vla-get-Rows
vla-get-columns

[Ubivec81]

Сообщение от VVA vla-get-Rows vla-get-columns

vla-get-Rows возвращает количество строк
vla-get-columns колличество столбцов
как эти функции использовать в формуле?
Формула то выглядит как =(А1+А3+А7+А10) а в следующей колонке =(В1+В3+В7+В10)
Как вставить числа и запустить это в цикле я понял а вот как БУКВУ в цикле менять?
Думал что есть функция которая возвращает положение ячейки типа (VLA-get.... 1 1) (положение ячейки строка 1 столбец 1 = А1) но ничего не нашел в хелпе! или плохо искал?

[VVA]

Сообщение от Ubivec81 Как вставить числа и запустить это в цикле я понял а вот как БУКВУ в цикле менять?

На выбор

Код:

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

(defun Alpha2Number (Str$ / Num#)
;-------------------------------------------------------------------------------
; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
  (if (= 0 (setq Num# (strlen Str$)))
    0
    (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
       (Alpha2Number (substr Str$ 2))
    );+
  );if
);defun Alpha2Number

(defun Number2Alpha (Num# / Val#)
;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
  (if (< Num# 27)
    (chr (+ 64 Num#))
    (if (= 0 (setq Val# (rem Num# 26)))
      (strcat (Number2Alpha (1- (/ Num# 26))) "Z")
      (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
    );if
  );if
);defun Number2Alpha

Код:

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

(defun ColLetter  (N			;Integer
		   /
		   Res			;resulting string
		   TMP			;work variable
		   )
;;---------------------------------------------------------------------
;; From the Wizards Utilities...
;;---------------------------------------------------------------------
;; ColLetter - Given a number, returns a string that is the Excel
;; method of numbering columns.
;; 1="A", 2="B", ... 26="Z", 27="AA", 28 = "AB" ...
;;
		   
  (setq Res "")
  (while (> N 0)
    (setq TMP (rem N 26)		;remainder of N divided by 26
	  TMP (if (zerop TMP)		;reset to "Z"
		(setq N	  (1- N)	;move under next order
		      TMP 26		;set to Z offset value
		      )
		TMP)			;use value as it is
	  Res (strcat			;Add character
		(chr (+ 64 TMP))	;Offset plus 64 ("A" = 65)
		Res)			;existing string
	  N   (/ N 26)			;shift down an order
	  )
    )
  Res
  )

Код:

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

;;;--- Function to convert an Excel column letter to a number
;;;    Not used in this program but didn't want to dismiss code
;;;
;;;--- Parameters:
;;;
;;;       a = alpha Column name  Ex. "A" or "AB"
;;;
;;;--- Returns:
;;;
;;;       Column number as integer
;;;
;;;
;;;--- Limitations
;;;
;;;      Works from "A" to "ZZ" or 702 columns

(defun C2N(a)
  (if(= 1 (strlen a))
    (setq column (- (ascii a) 64))
  )  
  (if(= (strlen a) 2)
    (progn
      (setq b(substr a 1 1))
      (setq c(substr a 2 1))
      (setq column(- (ascii c) 64))
      (setq column(+ column(* 26 (- (ascii b) 64))))
    )
  )  
  column
)  
;;;--- Function to convert a column number to an excel column letter
;;;
;;;--- Parameters:
;;;
;;;       a = Column number as integer
;;;
;;;--- Returns:
;;;
;;;       Column name as in Excel  Ex. "A" or "AB"
;;;
;;;
;;;--- Limitations
;;;
;;;      Works from 1 to 702

(defun N2C(a)
  (if(< a 27)
    (setq column (chr (+ a 64)))
    (setq column
      (strcat
        (if(= 91 (+ 64(fix(/ a 26.001))))
           "Z"
           (chr(+ 64(fix(/ a 26.001))))
        )  
        (if(= 64 (+ 64(- a(* 26(fix(/ a 26))))))
          "Z"
          (chr(+ 64(- a(* 26(fix(/ a 26))))))
        )
      )
    )
  )  
  column
)

[baaba]

Беру широко известную программу на автолисп. Я вижу что после загрузки программы вспомогательные функции остаются в памяти:

Код:

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

Command: (load "quickdraw")
Type in command line:
QR - QUICKDRAW with restore setting
Q - only QUICKDRAW"\nQ - only QUICKDRAW"
Command: !qmake_cmd
#<SUBR @04f1ba50 QMAKE_CMD>

как бы это сделал я:

 

; файл программы:

(defun c:quickdraw ()

	(load quickdraw_fun_lib.lsp)

	(...)

)

(defun c:q ()

	(load quickdraw_fun_lib.lsp)

	(...)

)

; и так далее

quickdraw_fun_lib.lsp - содержит определения всех необходимых функций (qmake_cmd и т. д.).
В результате в памяти только функции c:quickdraw с:q, и т. д. Функций типа qmake_cmd, не нужных конечному пользователю, в памяти нет. Память используется экономно. Или я неправильно понимаю механизм расходования памяти? Может быть не париться: просто определить все функции а затем комманды, в одном текстовом файле. То есть и в том и в ином случае функции вроде qmake_cmd, назовём их функции ненужные пользователю, одинаково будут расходовать память. Просто в случае когда они вынесены в отдельный текстовый файл и загружаются внутри функций c:q c:quickdraw и т. д., ими не может воспользоваться конечный пользователь (но они ему в общем-то и не нужны), они скрыты от него.

То есть, видны или не видны функции (!имя_функции равно не nil значит функция видна пользователю), влияет ли это на расход памяти?

[Ubivec81]

VVA, спасибо! почему то не вспомнились функции ascii и chr. Наверное потому что никогда до этого их не использовал.

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

Сообщение от baaba В результате в памяти только функции c:quickdraw с:q, и т. д.

Ошибаешься.

[VVA]

Дополню Алексея

В результате в памяти только функции c:quickdraw с:q, и т. д.

До первого вызова команды quickdraw.
Тогда уж лучше повесь на кнопку код

Код:

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

(if (null c:quickdraw)(load "quickdraw.lsp"));quickdraw;

Тогда если пользователь не пользуется, то код и не грузится

Сообщение от baaba влияет ли это на расход памяти?

Не парься

[dirge]

Ребята, всем привет! Не хватает хорошей функции SelSim, сам я работаю в 2009 64bit, под 64 бита её просто нету, а иногда очень хочется выделять подобные объекты по нужным состояниям. Уже вообщем-то привык и Quick Select, но SelSim'ом быстрее бывает. Есть ли близкая LISP альтернатива к SelSim?

[це ментовозик]

Добрый день! Подскажите, пожалуйста, каким образом отредактировать готовую команду акада... К примеру _mirror... чтобы не было последнего запроса (удалять ли исходные объекты), а чтобы они сразу удалялись...
Пытался писать что-то вроде:
(command _mirror pause pause pause pause "_y") ; здесь можно улыбнуться, но я только начинаю в этом всём разбираться...
...получилось, только выбрать можно всего один объект и не работает рамка выбора... если напряжно писать лисп, то может быть подскажете направление в котором работать?) пасип!

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

По-быстрому и не очень красиво:

Код:

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

 (vl-load-com)

(defun c:mirr (/ adoc selset pt1 pt2)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (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 pt1 (vl-catch-all-apply
                                (function (lambda () (getpoint "\nУкажите первую точку оси отражения <Отмена> : ")))
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           (= (type
                (setq pt2 (vl-catch-all-apply
                            (function (lambda () (getpoint pt1 "\nУкажите вторую точку оси отражения <Отмена> : ")))
                            ) ;_ end of vl-catch-all-apply
                      ) ;_ end of setq
                ) ;_ end of type
              'list
              ) ;_ end of =
           ) ;_ end of and
    (command "_.mirror" selset "" "_none" pt1 "_none" pt2 "_y")
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[це ментовозик]

оуууу... оочень оперативно! огромное спасибо! буду разбираться...

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

Если убрать все проверки на ошибки, то алгоритм очень прост: сначала запрашиваем у пользователя набор примитивов, игнорируя объекты на заблокированных слоях. Потом запрос первой и второй точек отражения. И команду на запуск: _.mirror, в качестве первого параметра подставляем полученный набор примитивов, заканчиваем выбор ENter'ом (пустая строка), подставляем первую точку с временным отключением привяззок и вторую точку - тоже не забыв про привязки.

[dirge]

Всем привет! Ребята, подскажите как можно достучаться до вложенных фильтров слоёв один в другом? Фильтров может быть много.

Код:

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

 (setq dict_ACAD_LAYERFILTERS
       (dictsearch
	 (cdr
	   (assoc
	     360
	     (entget
	       (cdr (assoc
		      330
		      (entget (tblobjname "LAYER" "0"))
		    )
	       )
	     )
	   )
	 )
	 "ACAD_LAYERFILTERS"
     )
)

Этой процедурой получается узнать все внешние фильтры, но не получается узнать свойств и имён вложенных фильтров. Как будто их вообще нет. Подскажите как решить задачу?

[Andru1968]

Всем привет! Ребята, подскажите при выполнении функции получил значение переменной Result: (("zona_n" "login_user") (3 "chaa")), далее идет строка

Код:

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

 (setq SQLFetch (cdr Result))

получаю результат: ((3 "chaa"))
Как из этого получить (3 "chaa")?

[gomer]

Сообщение от Andru1968 получаю результат: ((3 "chaa")) Как из этого получить (3 "chaa")?

Код:

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

 (nth 0 '((3 "chaa")))

[TararykovDG]

Или может лучше сразу так

Код:

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

 
(setq SQLFetch (cadr Result))
(setq SQLFetch (assoc 3 Result))

[alex8888]

Как из этого получить (3 "chaa")

а просто (car '((3 "chaa"))) недостаточно?

Или во всей строке: (setq SQLFetch (cadr Result))

[Andru1968]

Когда делаю так

Код:

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

 (setq SQLFetch (cadr Result))

получаю SQLFetch = (3 "chaa") и далее можно работать со списком

Код:

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

 (if (not SQLFetch)
	(alert "Строка в базе не найдена")
	(progn
	  (setq  zona_n ( car SQLFetch)
                  SQLFetch ( cdr SQLFetch)
                login_user ( car SQLFetch)
                  SQLFetch ( cdr SQLFetch))

получаю zona_n = 3, login_user = "chaa"

а если делаю так

Код:

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

 (setq SQLFetch (cadr Result))
(setq SQLFetch (assoc 3 Result))

получаю SQLFetch = nil и идет сообщение "Строка в базе не найдена" хотя она там есть

[TararykovDG]

Сообщение от Andru1968 а если делаю так Код: [Выделить все] (setq SQLFetch (cadr Result)) (setq SQLFetch (assoc 3 Result)) получаю SQLFetch = nil и идет сообщение "Строка в базе не найдена" хотя она там есть

Имелось ввиду, что нужно делать или так (setq SQLFetch (cadr Result)) или так (setq SQLFetch (assoc 3 Result)), а не одновеременно

[dirge]

Так, я ни на шаг не приблизился к пониманию того, можно ли вытащить подгруппы фильтров слоёв через лисп. Ребята, есть у кого какие идеи?

[gross]

Здравствуйте. Есть такой вопрос, я в настройках отключил контекстное, т к использую его редко, можно ли повесить на кнопу команду чтоб оно выходило?, в привычном виде, или когда вызываю команду ПСК _ucs, выходит необычное меню (не знаю как оно правильно называется) - хотя бы такого вида чтоб выходило/
Подскажите пожалуйста

[VVA]

dirge, Не самая подходящая тема для твоего сообщения.
Было много тем про фильтры слоев. На вскидку
http://forum.dwg.ru/showthread.php?t=52142
http://forum.dwg.ru/showthread.php?t=3825
http://forum.dwg.ru/showthread.php?t=58915
Лучше задать вопрос в одной из более подходящих тем или создать новую. Так же более четко сформулировать вопрос, приложить пример в виде dwg файла, указать версию Автокада. Я, например, пока не понимаю, что такое подгруппы фильтров слоёв

[baaba]

null

[dirge]

Сообщение от VVA dirge, Не самая подходящая тема для твоего сообщения. Было много тем про фильтры слоев. На вскидку http://forum.dwg.ru/showthread.php?t=52142 http://forum.dwg.ru/showthread.php?t=3825 http://forum.dwg.ru/showthread.php?t=58915 Лучше задать вопрос в одной из более подходящих тем или создать новую. Так же более четко сформулировать вопрос, приложить пример в виде dwg файла, указать версию Автокада. Я, например, пока не понимаю, что такое подгруппы фильтров слоёв

Спасибо, за ссылки. Вот в этой теме последнее сообщение такой же вопрос по сути:
http://www.caduser.ru/forum/index.ph...#message252725

Версия AutoCAD 2009.
Хорошо, поясню чуть более корректней. Под подгруппами я имею ввиду, что внутри New Property Filter можно создать ещё один и ещё и т.д, соответственно можно образовывать ветвление фильтров внутри одного единственного. Так вот, готовые процедуры по поиску фильтров слоёв которые я нашёл на форумах возвращают только один фильтр и не видят то, что внутри него. Вот собственно и суть вопроса была. Как добраться до 2го, 3го уровня фильтров не понятно. На всякий случай, dwg прилагаю.

Буду признателен в помощи.

[Redj-ЭС]

2011
вот и первый вопрос...

имеется мультивыноска с целым числовым значением, и я её размножаю коммандой _copy...
как сделать, чтоб при каждой вставке этой коммандой, значение увеличивалось... а...?
на 1...

[engngr]

2025
... а... работает?.. поиск... не ?.. ну...

[TararykovDG]

Redj, попробуй так (Используется реактор)

Код:

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

 
; ----------------------------------------------------------------------------------------------------------------------------------------------
(vl-load-com)
(setq *flag_copy* nil
      *flag_append* nil
      *index* nil
      *step* 1 ; здесь можно задать свой шаг инкремента
      )
; ----------------------------------------------------------------------------------------------------------------------------------------------
(defun objectAppended(reac data / ) ; примитив добавлен
  (if *flag_copy*
    ((lambda(obj)
       (if obj
         ((lambda(ed)
            (if (= (cdr (assoc 0 ed)) "MULTILEADER")
              ((lambda(new_str_value)
                 (if (and (not *flag_append*)
                          (/= new_str_value "")
                          )
                   (progn
                     (setq *flag_append* (not *flag_append*)
                           ed (subst (cons 304 new_str_value) (assoc 304 ed) ed)
                           )
                     (entmod ed)
                     )
                   (setq *flag_append* (not *flag_append*))
                   )
                 )
                (if (not *index*)
                  ((lambda(str_value)
                     (cond ((Is-Str->Value str_value nil T)
                            (if (= (type *step*) 'INT)
                              (itoa (setq *index* (+ *step* (atoi str_value))))
                              (rtos (setq *index* (+ *step* (atoi str_value))))
                              )
                            )
                           ((Is-Str->Value str_value nil nil)
                            (rtos (setq *index* (+ *step* (atof str_value))))
                            )
                           (T "")
                           )
                     )
                    (cdr (assoc 304 ed))
                    )
                  (cond ((= (type *index*) 'INT) (itoa (setq *index* (if (not *flag_append*) *index* (+ *step* *index*)))))
                        ((= (type *index*) 'REAL) (rtos (setq *index* (if (not *flag_append*) *index* (+ *step* *index*)))))
                        (T "")
                        )
                  )
                )
              )
            )
           (entget obj)
           )
         )
       )
      (cadr data)
      )
    )
)
; ----------------------------------------------------------------------------------------------------------------------------------------------

; ----------------------------------------------------------------------------------------------------------------------------------------------
(setq AcDb_Reac (vlr-acdb-reactor "Реактор базы: "
          (list '(:VLR-objectAppended . objectAppended)
            )
          )
      )
; ----------------------------------------------------------------------------------------------------------------------------------------------

; ----------------------------------------------------------------------------------------------------------------------------------------------
(defun commandWillStart(reac data / )
  (if (= (car data) "COPY")
    (setq *flag_copy* T)
    )
  )
; ----------------------------------------------------------------------------------------------------------------------------------------------

; ----------------------------------------------------------------------------------------------------------------------------------------------
(defun commandEnded(reac data / )
  (if (= (car data) "COPY")
    (setq *index* nil
          *flag_copy* nil
          )
    )
  )
; ----------------------------------------------------------------------------------------------------------------------------------------------

; ----------------------------------------------------------------------------------------------------------------------------------------------
(setq CmdReac (vlr-command-reactor "Реактор команд: "
            (list '(:vlr-commandWillStart . commandWillStart)
                      '(:vlr-commandEnded . commandEnded)
              )
            )
    )
; ----------------------------------------------------------------------------------------------------------------------------------------------


; Проверка является ли строка числом (если not_null = T - проверка на неравенство нулю; если int = T - проверка является ли число целым)
(defun Is-Str->Value(str not_null int / lst lst_memb)
  (if (= (substr str 1 1) "-")
    (setq str (substr str 2))
  )
  (setq lst (vl-string->list (vl-string-translate ",e" ".E" str)))
  (if int
    (setq lst_memb (list 45 48 49 50 51 52 53 54 55 56 57 69))
    (setq lst_memb (list 45 46 48 49 50 51 52 53 54 55 56 57 69))
  )
  (if (and (vl-every '(lambda(x) (member x lst_memb)) lst)
           (< (length (vl-remove-if-not '(lambda(x) (= x 46)) lst)) 2)
       (if (vl-position 69 lst)
         (and (> (vl-position 69 lst) 0)
          (< (vl-position 69 lst) (1- (length lst)))
          (< (length (vl-remove-if-not '(lambda(x) (= x 69)) lst)) 2)
          )
         T
         )
           (if (vl-position 45 lst)
             (and (< (length (vl-remove-if-not '(lambda(x) (= x 45)) lst)) 2)
                  (< (vl-position 45 lst) (1- (length lst)))
                  (= (nth (1- (vl-position 45 lst)) lst) 69)
                  )
             T
             )
           )
    (if not_null
      (> (length (vl-remove-if '(lambda(x) (or (= x 45) (= x 46) (= x 48) (= x 69))) lst)) 0)
      T
      )
    nil
  )
); End Is-Str->Value

P. S. можно добавить в автозагрузку, и тогда будет работать автоматически на любом чертеже, но ИМХО лучше загружать самому когда это необходимо, а то вдруг надо будет просто скопировать мультивыноску без инкрементирования.

[Redj-ЭС]

во...
такая простая идея... вроде...
и такой длинный код... о как...

спасибо за информацию... буду изучать.

[Pavel_GP]

Здравствуйте!
Подскажите плз, как написать LISP (стараюсь - не получается) - построение линии по географическим координатам.

П.С. AutoCad civil 3d 2012

Пример

Код:

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

 
  (defun C:setka_gk ()
  (command "_.line" "_'LL")
  (command "67 27 10")
  (command "86 30 00")
  (command "67 27 50")
  (command "86 30 00")
  )

Этот код не работает ((, что-то делаю не так.
Первая точка строится, а вот вторая нет, ругается...:

Вставка из командной строки:
Команда: SETKA_GK
_.line Первая точка:
Текущая единица изменения широты/долготы: градусы; ввод: ГГ° ММ' СС.СС" (с
пробелами)
>>Введите широту <С067° 00' 00.00">: 67 27 10
>>Введите долготу <В027° 00' 00.00">: 86 30 00
Возобновляется команда SETKA_GK.
Первая точка: 67 27 50
Неверная точка.
; ошибка: Функция отменена
Первая точка:
(478597.0 7.48494e+006 0.0)
Следующая точка или [оТменить]:
Текущая единица изменения широты/долготы: градусы; ввод: ГГ° ММ' СС.СС" (с
пробелами)
>>Введите широту <С067° 27' 10.00">:

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

Привязку снять забыл.

[Pavel_GP]

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

Код:

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

 (defun C:setka_sk ()
  (command "_.osnap" "_none")
  (command "_.line" "_'LL")
  (command "67 27 10")
  (command "86 30 00")
  (command "67 27 50")
  (command "86 30 00")
)

Все так же, не изменилось.

В ручную я эту линию могу нарисовать, а код не пишится...

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

(command "_.line" "_none" '(67 27 10) "_none" '(86 30 0) "_none" '(67 27 50) "_none" '(86 30 0))

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc (command "_.line" "_none" '(67 27 10) "_none" '(86 30 0) "_none" '(67 27 50) "_none" '(86 30 0))

этот код для линии в сети прямоугольных координат.

Я хочу создать линии по географическим координатам - использую команду _'LL

При создании линии по команде _'LL - выдается сообщение введите значение широты (с пробелами). Когда я использую твой код , то вместо широты вводится _none, что следует по прядку за командой _'LL.

(command "_.line" "_'LL" "_none" '(67 27 10) "_none" '(86 30 0) "_none" '(67 27 50) "_none" '(86 30 0))

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

Ну, я с Civil не работаю.

[AlexSheep]

а если так попробовать?

Код:

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

 (command "_.line" "_'LL" '(67 27 10) '(86 30 0) '(67 27 50) '(86 30 0))

или так:

Код:

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

 (command "_.line" "_'LL" "67 27 10" "86 30 0" "67 27 50" "86 30 0")

А вообще то странно, что "общеавтокадовская" функция Line имеет в Civil'е какую-то непонятную опцию "_'LL"

[Pavel_GP]

Сообщение от AlexSheep а если так попробовать? Код: [Выделить все] (command "_.line" "_'LL" '(67 27 10) '(86 30 0) '(67 27 50) '(86 30 0)) или так: Код: [Выделить все] (command "_.line" "_'LL" "67 27 10" "86 30 0" "67 27 50" "86 30 0") А вообще то странно, что "общеавтокадовская" функция Line имеет в Civil'е какую-то непонятную опцию "_'LL"

1. Первый код не работает
2. Второй код я сам его писал (см. выше) - он отрабатывает ток первую точку, на второй стоп...

Функция _'LL отдельно ее использовать нельзя, она применяется с вызовом основной команды. Основная задача построение примитивов по географическим координатам (Ввод вместо прямоугольных координат (X,Y), - широту и долготу)

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

Хорошо, почему "стоп"? Что запрашивает Civil? Какие действия выполняются, если построения происходят "вручную"?

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Хорошо, почему "стоп"? Что запрашивает Civil? Какие действия выполняются, если построения происходят "вручную"?

1. Выписка из командной строки ("почему стоп? Что запрашивает Civil"):
Вставка из командной строки:
Команда: SETKA_GK
_.line Первая точка:
Текущая единица изменения широты/долготы: градусы; ввод: ГГ° ММ' СС.СС" (с
пробелами)
>>Введите широту <С067° 00' 00.00">: 67 27 10
>>Введите долготу <В027° 00' 00.00">: 86 30 00
Возобновляется команда SETKA_GK.
Первая точка: 67 27 50
Неверная точка.
; ошибка: Функция отменена
Первая точка:
(478597.0 7.48494e+006 0.0)
Следующая точка или [оТменить]:
Текущая единица изменения широты/долготы: градусы; ввод: ГГ° ММ' СС.СС" (с
пробелами)
>>Введите широту <С067° 27' 10.00">:

Вторую точку просит ввести самостоятельно, а не по коду.

2. Построение линии без кода - самостоятельно::
Команда: _LINE
Первая точка: _'LL
Текущая единица изменения широты/долготы: градусы; ввод: ГГ° ММ' СС.СС" (с
пробелами)
>>Введите широту <С067° 27' 10.00">: 67 27 10
>>Введите долготу <В086° 30' 00.00">: 86 30 00
Возобновляется команда ОТРЕЗОК.
Первая точка:
(478597.0 7.48494e+006 0.0)
Следующая точка или [оТменить]:
Текущая единица изменения широты/долготы: градусы; ввод: ГГ° ММ' СС.СС" (с
пробелами)
>>Введите широту <С067° 27' 10.00">: 67 27 52
>>Введите долготу <В086° 30' 00.00">: 86 30 00
Возобновляется команда ОТРЕЗОК.
Следующая точка или [оТменить]:
(478607.0 7.48624e+006 0.0)
Следующая точка или [оТменить]:

И продолжается дальше цикл соединения линии (если нужно дальше строить линии)

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

В ответ на запрос

Сообщение от Pavel_GP Следующая точка или [оТменить]:

что нажимаешь? То же самое и имитируй в коде

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc В ответ на запрос что нажимаешь? То же самое и имитируй в коде

Код:

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

 1    (defun C:setka_gk ()
2    (command "_.line" "_'LL")
3    (command "67 27 10")
4    (command "86 30 00")
5    (command "67 27 50")
6    (command "86 30 00")
7    )

Так в коде и прописано следущее 67 27 50 (широта), а команда прописывает:
Команда: SETKA_GK
_.line Первая точка:
Текущая единица изменения широты/долготы: градусы; ввод: ГГ° ММ' СС.СС" (с
пробелами)
>>Введите широту <С067° 00' 00.00">: 67 27 10
>>Введите долготу <В027° 00' 00.00">: 86 30 00
Возобновляется команда SETKA_GK.
Первая точка: 67 27 50
Неверная точка.
; ошибка: Функция отменена
эти 3 строки он не должен писать
Первая точка:
(478597.0 7.48494e+006 0.0)
Следующая точка или [оТменить]:
Текущая единица изменения широты/долготы: градусы; ввод: ГГ° ММ' СС.СС" (с
пробелами)
>>Введите широту <С067° 27' 10.00">: а должно сюда прописывать 67 27 50

Показываю как я строю линию самостоятельно при вводе в командную строку:
_.Line "Enter"
_'LL "Enter"
67 27 10 "Enter"
86 30 00 "Enter"
67 27 50 "Enter"
86 30 00 "Enter"
Esc

Линия построена


Первая точка:
(478597.0 7.48494e+006 0.0)
Вот эти цифры - это программа переводит из географических в прямоугольные координаты. Потомучто Автокад - это прямоугольная система.

Есть конечно еще вариант но он долгий:
Забивать в код функцию перевода из географических в прямоугольные - не применяя функцию _'LL
Но мне все таки охота чтоб вопрос решился через функции заложенные в Автокаде, а именно в Civil"е"

[AlexSheep]

Сообщение от Pavel_GP Возобновляется команда SETKA_GK. Первая точка: 67 27 50 Неверная точка. ; ошибка: Функция отменена эти 3 строки он не должен писать

Я бы даже сказал что он не должен писать 4 строки, потому как команда SETKA_GK, по идее, возобновляться не должна..... все-таки странная эта опция "_'LL".... проверить негде, Civil'а нет

[Li6-D]

Сообщение от Pavel_GP Есть конечно еще вариант но он долгий: Забивать в код функцию перевода из географических в прямоугольные - не применяя функцию _'LL Но мне все таки охота чтоб вопрос решился через функции заложенные в Автокаде, а именно в Civil"е"

Попробуй поставить двойные кавычки "" в конце (command "_.Line" "_.'LL" "_None" "67 27 10" "_None" "86 30 00" ... ''"), чтобы команда завершилась, а не запросила очередную точку. Для рисования замкнутого контура из отрезков в конце можно поставить "_Close".

[Pavel_GP]

Код:

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

 (defun C:FL_to_XY ()
  (setq fs_grad (getreal "\nВведите градусы южной широты: "))
  (setq fs_min (getreal "\nВведите минуты южной широты: "))
  (setq shir_s (+ (/ fs_min 60) fs_grad))
  (setq shir_sr (* pi (/ shir_s 180.0)))
  (setq lw_grad (getreal "\nВведите градусы западной долготы: "))
  (setq lw_min (getreal "\nВведите минуты западной долготы: "))
  (setq dolg_w (+ (/ lw_min 60) lw_grad))
  (setq    nz (fix (/ (+ 6 dolg_w) 6))
  )
  (setq    L (/ (- dolg_w (+ 3 (* 6 (- nz 1)))) 57.2957951)
  )
  (setq    A (* (expt L 2)
         (-    (+ (- 109500
              (* 574700 (expt (sin shir_sr) 2))
           )
           (* 863700 (expt (sin shir_sr) 4))
        )
        (* 398600 (expt (sin shir_sr) 6))
         )
      )
  )
  (setq    B (* (expt L 2)
         (-    (+ (- 278194
              (* 830174 (expt (sin shir_sr) 2))
           )
           (* 572434 (expt (sin shir_sr) 4))
        )
        (* 16010 (expt (sin shir_sr) 6))
         )
      )
  )
  (setq    C (* (expt L 2)
         (-    (+ (- 672483.4
              (* 811219.9 (expt (sin shir_sr) 2))
           )
           (* 5420 (expt (sin shir_sr) 4))
        )
        (* 10.6 (expt (sin shir_sr) 6))
         )
      )
  )
  (setq    D (* (expt L 2)
         (+    (+ (+ 1594561.25
              (* 5336.535 (expt (sin shir_sr) 2))
           )
           (* 26.79 (expt (sin shir_sr) 4))
        )
        (* 0.149 (expt (sin shir_sr) 6))
         )
      )
  )
  (setq    E (+ (+ 16002.89 (* 66.9607 (expt (sin shir_sr) 2)))
         (* 0.3515 (expt (sin shir_sr) 4))
      )
  )
  (setq    F (* (sin (* shir_sr 2))
         (+ (+ (+ (- E D) C) B) A)
      )
  )
  (setq    Y (- (* 6367558.4968 shir_sr) F)
  )

  (setq    G (* (expt L 2)
         (-    (+ (- 79690
              (* 866190 (expt (sin shir_sr) 2))
           )
           (* 1730360 (expt (sin shir_sr) 4))
        )
        (* 945460 (expt (sin shir_sr) 6))
         )
      )
  )
  (setq    H (* (expt L 2)
         (-    (+ (- 270806
              (* 1523417 (expt (sin shir_sr) 2))
           )
           (* 1327645 (expt (sin shir_sr) 4))
        )
        (* 21701 (expt (sin shir_sr) 6))
         )
      )
  )
  (setq    J (* (expt L 2)
         (-    (+ (- 1070204.16
              (* 2136826.66 (expt (sin shir_sr) 2))
           )
           (* 17.98 (expt (sin shir_sr) 4))
        )
        (* 11.99 (expt (sin shir_sr) 6))
         )
      )
  )
  (setq    K (+ (+    (+ 6378245
           (* 21346.1415 (expt (sin shir_sr) 2))
        )
        (* 107.1590 (expt (sin shir_sr) 4))
         )
         (* 0.5977 (expt (sin shir_sr) 6))
      )
  )
  (setq    M (* (* L (cos shir_sr))
         (+ (+ (- K J) H) G)
      )
  )
  (setq    X (+ 500000 M)
  )
  (command "_.point" X Y)
  (command "")
)

Перевел формулу перехода их географических в прямоугольные в код

Необходимо построить "точку", опять что-то не строится - формула работает, а вот что-то не так ввожу команду при построении точки.
Посмотрите (точку нужно построить по данным X Y).
Вывод Y находится в 061 строке
X находится в 106 строке
Посмотрите плз в самой команде построение точки - я все правильно написал ( я ток учусь лиспу под свое ремесло - извините)

П.С. Модераторы прошу Вас создать отдельную тему Лисп - Civil и перенести туда все мои вопросы и тех кто отвечал на них в новую тему. Спс.

[Лиспер]

Это не лисп-код, а html вдобавок полно крякозябр вместо русского текста.

[Pavel_GP]

Сообщение от Лиспер Это не лисп-код, а html вдобавок полно крякозябр вместо русского текста.

Перейди со страницы на страницу (84 на 83 и обратно)- крякозябр изчезнет =)

Я просто сразу в Civil"е" писал.=), в это разделе сам код я не даю на рассмотрение - дело в другом - точка

Если нужно код закину сюда в txt

[Лиспер]

Сравни:

Код:

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

_$ (setq fs_min 1)
(/ fs_min 60)
1
0
_$ (setq fs_min 1)
(/ fs_min 60.)
1
0.0166667

P.S. Привязку перед командой кто снимать будет?
P.P.S. Строку (command "_.point" ... можно запросто заменить на (entmakex (list '(0 . "POINT") (cons 10 (list x y))))

[Li6-D]

Сообщение от Pavel_GP Посмотрите плз в самой команде построение точки - я все правильно написал ( я ток учусь лиспу под свое ремесло - извините)

И еще, в 108-ой строке напиши так: (command "_.Point" (list X Y))
Cтрочку ниже можно убрать - при рисовании точки она необязательна.

Посмотри еще здесь

[Pavel_GP]

Сообщение от Лиспер P.S. Привязку перед командой кто снимать будет? P.P.S. Строку (command "_.point" ... можно запросто заменить на (entmakex (list '(0 . "POINT") (cons 10 (list x y)))) __________________

Сообщение от Li6-D И еще, в 108-ой строке напиши так: (command "_.Point" (list X Y)) Cтрочку ниже можно убрать - при рисовании точки она необязательна.

Спс. Точка строится.

Пысы Будут еще вопросы (далеко не убегайте =))

преобразовал формулы в другой код более понятный для меня =)

Код:

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

 ;для WGS84
(defun C:FL_to_XY ()
  (setq fs_grad (getreal "\nВведите градусы южной широты: "))
  (setq fs_min (getreal "\nВведите минуты южной широты: "))
  (setq fs_sek (getreal "\nВведите секунды южной широты: "))
                    ;перевод широты в радианы
  (setq    shir_r (/ (* (+    (+ fs_grad (/ fs_min 60.))
            (/ fs_sek 3600.)
             )
             pi
          )
          180.
           )
  )
  (setq lw_grad (getreal "\nВведите градусы западной долготы: "))
  (setq lw_min (getreal "\nВведите минуты западной долготы: "))
  (setq lw_sek (getreal "\nВведите секунды западной долготы: "))
  (setq    dolg (+    (+ lw_grad (/ lw_min 60.)) ;перевод долготы в градусы
        (/ lw_sek 3600.)
         )
  )
  (setq dolg_r (/ (* dolg pi) 180.))    ;перевод долготы в радианы
  (setq    nz (fix (/ (+ 6. dolg) 6.))    ;номер зоны
  )
  (setq    L (/ (* (+ 3. (* 6. (- nz 1.))) pi) 180.) ;Осевой меридиан
  )
  (setq a 6378137.0)            ;большая полуось
  (setq f (/ 1. 298.25722356))        ;полярное сжатие
  (setq e2 (* f (- 2. f)))        ; 1-й эксцентриситет
  (setq e4 (expt e2 2.))
  (setq e6 (* e2 e4))
  (setq e_2 (/ e2 (- 1. e2)))        ;2-й эксцентриситет
  (setq sf2 (expt (sin shir_r) 2.))
  (setq cf2 (expt (cos shir_r) 2.))
  (setq tg (/ (sin shir_r) (cos shir_r)))
  (setq tg2 (/ sf2 cf2))
  (setq N (/ a (sqrt (- 1. (* e2 sf2)))))
  (setq c (* e_2 cf2))
  (setq A_1 (* (- dolg_r L) (cos shir_r)))
  (setq    M (* a
         (-    (+ (- (* (- (- (- 1.(/ e2 4.))
                   (/ (* 3. e4) 64.)
                )
                (/ (* 5. e6) 256.)
             )
             shir_r
              )
              (* (+ (+ (/ (* 3. e2) 8.)
                   (/ (* 3. e4) 32.)
                )
                (/ (* 45. e6) 1024.)
             )
             (sin
               (* 2. shir_r)
             )
              )
           )
           (* (+ (/ (* 15. e4) 256.)
             (/ (* 45. e6) 1024.)
              )
              (sin
            (* 4. shir_r)
              )
           )
        )
        (* (/ (* 35. e6) 3072.) (sin (* 6. shir_r)))
         )
      )
  )
  (setq    Y_1 (* N
           (+ (+ A_1
             (*    (+ (- 1. tg2) c)
            (/ (expt A_1 3.) 6.)
             )
          )
          (* (-    (+ (+ (- 5. (* 18. tg2))
                  (expt tg2 2.)
               )
               (* 72. c)
            )
            (* 58. e_2)
             )
             (/ (expt A_1 5.) 120.)
          )
           )
        )
  )
  (setq    X (+ M
         (*    (* N tg)
        (+ (+ (/ (expt A_1 2.) 2.)
              (* (+ (+ (- 5. tg2)
                   (* 9. c)
                )
                (* 4. (expt c 2.))
             )
             (/ (expt A_1 4.) 24.)
              )
           )
           (* (- (+ (+ (- 61. (* 58. tg2))
                   (expt tg2 2.)
                )
                (* 600. c)
             )
             (* 330. e_2)
              )
              (/ (expt A_1 6.) 720.)
           )
        )
         )
      )
  )
  (setq    Y (+ 500000.0 Y_1)
  )
  (command "_.Point" "_none" (list Y X))
)

Вопрос1. Как построить несколько точек, не используя постоянно многоэтажную формулу для каждой точки?
Вопрос2. Как выделить все объекты с помощью команды в лиспе?

Спс.

[AMATOP]

Извините, за тупость обильно приправленную, увы, ленью, но ... как создать пустой список?
Т.е. переменная, типа список, есть, но внутри ничего нет! Другими словами, это как перед входом в супермаркет - нужно взять тележку, но пустую. А в LISP-е у меня получаеться только тогда, когда в "тележку" какой-нибудь "мусор" закинешь!

[Oliver_88]

Вот это явно подзадача. Хотелось бы услышать саму задачу.
Я по глупости так делал когда-то

Код:

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

 (setq lst '())

[AMATOP]

Спасибо за оперативность, все сраслось!
Вот:

Код:

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

 (setq spisok '())
(setq nabor (ssget))
(setq kolvo (sslength nabor))
(while (<= 0 kolvo)
  (setq kolvo(1- kolvo))
(vl-load-com)
(setq object (ssname nabor kolvo))
(setq spisok (append (list (vlax-get-property (vlax-ename->vla-object object) 'Angle)) spisok)))

О! Так намного изящней! Еще раз громаднейшее спасибо!
Это я про код в следующем посте от Oliver_88

[Oliver_88]

Код:

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

     (setq nabor (ssget))
    (setq kolvo (sslength nabor))
    (while (< 0 kolvo)
      (setq kolvo (1- kolvo))
      (vl-load-com)
      (setq object (ssname nabor kolvo))
      (setq spisok (cons (vlax-get-property (vlax-ename->vla-object object) 'Angle) spisok))
      )

[gomer]

Сообщение от AMATOP Вот:

бред какой-то
ВОТ:

Код:

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

 (if (setq ss (ssget '((0 . "LINE"))))
  (mapcar
   '(lambda (x)
	  (angle (cdr (assoc 10 x)) (cdr (assoc 11 x)))
	)
	(mapcar
	  'entget
	  (vl-remove-if
	  'listp
	  (mapcar 'cadr (ssnamex ss))
	  )
	)
  )
)

[Li6-D]

Сообщение от AMATOP Извините, за тупость обильно приправленную, увы, ленью, но ... как создать пустой список? Т.е. переменная, типа список, есть, но внутри ничего нет! Другими словами, это как перед входом в супермаркет - нужно взять тележку, но пустую. А в LISP-е у меня получаеться только тогда, когда в "тележку" какой-нибудь "мусор" закинешь!

nil - и есть пустой список во всех функциях обработки списков (такой же как '() или (list)):
(cons 0 nil) возвращает (0).
Если переменной значение еще не присваивалось, то она и есть уже готовый пустой список.
Кроме того, nil в некоторых логических функциях (<, <=, >, >=, /=) ведет себя как минус бесконечность:
(> -999999999. nil) возвращает T.

Сообщение от Oliver_88 Код: [Выделить все] (setq nabor (ssget)) (setq kolvo (sslength nabor)) (while (< 0 kolvo) (setq kolvo (1- kolvo)) (vl-load-com) (setq object (ssname nabor kolvo)) (setq spisok (cons (vlax-get-property (vlax-ename->vla-object object) 'Angle) spisok)) )

Нет проверки того, что объекты в выборке имеют свойство 'Angle - от этого и ошибка. Надо или проверять с помощью vlax-property-available-p или использовать в ssget фильтр для примитивов нужного типа, например, отрезков (см. сообщение выше).
Зачем (vl-load-com) включать в цикл?
В третей строке раньше правильно было:
(while (<= 0 kolvo)
А еще правильней вместо while применить repeat.
Нет проверки того, что nabor не nil (если пользователь ответил пустым вводом), поэтому возможна ошибка:
Команда: (sslength (ssget))
Выберите объекты:
; ошибка: неверный тип аргумента: lselsetp nil
Без фильтра:

Код:

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

 ((lambda (ss / i spisok obj)
   (vl-load-com)
   (repeat (if ss (setq i (sslength ss)) 0)
     (setq i (1- i)
           obj (vlax-ename->vla-object (ssname ss i)))
     (if (vlax-property-available-p obj 'Angle)
       (setq spisok (cons (vlax-get-property obj 'Angle) spisok))
   ) )
   spisok
 )
 (ssget)
)

[AMATOP]

Сообщение от gomer бред какой-то

Во-первых спасибо, за код отвечающий всем правилам "этикета" - почерпнул для себя много полезного!Правда, не понял зачем еще этот предохранитель:

Код:

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

  (vl-remove-if
	  'listp
	  (mapcar 'cadr (ssnamex ss))
	  )

Во-вторых:"Мы все учились понемногу,
Чему-нибудь и как-нибудь..."
Ну и (набравшись наглости) в третьих: предлагаю блиц "Что? Где? Когда?" А именно: есть куча 3D solids. Нужно проверить каждый на соответсвие определению прямоугольного параллелепипеда. И те что не прямоугольные, снабдить расширенными данными - мол, уродцы.Буду признателен за любые алгоритмы, ну а за код не совестно и в ноги поклониться!

@ Li6-D - спасибо большущее! Для меня это важная новость.

[Oliver_88]

Вот еще что-то такое

Код:

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

   (vl-load-com)
  (setq ssl
	 (vla-get-ActiveSelectionSet
	   (vla-get-activedocument
	     (vlax-get-acad-object)
	     )
	   )
	)
  (vla-Clear ssl)
  (setq i -1)
  (if
    (and
      (not
	(vl-catch-all-error-p
	  (vl-catch-all-apply
	    'vla-SelectOnScreen
	    (list ssl (vlax-safearray-fill
			(vlax-make-safearray
			  vlax-vbInteger
			  (cons 0  0)
			  )
			(list 0)
			)
		  (vlax-safearray-fill
		    (vlax-make-safearray
		      vlax-vbVariant
		      (cons 0  0)
		      )
		    (list "LINE")
		    )
		  )
	    )
	  )
	)
      (/= 0 (vla-get-Count ssl))
      )
    (progn
      (setq arr (vlax-make-safearray
		  vlax-vbDouble
		  (cons 0  (1- (vla-get-Count ssl)))
		  )
	    )
      (vlax-map-collection ssl
	(function
	  (lambda (x)
	    (setq i (1+ i))
	    (vlax-safearray-put-element
	      arr
	      i
	      (vla-get-Angle x)
	      )
	    )
	  )
	)
      (vlax-safearray->list arr)
      )
    )

Li-6D

В третей строке раньше правильно было: (while (<= 0 kolvo)

Вот почему то именно это у меня даёт ошибку
; ошибка: неверный тип аргумента: lentityp nil
Поэтому и поменял на <.
С остальными замечаниями полностью согласен.

[gomer]

Сообщение от AMATOP Правда, не понял зачем еще этот предохранитель:

это не предохранитель, а преобразователь набора в список... обычно является частью библиотечных функций... с их использованием еще все лаконичнее

Код:

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

 if (setq ss (ssget '((0 . "LINE"))))
  (mapcar
   '(lambda (x)
	  (angle (dxf 10 x) (dxf 11 x))
	)
	(ss->list ss)
  )
)

ваша ошибка в постановке задачи... угол не может существовать без точек + свойство Angle есть только у отрезков (зная точки можно найти угол) + куча холостых vl-load-com в цыкле и пребразований из типа в тип
Oliver_88, посмотрите на свой код и на мой... Стоит ли овчинка выделки? Не все то золото, что пропиарили... единственное преимущество вашего - реакция на Esc... с помощью библиотечных функций это делается в две строки тем более, что скорости вам иксы не прибавят, данном случае

[Oliver_88]

Offtop: gomer, написал как вариант. Ничего личного.

[gomer]

Сообщение от Oliver_88 написал как вариант

ActiveX - вотчина vba... Там по другому нельзя! Задача же элементарная: берем отрезки и для каждого вычисляем угол...

[AMATOP]

Сообщение от gomer это не предохранитель, а преобразователь набора в список...

Я имел в виду:

Код:

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

   (vl-remove-if
	  'listp...

Ведь mapcar уже даст на выходе список!? Зачем проверка с очисткой?

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

А ты проверь

[AMATOP]

Да, поспешил! - Поленился сначала протянуть до конца строку в окне консоли.

[Michael!]

Доброго времени суток!
Подскажите, какая команда существует в Visual Lisp для выбора последнего отрисованного элемента?
спасибо!

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

entlast, кажется...

[Michael!]

я видимо не так сформулировал вопрос. я хотел через VLA. какой там синтаксис?

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

Если создание объекта (черт, два литра пива дают о себе знать...) выполняется через vla-, то результат создания объекта уже и есть указатель на созданный объект. Я не очень понимаю - в чем, собственно, трудность-то?

[Michael!]

пиво в малых дозах полезно в любых количествах .
дело то вот в чем: я хочу выбрать мин и мах точки у замкнутого контура. знаю как это сделать через VLA (vla-GetBoundingBox obj 'minpoint 'maxpoint). поэтому мне нужно выбрать объект через VLA. он создается копированием. поэтому хочу взять этот OBJ так. (типо как entlast в лиспе).

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

Попробуй так:
(setq res (vla-copy ....
А потом дампить res. Проверить сейчас уже не могу, спать сильно хочу. Если что - днем попробую проверить...

[Michael!]

ладно. до завтра. все равно ничего не понял
в любом случае спасибо!

[Oliver_88]

Код:

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

 (vla-Item (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
	  (1- (vla-get-Count (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))))
	  )

Если рисуешь в листе, нужно заменить vla-get-modelspace на vla-get-paperspace.

[TararykovDG]

Сообщение от Michael! поэтому хочу взять этот OBJ так. (типо как entlast в лиспе).

Ну так и возьми тупо

Код:

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

 
(vlax-ename->vla-object (entlast))

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

Вариант 1:

Код:

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

 (vlax-ename->vla-object (entlast))

Вариант 2:

Код:

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

 (setq res (vla-copy (vlax-ename->vla-object (car (entsel)))))
(vla-move res (vlax-3d-point (getpoint "\nBase point : ")) (vlax-3d-point (getpoint "\nSource point : ")))

[Michael!]

Спасибо всем!
сделал так:

Код:

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

 (setq obj (vlax-ename->vla-object (entlast)))
(vla-GetBoundingBox obj 'minpoint 'maxpoint)
(setq minb(vlax-safearray->list minpoint))
(setq maxb(vlax-safearray->list maxpoint))

работает

[gomer]

Если

Сообщение от Michael! он создается копированием

через ActiveX, то первая строка не нужна

[Michael!]

наверное только я тут вопросы задаю
проблемка сейчас возникла такая:
схраняю в файл dxf некоторое количество примитивов. выбираю рамкой все, а потом на что ненужное снимаю выделение.

Код:

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

 
(command "saveas" "dxf" "objects" "w" pause pause pause "version" ver "16" filename)

(тут version и filename переменные)
но как то неправильно тут, потому прога не ждет пока я закончу с выделениями и нажму enter или правую кнопку, а сразу переходит на шаг вперед, в результате неправильное выполнение команды.
подскажите, как написать чтобы программа ожидала окончания работ по выделению или снятия выделения с примитивов.
спасибо!

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

(setq ss (ssget))
(command "_.-saveas" "dxf" "_objects" ss "" "version" ver "16" filename)

Наверное, так...

[Michael!]

спасибо! то что нужно.

[Vladimir_Sergeevich]

Подскажите пожалуйста, можно ли из такого бреда:

"<p align=\"center\" style=\" margin-top:0px; margin-bottom:0px; margin-left:0px; margin-right:0px; -qt-block-indent:0; text-indent:0px;\"><span style=\" font-family:'Arial'; font-size:10pt; color:#000000;\">176,98</span></p></td>"

вытащить число 176,98?
Опыта пока нет, мозг пасует...

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

Как вариант - преобразовать строку в список по разделите span и вытащить второй элемент.
Пишу с телефона, так что кода не будет

[Дима_]

Как html получили? Быть может применить методы "долиспового" распознавания, ведь совсем не факт, что форматирование "там" никогда не изменится.
Там </td> виднеется - я б через таблицы пошел.

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

Судя по стилю html-кода, он сформирован автоматически чем-нибудь типа MS Word. Или FrontPage. Так что "долисповое" распознавание вряд ли сработает

[Дима_]

Тады тем более - может обратится к "из чего сформирован".

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

Дима_, да в Word'e просто наколотили текст, а потом страницу сохранили как html... Тоже вариант (с)

[Дима_]

Если так - то для чего это сделано (может - чтоб лиспом можно было вытащить - бывают и такие "деятели" встречаются). Разбирать из-за вылавливания пары чисел весь синтаксис HTML автолиспом я бы точно не стал (а не разбирая ВЕСЬ гарантий никаких не будет). Вариантов масса - обратится к первоисточнику (если это действительно Word), WebBrowser.Document.All... выбираем нужную табличку (пусть даже многократновложенную)... нужную ячейку...OuterText(или как он там - суть понятна) - короче вариантов масса.

[gomer]

Сообщение от Vladimir_Sergeevich Подскажите пожалуйста, можно ли из такого бреда:

Ctrl+A
Ctrl+C
Ctrl+V
Ctrl+S

[Vladimir_Sergeevich]

Эту таблицу выкидывает программа... для образца мне дали файлик на сотню+ точек, на каждую точку(строку таблицы) 6 значений (полей) мне бы разобраться как из строки вытащить искомый ткст, а там дальше разберусь...

[Дима_]

Твоя ведомость "на ура" открывается excel'ем - а уж как из него вытщить данные страниц 500 на форуме.
p.s. Offtop: По просьбе из лички

Код:

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

 (vl-load-com)
(defun html-export(path)
  ((lambda (excel)
     (vlax-invoke-method (vlax-get-property excel 'Workbooks) 'Open path)
     ((lambda (ret)
        (vlax-invoke-method excel 'Quit)
        ret)
      (mapcar '(lambda (row) (mapcar 'vlax-variant-value row))
              (vlax-safearray->list
               (vlax-variant-value
                (vlax-get-property
                 (vlax-get-property
                  (vlax-get-property
                   (vlax-get-property excel 'Worksheets) 'Item 1) 'UsedRange) 'Value))))))
   (vlax-create-object "excel.application")))

пример запуска

Код:

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

 ((lambda (path) (if path (html-export path)))
  (getfiled "Выберите файл" "" "html" 0))

Функция не конечная (не для юзера) - никаких проверок на наличие файла и пр - нет (сам делай).

[Michael!]

доброго времени суток!
образовался такой вопрос: как присвоить значение имеющееся в данный момент в буфере обмена виндовс (например "тест109") переменной в лиспе?
спасибо!

[VVA]

>Michael!
Воспользоваться поиском по сочетанию "буфер обмена"

[Дима_]

"Прямого" метода доступа к буферу обмена в автолиспе нет, есть команды для вставки в рисунок содержимого буфера (не обязательно текста) - то есть можно попробывать что-то вроде:

Код:

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

 (defun get-text-clipboard ()
  ((lambda (ent-last)
     (command "_.pasteclip" '(0 0))
     (if (not (equal ent-last (entlast)))
         ((lambda (text)
            (entdel (entlast))
            text)
          (cdr (assoc 1 (entget (entlast)))))))
   (entlast)))

но, метод этот скажем прямо - только если от безисходности, как вариант погуглить (а они 100% были) специальные COM dll'ки для работы с буфером обмена и использовать их через vla, ну или загружать net сборку:

Код:

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

module Clipboard.Clip
  open System.Windows.Forms
  open Autodesk.AutoCAD.DatabaseServices
  open Autodesk.AutoCAD.Runtime
  [<LispFunction("GetTextClipboard")>]
  let Test (x:ResultBuffer) =
      TypedValue(5005,Clipboard.GetText())

это F# - могу скомпилировать только под 2010 (другого сейчас нет - как скомпилировать самому - без труда найдешь в сети) - после загрузки появиться lisp команда (GetTextClipboard) возвращающая текстовое содержимое буфера обмена (или "" - если пусто).

как присвоить значение имеющееся в данный момент в буфере обмена виндовс (например "тест109") переменной в лиспе?

все таки видимо это неизлечимая очень заразная болезнь - почему если нужно какое нибудь значение - его обязательно надо присваивать переменной?

[VVA]

Сообщение от Дима_ после загрузки появиться lisp команда (GetTextClipboard) возвращающая текстовое содержимое буфера обмена (или "" - если пусто)

Можно и без F# До текста в буфере обмена можно добраться с помощь объекта InternetExplorer.Application (хуже) и htmlfile (предпочтительнее)

[Дима_]

Сообщение от VVA InternetExplorer.Application (хуже) и htmlfile (предпочтительнее)

то VVA - Да сам я этот Net (в разрезе автокада) недолюбливаю, но иногда "приходиться", ежели у Вас есть набор ссылок на "интересные" COM'ы (которые и так предустановленны "на каждом" компьютере) - сбростье мне (можно сюда), а то иной раз не хочется ни к чему "дополнительному" привязываться, да и на лиспе "городить" типа кода из предыдущего поста.

[Michael!]

Спасибо!
Вариант Димы со вставкой и последующим стиранием мне больше всего понравился изза его простоты. да и мне нужно только тексты вставлять так.
Еще раз спасибо всем откликнувшимся.

[Eghor123]

Сообщение от VVA Дальше Tools (Сервис) -> Load text in editor (Загрузить текст в редактор) (или Ctrl+Alt+E)

вот хоть убейте - нет такого. Акад 2012. консоль vlide - хз. как ей пользоваться?

[VVA]

Сообщение от Eghor123 консоль vlide - хз. как ей пользоваться

В интернете достаточно много про это уже написано
Полезности в редакторе VLIDE
Среда Visual LISP

[Eghor123]

VVA, спасибо. будем посмотреть)

[Eghor123]

Основываясь на коде от Кулик Алексей aka kpblc, написал такую вещь. вроде работает. у меня есть вопрос - если я делаю obj локальной переменной, и строку, выделенную синим, пишу без условного оператора if, то команда работает только один раз (как я понял - (vla-get-ActiveSelectionSet actdoc) не может быть выполнено второй раз, после первого выполнения команды). а в чем проблема - я не понимаю...

а вообще - это одно из моих первых творений, и явно далеко не совершенное. так что критика могла бы мне помочь в дальнейшем)))

еще - можно ли в фильтр выбора поставить effectivename, и как это сделать?

Код:

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

(defun c:test ( / actdoc  i n x1 x2 ent1 ent prop value value1)


(vl-load-com)

(setq actdoc (vla-get-activedocument (vlax-get-acad-object)))
(if (not obj) 
    (setq obj (vla-get-ActiveSelectionSet actdoc))
) ;_ end of if
(vla-clear obj)

(vla-selectOnScreen obj
  (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
  (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) '("INSERT")))

(setq i -1
      n 1)
(setq n (vla-get-count obj))

(vla-startundomark actdoc) ;_ end of vla-StartUndoMark



(repeat n
        (setq ent (vla-item obj (setq i (1+ i))))

(if (= (vla-get-effectivename ent) "сварка")
    (progn
        (setq x1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint ent))))
        (setq x2 (polar x1 (/ pi 2) 10))


        (setq ent1
                   (vla-mirror ent (vlax-3d-point x1) (vlax-3d-point x2))
        );_ end of setq

       (vla-delete ent)

       (setq prop 
                  (car (vl-remove-if-not
                         '(lambda (x)
                            (= (strcase (vla-get-propertyname x))
                               (strcase "Отраженное состояние2")
                            ) ;_ end of =
                          ) ;_ end of lambda
                          (vlax-safearray->list
                            (vlax-variant-value
                              (vla-getdynamicblockproperties ent1)
                            ) ;_ end of vlax-variant-value
                          ) ;_ end of vlax-safearray->list
                        ) ;_ end of vl-remove-if-not
                  ) ;_ end of car
       ) ;_ end of setq

       (setq value
                   (vlax-variant-value (vla-get-value prop))
       ) ;_ end of setq 

       (if (= value 0)
           (setq value1 1)
           (setq value1 0)
       ) ;_ end of if 

       (vla-put-value prop                                        
                      (vlax-make-variant value1                                     
                                         (vlax-variant-type (vla-get-value prop))  
                      ) ;_ end of vlax-make-variant
       ) ;_ end of vla-put-value

       (vla-update ent1)   
) ;_ end of progn                          
) ;_ end of if
) ;_ end of repeat

(vla-endundomark actdoc)

(princ "\nВсе блоки обработаны")
(princ)
) ;_ end of defun

[VVA]

Сообщение от Eghor123 только один раз (как я понял - (vla-get-ActiveSelectionSet actdoc) не может быть выполнено второй раз, после первого выполнения команды)

почитай тему ssget и vla-get-ActiveSelectionSet особенно пост #7. Может поможет

[Eghor123]

VVA, не помогла. да и шут с ним. через ssget сдалал.

Вот можно ли фильтр по effectivename сделать? чтоб в набор попадали только нужные блоки, а не все??. работает впринципе и так. просто интересно, может еще и понадобится где)

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

Вроде на болоте было решение, которое потом здесь публиковалось... VVA, кажется, показывал.

[Eghor123]

что такое болото?

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

theswamp.org. Для просмотра кодов на этом ресурсе требуется регистрация,

[Eghor123]

так работает

Код:

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

(setq temp (vlax-make-safearray vlax-vbObject '(0 . 2)))
(vlax-safearray-put-element temp 0 arc1)
(vlax-safearray-put-element temp 1 arc2)
(vlax-safearray-put-element temp 2 arc3)

а как сделать так:

Код:

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

(setq temp (vlax-safearray-fill (vlax-make-safearray vlax-vbObject '(0 . 2))

?

[Дима_]

Ну было б не плохо, чтоб ты объянил что нужно-то получить - если vla массив то в твоем случае

Код:

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

 (vlax-safearray-fill (vlax-make-safearray vlax-vbObject '(0 . 2)) (list arc1 arc2 arc3))

[Олег (jr.)]

Сообщение от Eghor123 VVA, не помогла. да и шут с ним. через ssget сдалал. Вот можно ли фильтр по effectivename сделать? чтоб в набор попадали только нужные блоки, а не все??. работает впринципе и так. просто интересно, может еще и понадобится где)

Нет, нельзя
Но можно укоротить путь выбора используя такую маску фильтра:
(ssget (list (cons 0 "insert")(cons 2 "`U*,MyDynamicBlockName"))
обрати внимание в начале стоит наклонная кавычка, а не прямая, U* означает
анонимный блок
Теперь в наборе только твои блоки "MyDynamicBlockName" плюс анонимные,
и остается только по ходу проверить соответствует ли свойство effectivename
имени твоего блока

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

Только, наверное, все же
(ssget (list (cons 0 "insert")(cons 2 "`*U*,MyDynamicBlockName"))
??

[VVA]

Сообщение от Олег (jr.) Нет, нельзя Но можно укоротить путь выбора используя такую маску фильтра: (ssget (list (cons 0 "insert")(cons 2 "`U*,MyDynamicBlockName")) обрати внимание в начале стоит наклонная кавычка, а не прямая, U* означает анонимный блок Теперь в наборе только твои блоки "MyDynamicBlockName" плюс анонимные, и остается только по ходу проверить соответствует ли свойство effectivename имени твоего блока

Чистым ssget см. #1730, а с небольшой добавочкой можно
Пример вызова

Код:

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

 (SSSETFIRST nil (GetBlockSelection "EFFECTIVE_BLOCK_NAME"))
;;;Где EFFECTIVE_BLOCK_NAME - имя блока

Код:

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

(defun GetBlockSelection ( name )
    (ssget "_X"
        (list
           '(0 . "INSERT")
            (cons 2
                (apply 'strcat
                    (cons name
                        (mapcar
                            (function (lambda ( x ) (strcat ",`" x)))
                            (LM:GetAnonymousReferences name)
                        )
                    )
                )
            )
        )
    )
)

;;--------------=={ Get Anonymous References }==--------------;;
;;                                                            ;;
;;  Returns the names of all anonymous references of a block. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  name - block name for which to return anon. references    ;;
;;------------------------------------------------------------;;
;;  Returns:  List of Anonymous Block names, else nil if none ;;
;;------------------------------------------------------------;;

(defun LM:GetAnonymousReferences ( name / ano def lst rec ref )
    (setq name (strcase name))
    (while (setq def (tblnext "BLOCK" (null def)))
        (if
            (and
                (= 1 (logand 1 (cdr (assoc 70 def))))
                (setq rec
                    (entget
                        (cdr
                            (assoc 330
                                (entget
                                    (tblobjname "BLOCK"
                                        (setq ano (cdr (assoc 2 def)))
                                    )
                                )
                            )
                        )
                    )
                )
            )
            (while
                (and
                    (not (member ano lst))
                    (setq ref (assoc 331 rec))
                )
                (if
                    (and
                        (entget (cdr ref))
                        (eq name (strcase (LM:EffectiveName (cdr ref))))
                    )
                    (setq lst (cons ano lst))
                )
                (setq rec (cdr (member (assoc 331 rec) rec)))
            )
        )
    )
    (reverse lst)
)
                        
;;----------------=={ Effective Block Name }==----------------;;
;;                                                            ;;
;;  Returns the effective name of a block.                    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  blockentity - Block Reference Entity name                 ;;
;;------------------------------------------------------------;;
;;  Returns:  True block name as per the block definition     ;;
;;------------------------------------------------------------;;

(defun LM:EffectiveName ( blockentity / name repbtag )
    (if (wcmatch (setq name (cdr (assoc 2 (entget blockentity)))) "`**")
        (if
            (and
                (setq repbtag
                    (cdadr
                        (assoc -3
                            (entget
                                (cdr
                                    (assoc 330
                                        (entget (tblobjname "BLOCK" name))
                                    )
                                )
                               '("AcDbBlockRepBTag")
                            )
                        )
                    )
                )
                (setq repbtag (handent (cdr (assoc 1005 repbtag))))
            )
            (setq name (cdr (assoc 2 (entget repbtag))))
        )
    )
    name
)

[Eghor123]

Дима_, ну да. создать vla массив и заполнить его. не хватает мне знаний пока. я первый код написал с месяц назад всего.
спасибо работает.

VVA, что значит преффикс LM: ?

[VVA]

Сообщение от Eghor123 VVA, что значит преффикс LM: ?

Lee Mac

[La Persona]

Доброго времени суток! Дабы не захламлять форум лишней темой, спрошу тут.
Необходимо создать несколько списков:

Код:

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

 
(setq list_1 (list coord_ku_1 measure_num_1)
      list_2 (list coord_ku_2 measure_num_2)
      .......
      list_n (list coord_ku_n measure_num_n)
)

Проблема в том, что заранее число n неизвестно, оно задается непосредственно в начале программы через диалоговое окно DCL. Как создать n-ное количество списков с однотипными именами "list_n"?

[Дима_]

Сообщение от La Persona Как создать n-ное количество массивов с однотипными именами "list_n"

Поверьте на слово подход Вы пытаетесь "неверный" прикрутить - не надо плодить однотипные переменные - складывайте все "одинаковое" в список - причем если обрабатывать все равно все - то в простой, если выборочно - то в ассоциативный, лучше по уникальному ключу.

[La Persona]

Сообщение от Дима_ Поверьте на слово подход Вы пытаетесь "неверный" прикрутить - не надо плодить однотипные переменные - складывайте все "одинаковое" в список - причем если обрабатывать все равно все - то в простой, если выборочно - то в ассоциативный, лучше по уникальному ключу.

Спасибо за хорошую идею ) Как-то не сообразил сам

[La Persona]

Доброго всем времени суток! Подскажите, пожалуйста, почему значения num_cu и num_ou остаются пустыми? Код DCL и LISP приведены ниже.
Форма благополучно вызывается, забиваю значения, но переменные остаются пустыми..

Код:

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

 (defun num-dialog-handler( / dcl_id num_ou num_cu)
  (if (< (setq dcl_id (load_dialog "C:\\Documents and Settings\\user\\Ìîè äîêóìåíòû\\Automation LISP\\dialog_num.dcl")) 0) (exit))
  (if (not (new_dialog "dialog_num" dcl_id)) (exit))
  (setq num_cu (atoi (get_tile "kNum_cu")))
  (setq num_ou (atoi (get_tile "kNum_ou")))
  (setq num_list (list num_cu num_ou))
  (start_dialog)
  (unload_dialog dcl_id)
)

Код:

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

 
dialog_num: dialog {label="Êîëè÷åñòâî êðàíîâûõ óçëîâ è îòêðûòûõ ó÷àñòêîâ";
:edit_box{label="Êîëè÷åñòâî êðàíîâûõ óçëîâ"; key="kNum_cu";
	edit_width=12; edit_limit=24;}
:edit_box{label="Êîëè÷åñòâî îòêðûòûõ ó÷àñòêîâ"; key="kNum_ou";
	edit_width=12; edit_limit=24;}
ok_button;
}

[Дима_]

Вас порядок действий не смущает?

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

А в каком месте проверяешь? Это ж у тебя локальные переменные!

[gomer]

Сообщение от La Persona почему значения num_cu и num_ou остаются пустыми?

про action_tile не знал, да еще и забыл

[La Persona]

Сообщение от Дима_ Вас порядок действий не смущает?

А должен? О каком порядке идет речь?

Сообщение от Кулик Алексей aka kpblc А в каком месте проверяешь? Это ж у тебя локальные переменные!

По окну контрольных значений.

Сообщение от gomer про action_tile не знал, да еще и забыл

Разве (setq num_cu (get_tile "kNum_cu") не равнозначно (action_tile "kNum_cu" "(setq num_cu $value)")??

[gomer]

Сообщение от La Persona Разве (setq num_cu (get_tile "kNum_cu") не равнозначно (action_tile "kNum_cu" "(setq num_cu $value)")??

отнюдь, более того

Сообщение от La Persona (action_tile "kNum_cu" "(setq num_cu $value)")

это вообще моветон

в простых диалогах есть только два элемента, достойные action_tile - это кнопки accept и cancel (которой у вас нет, а она нужна, хотя бы потому, что пользователь должен иметь возможность отменить команду)

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

Offtop: Что значит дурная привычка использовать callback-функцию целиком на диалог!

[gomer]

ООП, каг бэ

[La Persona]

Сообщение от gomer ООП, каг бэ

Offtop: что наподобие )) .NETом все мозги уже замылились
Так что все-таки использовать: get_tile или action_tile? Если не затруднит - набросайте код, как примерно оно всё должно выглядеть.. Моё творения отказывается работать должным образом

[gomer]

La Persona, причем тут нет, вы должны понять что вообще происходит, тогда код сам напишется
по порядку грузим диалог, из файла назначаем кнопкам их действия, запускаем диалог, ждем выхода, отлавливая результат, выгружаем диалог
второй пункт подробнее: чтоб кнопка accept отловила значение полей ввода, ей нужно задать действие - отловить значения таких-то полей. Если перевести вышесказанное с русского на лисп, то можно увидеть, что и то и то нужно

[La Persona]

Сообщение от gomer по порядку грузим диалог, из файла назначаем кнопкам их действия, запускаем диалог, ждем выхода, отлавливая результат, выгружаем диалог второй пункт подробнее: чтоб кнопка accept отловила значение полей ввода, ей нужно задать действие - отловить значения таких-то полей. Если перевести вышесказанное с русского на лисп, то можно увидеть, что и то и то нужно

Благодарствую, подсказка помогла )
В итоге родилось это:

Код:

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

 (defun num-dialog-handler (/ dcl_id num_ou num_cu)
  (if (< (setq dcl_id (load_dialog "C:\\WK\\dialog_num.dcl")) 0)
    (exit)
  )
  (if (not (new_dialog "dialog_num" dcl_id))
    (exit)
  )
  (action_tile
    "accept"
    (strcat
      "(setq num_cu (get_tile \"kNum_cu\"))"
      "(setq num_ou (get_tile \"kNum_ou\"))"
      "(done_dialog)"
    )
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (setq num_list (list num_cu num_ou))
)

[gomer]

Сообщение от La Persona В итоге родилось это:

очень мило, а теперь попробуйте избавиться от абсолютного пути в имени файла диалога, одного setq, добавить кнопку отмена и ее обработчик (см. внимательно функции start_dialog и done_dialog) и наконец избавиться от num_list

[ShaggyDoc]

очень мило, а теперь попробуйте ....

...подумать, что будет гадать пользователь, если условия if будут выполняться. Функция будет молча не работать. Надо сообщения давать.

[dirge]

Всем привет! Ребят, есть такая задача. Опишу приведённое вложение в письме. Нужно соединить полилинии (geo_base и geo_extend), так чтобы можно было выбирать направление соединения, иными словами щёлкнули по базовой геометрии потом по той линии которую хотим удлинить и ещё раз либо справа от "мнимой" точки пересечения либо слева и вся геометрия повторилась по тем же координатам (синяя или зелёная линия). Вроде бы казалось ничего сложного, но есть момент который я не могу понять как решить. Вся засада в том, что заранее неизвестно в какой последовательности идут номера точек объектов, а ведь они могут идти и в обратном направлении, а это тогда получится совсем другая геометрия.

[Дима_]

Лично я ничего не понял - какие линии с чем соединять - попробуйте по шагам расписать - как должен получается результат (там может и сами ответ найдете).

[VVA]

Сообщение от dirge Вся засада в том, что заранее неизвестно в какой последовательности идут номера точек объектов, а ведь они могут идти и в обратном направлении

1. Можно узнать "в каком направлении" идет полилиния см. ф-цию lwcl
2. Принудительно преобразовать все полилинии к одному виду (ВСЕ по часовой или ВСЕ ПРОТИВ ЧАСОВОЙ). см. здесь или здесь

[dirge]

Сообщение от VVA 1. Можно узнать "в каком направлении" идет полилиния см. ф-цию lwcl 2. Принудительно преобразовать все полилинии к одному виду (ВСЕ по часовой или ВСЕ ПРОТИВ ЧАСОВОЙ). см. здесь или здесь

Большое спасибо за ссылки, направили на нужное русло меня.

[La Persona]

Здравствуйте! Подскажите, пожалуйста, как узнать координаты AttachmentPoint объекта MText?

Код:

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

     (setq mtext_obj (vla-AddMText
	    (vla-get-ModelSpace
	      (vla-get-ActiveDocument (vlax-get-acad-object))
	    ) ;_ end of vla-get-ModelSpace
	    (vlax-3D-point pt11) 20
	      (strcat
		"{\\A1;"
		(itoa k)
		"\\P"
		"замер"
		" }"
	      )
	  ) ;_ end of vla-AddMText
    ) ;_ end of setq
    (vla-put-AttachmentPoint mtext_obj acAttachmentPointBottomCenter)

[Никита Ремизов]

Здравствуйте! а можно ли как-нибудь в этом лиспе сделать так, чтобы задание "направления копирования" и "участка копирования" производилось в одно действие?

Код:

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

(defun C:MASSIV ()
(setvar "cmdecho" 0)
(setvar "osnapcoord" 1)
(prompt "\nВыберите объекты: ")
(setq old_error *error*)
(setq *error* ERR_)
(setq
     LL        (ssget)
     W         (entget (ssname LL 0))
     TN        (cdr (assoc 10 W))
     S         (getreal "\n Шаг копирования: ")
);setq
(setq
     UG        (getangle "\n Направление копирования: <горизонтально> ")
);
(if (= UG nil)
(setq UG 0)
);if
(setq
     L         (getdist "\n Участок копирования: ")     
     Q         (fix (/ L S))
     TK        (polar TN UG S)
     N         2)
(command "_.undo" "_be")
(repeat Q
(command "_.copy" LL "" TN TK)
(setq
      S1       (* S N)
      TK       (polar TN UG S1)
      N        (+ 1 N))
);repeat
(command "_.undo" "_end") 
(setq *error* old_error)
);setq
(defun ERR_ (msg)
(command "_.undo" "_end")
(setq *error* old_error)
(princ)
)efun ERR

[AlexSheep]

Сообщение от La Persona Подскажите, пожалуйста, как узнать координаты AttachmentPoint объекта MText?

AttachmentPoint - не координата, а способ выравнивания текста относительно координаты вставки (InsertionPoint)

[La Persona]

Сообщение от AlexSheep AttachmentPoint - не координата, а способ выравнивания текста относительно координаты вставки (InsertionPoint)

Хм. Все становится сложнее...

[AlexSheep]

Сообщение от La Persona Хм. Все становится сложнее...

Хм. Почему? :-)
Какая цель-то?

[ShaggyDoc]

а можно ли как-нибудь в этом лиспе сделать так, чтобы задание "направления копирования" и "участка копирования" производилось в одно действие?

Функцией getpoint от начальной точки pnt1. Запрос точки pnt2 наподобие "Направление и дистанция копирования". По углу от начальной до полученной точки (angle pnt1 pnt2) получите направление, а функцией (distance pnt1 pnt2) - расстояние.

[Никита Ремизов]

Сообщение от ShaggyDoc Функцией getpoint от начальной точки pnt1. Запрос точки pnt2

пробовал, получается не так комфортно - нельзя задать угол и расстояние с клавиатуры, кроме того не попользуешься полярной привязкой и т.д. в идеале было бы чтобы механизм задания угла и расстояния совпадал с механизмом рисования отрезка, т.е. чтоб можно было как задать угол, длину(или что-то одно) с клавиатуры, так и "графически" мышью. надеюсь объяснил более или менее поянтно

[_mikka]

Народ подскажите, как удалить колонку из таблицы автокад ?

[ShaggyDoc]

нельзя задать угол и расстояние с клавиатуры

Как это нельзя, когда у всех льзя? Именно так моделируется построение отрезков, только надо опциями и проверками дополнять.

Код:

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

 Command: (setq pt1 (getpoint "Первая точка: "))

Первая точка:
Указали мышкой и получили результат

Код:

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

 (2240.0 970.0 0.0)

Запрос второй точки

Код:

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

 Command: (setq pt2 (getpoint pt1 "Вторая точка"))

Вторая точка
Вводим с клавиатуры расстояние и смещение
@300<0
и получаем результат:

Код:

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

 (2540.0 970.0 0.0)

Вычисляем угол:

Код:

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

 (setq ang (angle pt1 pt2))

0.0
Вычисляем расстояние:

Код:

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

 (setq dist (distance pt1 pt2))

300.0
"надеюсь объяснил более или менее поянтно"

[Дима_]

Сообщение от _mikka Народ подскажите, как удалить колонку из таблицы автокад ?

(vla-deletecolumns vla_представление_таблицы номер_столбца количество ) - а вобще лучше изучить как пользоваться справкой.

[Никита Ремизов]

ShaggyDoc

Сообщение от ShaggyDoc Как это нельзя, когда у всех льзя? Именно так моделируется построение отрезков, только надо опциями и проверками дополнять.

это все конечно здорово то, что вы написали, но мне нужно не это. я не хочу дополнительно вводить @ и <. Это не облегчает работу с начальным вариантом лиспа. Когда используется getpoint вводятся просто две отдельные точки, а хотелось бы иметь вот такую картинку: (см. приложение).
И чтобы между окошками ввода расстояния и угла можно было бы переключаться табом.
Кроме того в варианте с getpoint не воспользуешься привязками отслеживания.

[Frigate]

Подскажите, пожалуйста, есть ли где наработки по программной замене определения ДИНблока (не вставки, а именно определения) другим определением. Имена блоков одинаковые. Они определены в разных файлах. Такое делает дизайнцентр (Ctrl+2), но хотелось бы иметь возможность программно все делать. Что упрощает алгоритм - библиотечный файл с образцовым вариантом блока известен (как и его местоположение).
А замена вставок блоков вроде рассматривалась на форуме. Надеюсь, найду.

[Дима_]

То Frigate - а дин. блоки с параметром видимости в Вашем варианте не подходят?

[Frigate]

Дима_,

можно и на "ты" )))

так я именно динблоки "старого образца" хочу менять программно на динблоки "нового".

Это нужно, когда хочешь использовать старые наработки, но динблоки уже "усовершенствованы". Каждый раз переопределять через Дизайн-центр - это не выход.

[pavelgeorgievich]

Добрый вечер форумчане!!! может кто подскажет начинающему изучать лисп программирование. задался вопросом. можно-ли написать лисп на следующий набор действий, которые я выполняю при оформлении документации. я пользуюсь подшивками и при создании листов в подшивки произвожу множество манипуляций. хотелось бы облегчить себе жизнь. черчу в модели. листы компаную на вкладке лист. причем каждый лист я делаю отдельным файлом с ВЭ на файл, в котором находится чертеж на в пространстве модели. так вот хотелось бы, запустив всего одну команду получить автоматически следующий набор действий:
- выделить рамкой в модели пространство, которое я хотел бы разместить на листе в определенном масштабе
- далее выбрать шаблон для создания листа (открывается окно выбора шаблона) на который переносится ВЭ с писанной с определенным масштабом пространство листа
- далее присоединить этот файл к подшивке и сохранить его в нужном месте.
к сожалению код я не писал еще (проект только в мечтах). хотелось бы посоветоваться возможно ли такое осуществить при помощи лиспа и много ли потребуется времени для его написания начинающему? за советы заранее благодарю

[ciril]

Для начала вот так:

Код:

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

 (defun c:layoutcreate  (/ x00 x01 x02 x03 x04 x05 x06 x07)
  (setvar 'ctab "Model")
  (while (not (and (setq x00 (getpoint "\nУкажите первый угол рамки..."))
                   (setq x01 (getcorner x00 "\nУкажите второй угол рамки или <отменить>..."))))
    (princ "\nПовторите..."))
  (setq x02 (getfiled "\nВыбор файла с шаблонами листов"
                      (vl-registry-read
                        (strcat (setq x02 (strcat (setq x02 (strcat "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R" (substr (getvar 'acadver) 1 4)))
                                                  "\\"
                                                  (vl-registry-read x02 "CurVer")
                                                  "\\Profiles"))
                                "\\"
                                (vl-registry-read x02)
                                "\\General")
                        "TemplatePath")
                      "dwt"
                      16))
  (vl-load-com)
  (and (vl-catch-all-error-p
         (setq x03 (vl-catch-all-apply
                     'vla-open
                     (list (setq x04 (vla-getinterfaceobject
                                       (vlax-get-acad-object)
                                       (strcat "ObjectDBX.AxDbDocument."
                                               (if (>= (setq x04 (substr (getvar 'acadver) 1 2)) "16")
                                                 x04
                                                 ""))))
                           x02))))
       (vl-catch-all-error-message x03))
  (setq x02 ""
        x03 (vla-item (vla-get-dictionaries x04) "ACAD_LAYOUT")
        x05 (list)
        x06 -1)
  (repeat (length
            (setq x05 (cdr
                        (reverse
                          (while (not (vl-catch-all-error-p (setq x07 (vl-catch-all-apply 'vla-item (list x03 (setq x06 (1+ x06)))))))
                            (setq x05 (append x05 (list (vla-get-name x07)))))))))
    (setq x02 (strcat x02 (car x05) " ")
          x05 (cdr x05)))
  (initget 1 x02)
  (setq x05 (getkword (strcat "\nШаблоны листов: " x02 "\nВведите имя шаблона листа для вставки: ")))
  (while (or (zerop (setq x06 (1- x06)))
             (not (eq x05 (vla-get-name (setq x07 (vla-item x03 x06)))))))
  (and (vl-catch-all-error-p
         (setq x03 (vl-catch-all-apply
                     'vla-copyfrom
                     (list (setq x02 (vla-add (vla-get-layouts (vla-get-activedocument (vla-get-application (vlax-get-acad-object))))
                                              x05))
                           x07))))
       (vl-catch-all-error-message x03))
  (vlax-release-object x04)
  (vla-getpapersize x02 'x03 'x04)
  (gc)
  (setvar 'ctab x05)
  (setview (list (cons 0 "VIEW")
                 (cons 2 "calc")
                 (cons 70 0)
                 (list 10 (/ x04 2) (/ x03 2))
                 (cons 40 x04)
                 (cons 41 100.0)
                 (list 11 0.0 0.0 1.0)
                 (list 12 0.0 0.0 0.0)
                 (cons 42 1.0)
                 (cons 43 0.0)
                 (cons 44 0.0)
                 (cons 50 0.0)
                 (cons 71 0)
                 (cons 72 1)
                 (list 110 0.0 0.0 0.0)
                 (list 111 1.0 0.0 0.0)
                 (list 112 0.0 1.0 0.0)
                 (cons 79 0)
                 (cons 146 0.0))
           0)
  (princ))

Совершенно непонятно, что нужно с масштабами, иначе говоря, что куда вписывается. И не очень понятно, что в шаблоне: только установки печати или еще какие-то примитивы.

[ashas-]

Здравия всем!
У меня следующий вопрос, где можно взять, узнать, вытащить, координаты последних точек??? Всю справку перелопатил... Например когда делаешь какой нибудь выбор объекта с помощью команды select, как после ее окончания достать координату точки того места куда ты тыкнул курсором? Конечная цель получить переменную с координатами. Единственный известный мне способ это с помощью стрелочек... Но где это храниться? (((
Заранее всех БлагоДарю.

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

(getvar "lastpoint") катит?

[aso3]

Здравствуйте.
захотел написать программу отрисовки вертикальных линий красного цвета, по завершению которой, чтобы цвет возвращался на тот который был до начала команды, но не получилось.
рисует одну красную а все остальные предыдущего.
Прошу помочь разобратся.

[pavelgeorgievich]

Сообщение от ciril Совершенно непонятно, что нужно с масштабами, иначе говоря, что куда вписывается. И не очень понятно, что в шаблоне: только установки печати или еще какие-то примитивы.

спасибо, что откликнулись
по масштабам: необходимо, чтобы выделенная область появлялась в созданном ВЭ с масштабом, которыы мы задаем
в шаблоне лист с заданными параметрами печати. из примитивов если только рамка с основной надписью (которые уже храняться в шаблоне)

[ashas-]

Благодарю ). Катит.
Теперь бы любопытство свое успокоить, было бы вообще шикарно ... Когда выбираешь команду "отрезок" она предлогает указать первую точку, если в место этого нажимать стрелку вверх (на клавиатуре) то автокад дает несколько последних координат. Эти координаты можно где нибудь достать? Где они хранятся ? (((

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

aso3, оно?

Код:

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

(defun c:пг (/ *error* sysvar)

  (defun *error* (msg)
    (if sysvar
      (setvar "cecolor" sysvar)
      ) ;_ end of if
    (princ msg)
    (princ)
    ) ;_ end of defun

  (setq sysvar (getvar "cecolor"))
  (setvar "cecolor" "1")
  (while (vl-cmdf "._xline" "_h" pause))
  (if sysvar
    (setvar "cecolor" sysvar)
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

[ciril]

Сообщение от pavelgeorgievich по масштабам: необходимо, чтобы выделенная область появлялась в созданном ВЭ с масштабом, которыы мы задаем в шаблоне лист с заданными параметрами печати. из примитивов если только рамка с основной надписью (которые уже храняться в шаблоне)

Масштабы целочисленные? Проверка на превышения размеров ВЭ при заданном масштабе на выбранном шаблоне листа нужна? Примитивы с листа шаблона клонировать все или выборочно? На каком слое создавать ВЭ?

[pavelgeorgievich]

Сообщение от ciril Масштабы целочисленные? Проверка на превышения размеров ВЭ при заданном масштабе на выбранном шаблоне листа нужна? Примитивы с листа шаблона клонировать все или выборочно? На каком слое создавать ВЭ?

масштабы думаю стандартные необходимо (1:100, 1:50, 1:10 и т.д.)
проверку в принципе можно и не осуществлять, поскольку бывает, что и на А1 не помещаются чертежи
примитывы наверное все необходимы (в шаблоне обычно храню только рамку с основной надписью)
ВЭ в defpoints

[aso3]

Кулик Алексей aka kpblc, спасибо работает.

[ciril]

Сообщение от pavelgeorgievich pavelgeorgievich

Начерно вот так, потом изменю, но пока ВЭ создается на текущем слое и почему-то ВЭ смещен от указанной области, но общую идею посмотреть уже можно. Проверь, подходит?
Масштаб вводить десятичной дробью, то есть, например, 1:100 = 0.01

Код:

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

 (defun c:layoutcreate  (/ x00 x01 x02 x03 x04 x05 x06 x07 x08)
  (setvar 'ctab "Model")
  (while (not (and (setq x00 (getpoint "\nУкажите первый угол рамки..."))
                   (setq x01 (getcorner x00 "\nУкажите второй угол рамки или <отменить>..."))))
    (princ "\nУкажите еще раз..."))
  (and (> (setq x02 (car x00)) (setq x03 (car x01)))
       (setq x00 (cons x03 (cdr x00))
             x01 (cons x02 (cdr x01))))
  (and (> (setq x02 (cadr x00)) (setq x03 (cadr x01)))
       (setq x00 (list (car x00) x03)
             x01 (list (car x01) x02)))
  (initget 6)
  (setq x02 (getreal "\nВведите масштаб видового экрана: "))
  (setq x03 (getfiled "\nВыбор файла шаблонов листов"
                      (vl-registry-read
                        (strcat (setq x03 (strcat (setq x03 (strcat "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R" (substr (getvar 'acadver) 1 4)))
                                                  "\\"
                                                  (vl-registry-read x03 "CurVer")
                                                  "\\Profiles"))
                                "\\"
                                (vl-registry-read x03)
                                "\\General")
                        "TemplatePath")
                      "dwt"
                      16))
  (vl-load-com)
  (and (vl-catch-all-error-p
         (setq x04 (vl-catch-all-apply
                     'vla-open
                     (list (setq x05 (vla-getinterfaceobject
                                       (vlax-get-acad-object)
                                       (strcat "ObjectDBX.AxDbDocument."
                                               (if (>= (setq x05 (substr (getvar 'acadver) 1 2)) "16")
                                                 x05
                                                 ""))))
                           x03))))
       (vl-catch-all-error-message x04))
  (setq x03 ""
        x04 (vla-item (vla-get-dictionaries x05) "ACAD_LAYOUT")
        x06 (list)
        x07 -1)
  (repeat (length
            (setq x06 (cdr
                        (reverse
                          (while (not (vl-catch-all-error-p (setq x08 (vl-catch-all-apply 'vla-item (list x04 (setq x07 (1+ x07)))))))
                            (setq x06 (append x06 (list (vla-get-name x08)))))))))
    (setq x03 (strcat x03 (car x06) " ")
          x06 (cdr x06)))
  (initget 1 x03)
  (setq x06 (getkword (strcat "\nШаблоны листов: " x03 "\nВведите имя шаблона листа для вставки: ")))
  (while (or (zerop (setq x07 (1- x07))) (not (eq x06 (vla-get-name (setq x08 (vla-item x04 x07)))))))
  (and (vl-catch-all-error-p
         (setq x04 (vl-catch-all-apply
                     'vla-copyfrom
                     (list (setq x03 (vla-add (vla-get-layouts (setq x07 (vla-get-activedocument (vla-get-application (vlax-get-acad-object)))))
                                              x06))
                           x08))))
       (vl-catch-all-error-message x04))
  (setq x04 (list))
  (setvar 'ctab x06)
  (vla-copyobjects
    x05
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbobject (cons 0 (1- (vla-get-count (vla-get-block x08)))))
        (vlax-for auxi (vla-get-block x08) (setq x04 (append x04 (list auxi))))))
    (setq x07 (vla-get-paperspace x07)))
  (vlax-release-object x05)
  (vla-getpapersize x03 'x04 'x05)
  (setq x06 (vla-addpviewport
              x07
              (vlax-make-variant
                (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 2)) (list (/ x05 2) (/ x04 2) 0.0)))
              (* x02 (abs (- (car x01) (car x00))))
              (* x02 (abs (- (cadr x01) (cadr x00))))))
  (vla-put-customscale x06 x02)
  (vla-put-target
    x06
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbdouble '(0 . 2))
        (list (/ (+ (car x01) (car x00)) 2) (/ (+ (cadr x01) (cadr x00)) 2) 0.0))))
  (vla-put-viewporton x06 :vlax-true)
  (gc)
  (setview (list (cons 0 "VIEW")
                 (cons 2 "calc")
                 (cons 70 0)
                 (setq x03 (list 10 (/ x05 2) (/ x04 2)))
                 (cons 40 x05)
                 (cons 41 100.0)
                 (list 11 0.0 0.0 1.0)
                 (list 12 0.0 0.0 0.0)
                 (cons 42 1.0)
                 (cons 43 0.0)
                 (cons 44 0.0)
                 (cons 50 0.0)
                 (cons 71 0)
                 (cons 72 1)
                 (list 110 0.0 0.0 0.0)
                 (list 111 1.0 0.0 0.0)
                 (list 112 0.0 1.0 0.0)
                 (cons 79 0)
                 (cons 146 0.0))
           0)
  (princ))

[pavelgeorgievich]

Сообщение от ciril Начерно вот так, потом изменю, но пока ВЭ создается на текущем слое и почему-то ВЭ смещен от указанной области, но общую идею посмотреть уже можно. Проверь, подходит? Масштаб вводить десятичной дробью, то есть, например, 1:100 = 0.01

сегодня решил проверить. видимо из-за того что у меня возможно другая версия Автокада лисп прерывается после того как ввожу "имя листа шаблона для вставки"
пишет: ; ошибка: Ошибка Automation. Дублирующийся ключ

[Никита Ремизов]

Есть стандартная команда автокада Выбрать подобные(Selectsimilar). возможно ли написать лисп дополняющий эту команду параметром подобия "содержимое" для текста?

[ciril]

Сообщение от pavelgeorgievich сегодня решил проверить. видимо из-за того что у меня возможно другая версия Автокада лисп прерывается после того как ввожу "имя листа шаблона для вставки" пишет: ; ошибка: Ошибка Automation. Дублирующийся ключ

Эта ошибка из-за того, что в чертеже уже существует имя лист с таким же именем, как и у выбранного листа шаблона.

[pavelgeorgievich]

Сообщение от ciril Эта ошибка из-за того, что в чертеже уже существует имя лист с таким же именем, как и у выбранного листа шаблона.

изменил имя листа - получилось. спасибо за подсказку
возникла другая проблема: лисп к одному файлу с шаблоном относится нормально (например acad.dwt), а к другому нет (созданному мною A3.dwt) при вводе имени шаблона пишет: ; ошибка: Ошибка Automation. Отсутствует описание.
и еще:
1. лисп производит корректировку масштаба ВЭ в зависимости от формата листа. ввожу к примеру 0.01 или 0.1 и т.д. происходит корректриовка к масштабу 1:20 на лист А4 (причем не совсем точно. отрезок должен в масштабе быть длиной 50 мм, а получается 49.0808) можно убрать корректировку масштаба? лучше потом вручную править формат листа.
2. можно-ли чтобы по шаблону создавалась не вкладка листа в исходном файле, а отдельный файл с единственным листом с ВЭ на выделенную облась в исходном файле?

[ciril]

Сообщение от pavelgeorgievich pavelgeorgievich

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

[pavelgeorgievich]

Сообщение от ciril с отдельным файлом - непонятно, а примитивы из исходного как там окажутся?

я думаю ссылкой в виде ВЭ. я в диспетчере подшивок это делаю простым перетаскиванием файла с чертежом в модели на лист отдельного файла. получается как внешняя ссылка

[ciril]

Сообщение от pavelgeorgievich pavelgeorgievich

Был алгоритмический косяк с формирование шаблона запроса, поправил.

Код:

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

 (defun c:layoutcreate  (/ x00 x01 x02 x03 x04 x05 x06 x07 x08)
  (setvar 'ctab "Model")
  (while (not (and (setq x00 (getpoint "\nУкажите первый угол рамки..."))
                   (setq x01 (getcorner x00 "\nУкажите второй угол рамки или <отменить>..."))))
    (princ "\nУкажите еще раз..."))
  (and (> (setq x02 (car x00)) (setq x03 (car x01)))
       (setq x00 (cons x03 (cdr x00))
             x01 (cons x02 (cdr x01))))
  (and (> (setq x02 (cadr x00)) (setq x03 (cadr x01)))
       (setq x00 (list (car x00) x03)
             x01 (list (car x01) x02)))
  (initget 6)
  (setq x02 (getreal "\nУкажите масштаб видового экрана: "))
  (setq x03 (getfiled "\nВыбор файла шаблонов листов"
                      (vl-registry-read
                        (strcat (setq x03 (strcat (setq x03 (strcat "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R" (substr (getvar 'acadver) 1 4)))
                                                  "\\"
                                                  (vl-registry-read x03 "CurVer")
                                                  "\\Profiles"))
                                "\\"
                                (vl-registry-read x03)
                                "\\General")
                        "TemplatePath")
                      "dwt"
                      16))
  (vl-load-com)
  (and (vl-catch-all-error-p
         (setq x04 (vl-catch-all-apply
                     'vla-open
                     (list (setq x05 (vla-getinterfaceobject
                                       (vlax-get-acad-object)
                                       (strcat "ObjectDBX.AxDbDocument."
                                               (if (>= (setq x05 (substr (getvar 'acadver) 1 2)) "16")
                                                 x05
                                                 ""))))
                           x03))))
       (vl-catch-all-error-message x04))
  (setq x03 ""
        x04 (vla-item (vla-get-dictionaries x05) "ACAD_LAYOUT")
        x06 (list)
        x07 -1)
  (while (not (vl-catch-all-error-p (setq x08 (vl-catch-all-apply 'vla-item (list x04 (setq x07 (1+ x07)))))))
    (setq x06 (append x06 (list (vla-get-name x08)))))
  (or (and (eq "Model" (car x06)) (setq x08 (cdr x06)))
      (and (eq "Model" (last x06)) (setq x08 (cdr (reverse x06))))
      (repeat (length (- (length x06) (length (setq x08 (cdr (member "Model" x06)))) 1))
        (setq x08 (cons (car x06) x08)
              x06 (cdr x06))))
  (repeat (length x08)
    (setq x03 (strcat x03 (car x08) " ")
          x08 (cdr x08)))
  (initget 1 x03)
  (setq x06 (getkword (strcat "\nШаблоны листов: " x03 "\nВведите имя шаблона листа для вставки: ")))
  (while (not (eq x06 (vla-get-name (setq x08 (vla-item x04 (setq x07 (1- x07))))))))
  (and (vl-catch-all-error-p
         (setq x04 (vl-catch-all-apply
                     'vla-copyfrom
                     (list (setq x03 (vla-add (vla-get-layouts (setq x07 (vla-get-activedocument (vla-get-application (vlax-get-acad-object)))))
                                              x06))
                           x08))))
       (vl-catch-all-error-message x04))
  (setq x04 (list))
  (setvar 'ctab x06)
  (vla-copyobjects
    x05
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbobject (cons 0 (1- (vla-get-count (vla-get-block x08)))))
        (vlax-for auxi (vla-get-block x08) (setq x04 (append x04 (list auxi))))))
    (setq x07 (vla-get-paperspace x07)))
  (vlax-release-object x05)
  (vla-getpapersize x03 'x04 'x05)
  (setq x06 (vla-addpviewport
              x07
              (vlax-make-variant
                (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 2)) (list (/ x05 2) (/ x04 2) 0.0)))
              (* x02 (abs (- (car x01) (car x00))))
              (* x02 (abs (- (cadr x01) (cadr x00))))))
  (vla-display x06 :vlax-true)
  (vla-update x06)
  (vla-put-customscale x06 x02)
  (vla-update x06)
  (vla-put-target
    x06
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbdouble '(0 . 2))
        (list (/ (+ (car x01) (car x00)) 2) (/ (+ (cadr x01) (cadr x00)) 2) 0.0))))
  (vla-update x06)
  (gc)
  (setview (list (cons 0 "VIEW")
                 (cons 2 "calc")
                 (cons 70 0)
                 (setq x03 (list 10 (/ x05 2) (/ x04 2)))
                 (cons 40 x05)
                 (cons 41 100.0)
                 (list 11 0.0 0.0 1.0)
                 (list 12 0.0 0.0 0.0)
                 (cons 42 1.0)
                 (cons 43 0.0)
                 (cons 44 0.0)
                 (cons 50 0.0)
                 (cons 71 0)
                 (cons 72 1)
                 (list 110 0.0 0.0 0.0)
                 (list 111 1.0 0.0 0.0)
                 (list 112 0.0 1.0 0.0)
                 (cons 79 0)
                 (cons 146 0.0))
           0)
  (princ))

вот в таком виде выбирает область, шаблон, имя листа, запрашивает масштаб, вставляет лист, вставляет видовой экран по масштабу. Странно, у меня масштабирует нормально. С подшивкой разберусь чуть позже.

[pavelgeorgievich]

Сообщение от ciril вот в таком виде выбирает область, шаблон, имя листа, запрашивает масштаб, вставляет лист, вставляет видовой экран по масштабу. Странно, у меня масштабирует нормально.

все. у меня теперь тоже все работает. и масштабирует нормально.

[La Persona]

Здравствуйте! Помогите, пожалуйста, решить небольшую проблему: есть список poln_spisok, пытаюсь его инвертировать и вывести в текстовый файл. На строке (setq spisok_pr (reverse poln_spisok)) автокад спотыкается и выдает сообщение ошибка: неверный тип аргумента: consp nil. В чем может быть загвоздка?

Код:

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

   (setq spisok_pr (reverse poln_spisok))
  (setq f (open "C:\\AutoLISP_files\\cp_file.txt" "w"))
  (foreach x spisok_pr (princ (strcat x "\n") f))
  (close f)

UPD.:
Без reverse та же ошибка выдается...

Код:

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

 (setq f (open "C:\\AutoLISP_files\\cp_file.txt" "w"))
(foreach x poln_spisok (princ (strcat x "\n") f))
(close f)

[0] "4115 ÏÊ 41+15 3859 1671"
[1] "4064 ÏÊ 40+64 3810 1687"
[2] "3999 ÏÊ 39+99 3748 1707"
[3] "3928 ÏÊ 39+28 3680 1729"
[4] "3836 ÏÊ 38+36 3593 1756"
[5] "3752 ÏÊ 37+52 3513 1782"
[6] "3686 ÏÊ 36+86 3450 1802"
[7] "3613 ÏÊ 36+13 3380 1825"
[8] "3543 ÏÊ 35+43 3314 1846"
[9] "3472 ÏÊ 34+72 3247 1867"
[10] "3390 ÏÊ 33+90 3168 1892"
[11] "3327 ÏÊ 33+27 3108 1912"
[12] "3260 ÏÊ 32+60 3044 1932"
[13] "3199 ÏÊ 31+99 2986 1951"
[14] "3147 ÏÊ 31+47 2936 1967"
[15] "3087 ÏÊ 30+87 2880 1985"
[16] "3018 ÏÊ 30+18 2814 2006"
[17] "2955 ÏÊ 29+55 2754 2025"
[18] "2886 ÏÊ 28+86 2689 2046"
[19] "2804 ÏÊ 28+04 2610 2071"
[20] "2714 ÏÊ 27+14 2539 2063"
[21] "2643 ÏÊ 26+43 2506 2000"
[22] "2582 ÏÊ 25+82 2478 1946"
[23] "2528 ÏÊ 25+28 2453 1898"
[24] "2436 ÏÊ 24+36 2411 1817"
[25] "2361 ÏÊ 23+61 2376 1749"
[26] "2306 ÏÊ 23+06 2351 1701"
[27] "2218 ÏÊ 22+18 2311 1623"
[28] "2158 ÏÊ 21+58 2283 1569"
[29] "2080 ÏÊ 20+80 2247 1500"
[30] "2023 ÏÊ 20+23 2221 1450"
[31] "1944 ÏÊ 19+44 2184 1379"
[32] "1858 ÏÊ 18+58 2145 1303"
[33] "1791 ÏÊ 17+91 2114 1244"
[34] "1702 ÏÊ 17+02 2073 1165"
[35] "1609 ÏÊ 16+09 2030 1083"
[36] "1537 ÏÊ 15+37 1997 1018"
[37] "1452 ÏÊ 14+52 1958 943"
[38] "1358 ÏÊ 13+58 1895 912"
[39] "1281 ÏÊ 12+81 1824 942"
[40] "1220 ÏÊ 12+20 1768 965"
[41] "1142 ÏÊ 11+42 1696 994"
[42] "1053 ÏÊ 10+53 1613 1029"
[43] "990 ÏÊ 09+90 1555 1053"
[44] "935 ÏÊ 09+35 1504 1074"
[45] "843 ÏÊ 08+43 1419 1109"
[46] "763 ÏÊ 07+63 1346 1139"
[47] "672 ÏÊ 06+72 1261 1174"
[48] "593 ÏÊ 05+93 1188 1204"
[49] "520 ÏÊ 05+20 1121 1231"
[50] "426 ÏÊ 04+26 1033 1268"
[51] "356 ÏÊ 03+56 969 1294"
[52] "286 ÏÊ 02+86 904 1321"
[53] "194 ÏÊ 01+94 819 1356"
[54] "138 ÏÊ 01+38 768 1377"
[55] "56 ÏÊ 00+56 692 1408"

[Do$]

Список в лиспе выглядит так: (<Элемент1> <Элемент2> <Элемент3> <Элемент4> <Элемент5> ... ), например:

Код:

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

 
(setq poln_spisok 
   (list 
       "4115 ПК 41+15 3859 1671"
       "4064 ПК 40+64 3810 1687"
       "3999 ПК 39+99 3748 1707"
       "3836 ПК 38+36 3593 1756" 
       ;;... и так далее
   )
)

[La Persona]

Co списком poln_spisok проблем нет, создается и заполняется в цикле нормально. Содержимое списка я взял из журнала трассировки. Непонятно, почему выходит ошибка, когда пытаюсь вывести содержимое списка в файл...

Насколько я понял, автокад переменную poln_spisok не считает списком. Хотя во время отладки poln_spisok отображается именно как список. Что-то я вообще запутался на ровном месте...

Код:

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

 
(vl-load-com)

(defun _dwgru-random (/ modulus multiplier increment)
;;; Генерирует случайное вещественное число в диапазоне от 0 до 1
;;; Используется глобальная переменная *DWGRU_SEED*
  (if (not *DWGRU_SEED*)
    (setq *DWGRU_SEED* (getvar "DATE"))
  )
  (setq    modulus    65536
    multiplier
     25173
    increment 13849
    *DWGRU_SEED*
     (rem (+ (* multiplier *DWGRU_SEED*) increment) modulus)
  )
  (/ *DWGRU_SEED* modulus)
)
(defun c:cp (/        pln       base_l     use_l     cp_coord
         num    num_str       suff_str   suff     cp_coord_x
         cp_coord_y    use_l_str  spis_str   poln_spisok
         sl_ch    step_l       spisok_pr  coord1     coord2
         f        x
        )
  (setq snp (getvar "Osmode"))
  (setvar "Osmode" 0)
  (setq
    k1 (getint "Минимальное расстояние между контрольными точками:"
       )
  )
  (setq
    k2 (getint
     "Максимальное расстояние между контрольными точками:"
       )
  )
  (setq b_name (getstring "Введите имя блока:"))
  (setq pln (car (entsel)))
  (setq    base_l
     (vlax-curve-getDistAtParam pln (vlax-curve-getEndParam pln))
  )
  (setq use_l 0)
  (while (<= use_l base_l)
    (progn
      (setq sl_ch (_dwgru-random))
      (setq step_l (+ (* sl_ch (- k2 k1)) k1))
      (setq use_l (+ use_l step_l))
      (setq cp_coord (vlax-curve-getPointAtDist pln use_l))
      (setq num (fix (/ use_l 100)))
      (if (< num 10)
    (setq num_str (strcat "0" (itoa num)))
    (setq num_str (itoa num))
      )
      (setq suff (- (fix use_l) (* num 100)))
      (if (< suff 10)
    (setq suff_str (strcat "0" (itoa suff)))
    (setq suff_str (itoa suff))
      )
      (setq cp_coord_x (fix (nth 0 cp_coord)))
      (setq cp_coord_y (fix (nth 1 cp_coord)))

      (setq
    coord1 (list (- cp_coord_x 10) (+ cp_coord_y 2))
      )
      (setq coord2
         (list (+ cp_coord_x 10) (+ cp_coord_y 12))
      )
      (setq spis_str (strcat (itoa (fix use_l))
                 " "
                 (strcat "ПК " num_str "+" suff_str)
                 " "
                 (itoa cp_coord_x)
                 " "
                 (itoa cp_coord_y)
             )
      )
      (setq poln_spisok (cons spis_str poln_spisok))
      (command "_.insert" b_name cp_coord 1.0 0)
      (command "_.mtext" coord1 coord2 (strcat "+" suff_str) "")
    )
  )
  (setvar "Osmode" snp)
  (setq spisok_pr (reverse poln_spisok))
  (setq f (open "C:\\AutoLISP_files\\cp_file.txt" "w"))
  (foreach x spisok_pr (princ (strcat x "\n") f))
  (close f)
)

[Do$]

По записи в файл все работает нормально. Проверял так:

Код:

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

 
(setq poln_spisok
       (list
	 "4115 IE 41+15 3859 1671"
	 "4064 IE 40+64 3810 1687"
	 "3999 IE 39+99 3748 1707"
	 "3928 IE 39+28 3680 1729"
	 "3836 IE 38+36 3593 1756"
	 "3752 IE 37+52 3513 1782"
	 "3686 IE 36+86 3450 1802"
	 "3613 IE 36+13 3380 1825"
	 "3543 IE 35+43 3314 1846"
	 "3472 IE 34+72 3247 1867"
	 "3390 IE 33+90 3168 1892"
	 "3327 IE 33+27 3108 1912"
	 "3260 IE 32+60 3044 1932"
	 "3199 IE 31+99 2986 1951"
	 "3147 IE 31+47 2936 1967"
	 "3087 IE 30+87 2880 1985"
	 "3018 IE 30+18 2814 2006"
	 "2955 IE 29+55 2754 2025"
	 "2886 IE 28+86 2689 2046"
	 "2804 IE 28+04 2610 2071"
	 "2714 IE 27+14 2539 2063"
	 "2643 IE 26+43 2506 2000"
	 "2582 IE 25+82 2478 1946"
	 "2528 IE 25+28 2453 1898"
	 "2436 IE 24+36 2411 1817"
	 "2361 IE 23+61 2376 1749"
	 "2306 IE 23+06 2351 1701"
	 "2218 IE 22+18 2311 1623"
	 "2158 IE 21+58 2283 1569"
	 "2080 IE 20+80 2247 1500"
	 "2023 IE 20+23 2221 1450"
	 "1944 IE 19+44 2184 1379"
	 "1858 IE 18+58 2145 1303"
	 "1791 IE 17+91 2114 1244"
	 "1702 IE 17+02 2073 1165"
	 "1609 IE 16+09 2030 1083"
	 "1537 IE 15+37 1997 1018"
	 "1452 IE 14+52 1958 943"
	 "1358 IE 13+58 1895 912"
	 "1281 IE 12+81 1824 942"
	 "1220 IE 12+20 1768 965"
	 "1142 IE 11+42 1696 994"
	 "1053 IE 10+53 1613 1029"
	 "990 IE 09+90 1555 1053"
	 "935 IE 09+35 1504 1074"
	 "843 IE 08+43 1419 1109"
	 "763 IE 07+63 1346 1139"
	 "672 IE 06+72 1261 1174"
	 "593 IE 05+93 1188 1204"
	 "520 IE 05+20 1121 1231"
	 "426 IE 04+26 1033 1268"
	 "356 IE 03+56 969 1294"
	 "286 IE 02+86 904 1321"
	 "194 IE 01+94 819 1356"
	 "138 IE 01+38 768 1377"
	 "56 IE 00+56 692 1408"
       ) ;_ end of list
) ;_ end of setq

(setq spisok_pr (reverse poln_spisok))
(if
  (and (setq fn	(getfiled "Куда сохранить?"
			  "C:\\AutoLISP_files\\cp_file.txt"
			  "txt"
			  1
		) ;_ end of getfiled
       ) ;_ end of setq
       (setq f (open fn "w"))
  ) ;_ end of and
   (progn
     (foreach x spisok_pr (princ (strcat x "\n") f))
     (close f)
   ) ;_ end of progn
) ;_ end of if

[La Persona]

Хм... Тогда почему мой список не желает обрабатываться?
(setq spisok_pr (reverse poln_spisok)) возвращает nil. Но ведь содержимое списка poln_spisok не пустое.. Вопрос по-прежнему открыт. Может есть ошибка в теле цикла, во время заполнения списка?

[Do$]

Код из моего сообщения нормально работает? Если да, то используйте этот кусок в своей программе. Если проблема не исчезнет - значит где-то в другом месте ошибка.

[La Persona]

Сообщение от Do$ Код из моего сообщения нормально работает? Если да, то используйте этот кусок в своей программе. Если проблема не исчезнет - значит где-то в другом месте ошибка.

Проблема, как я понял, не в этом куске кода. Ошибка возникает здесь: (setq spisok_pr (reverse poln_spisok)) возвращает nil. poln_spisok как-то криво создан наверно. Но причину ошибки так и не могу отловить. Где-то в цикле надо искать...

[Do$]

У меня разбираться желание напрочь пропало, когда я увидел кучу этих setq и переменных Ни комментариев, ни описания про назначение программы... Примера в dwg нет, на котором протестировать можно...

[La Persona]

Может так лучше выглядит

Код:

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

 (vl-load-com)

(defun _dwgru-random (/ modulus multiplier increment)
;;; Генерирует случайное вещественное число в диапазоне от 0 до 1
;;; Используется глобальная переменная *DWGRU_SEED*
  (if (not *DWGRU_SEED*)
    (setq *DWGRU_SEED* (getvar "DATE"))
  )
  (setq    modulus    65536
    multiplier
     25173
    increment 13849
    *DWGRU_SEED*
     (rem (+ (* multiplier *DWGRU_SEED*) increment) modulus)
  )
  (/ *DWGRU_SEED* modulus)
)

;;;Вычисление контрольных точек трубопровода, запись ПК и координат в текстовый файл

(defun c:cp (/        pln       base_l     use_l     cp_coord
         num    num_str       suff_str   suff     cp_coord_x
         cp_coord_y    use_l_str  spis_str   poln_spisok
         sl_ch    step_l       spisok_pr  coord1     coord2
         f        x
        )
  (setq snp (getvar "Osmode"))
  (setvar "Osmode" 0)
  (setq
    k1       (getint "Минимальное расстояние между контрольными точками:"
       )
    k2       (getint
         "Максимальное расстояние между контрольными точками:"
       )
    b_name (getstring "Введите имя блока:") ; имя блока для вставки в контрольных точках
    pln       (car (entsel)) ;  выбор полилинии
    base_l (vlax-curve-getDistAtParam pln (vlax-curve-getEndParam pln));полная длина т/п
    use_l  0 ; начальная длина пройденного пути
  )
  (while (<= use_l base_l)
    (progn
      (setq sl_ch    (_dwgru-random)  ;  случайное число
        use_l    (+ use_l (+ (* sl_ch (- k2 k1)) k1)) ; текущее значение пройденного расстояния
        cp_coord (vlax-curve-getPointAtDist pln use_l) ; вычисление координаты контрольной точки
        num         (fix (/ use_l 100)) ; префикс
        suff     (- (fix use_l) (* num 100)) ; суффикс
      )
      (if (< num 10)
    (setq num_str (strcat "0" (itoa num)))
    (setq num_str (itoa num))
      )    ; end if /// если num<10, то добавляется 0 перед числом
      (if (< suff 10)
    (setq suff_str (strcat "0" (itoa suff)))
    (setq suff_str (itoa suff))
      )    ; end if /// если suff<10, то добавляется 0 перед числом
      (setq cp_coord_x (fix (nth 0 cp_coord))
        cp_coord_y (fix (nth 1 cp_coord))
        spis_str   (strcat (itoa (fix use_l))
                   " "
                   (strcat "ПК " num_str "+" suff_str)
                   " "
                   (itoa cp_coord_x)
                   " "
                   (itoa cp_coord_y)
               ) ; создаем строчку со всеми данными контрольной точки
      )
      (setq poln_spisok (cons spis_str poln_spisok)) ; добавляем в список новую запись
      (command "_.insert" b_name cp_coord 1.0 0) ; вставляем блок
      (command "_.mtext"
           (list (- cp_coord_x 10) (+ cp_coord_y 2))
           (list (+ cp_coord_x 10) (+ cp_coord_y 12))
           (strcat "+" suff_str)
           ""
      ) ; добавляем текст около контр. точки
    ) ;end of progn
  ) ;end of progn
  (setvar "Osmode" snp)
  (setq spisok_pr (reverse poln_spisok))
  (if
    (and (setq fn (getfiled "Куда сохранить?"
                "C:\\AutoLISP_files\\cp_file.txt"
                "txt"
                1
          ) ;_ end of getfiled
     ) ;_ end of setq
     (setq f (open fn "w"))
    ) ;_ end of and
     (progn
       (foreach x spisok_pr (princ (strcat x "\n") f))
       (close f)
     ) ;_ end of progn
  ) ;_ end of if
) ; end of defun c:cp

Программка должна на трубе через каждые 50...100 м вставлять блоки (control_point), вычислять контрольные точки - пикет, длина от начала трубопровода, координаты. И все это сохранять в текстовом файле.

[Do$]

Логическая ошибка условия в цикле while.
(<= use_l base_l) - как бы все правильно, текущая длина меньше всей длины, но потом в цикле
(setq use_l (+ use_l (+ (* sl_ch (- k2 k1)) k1))) - длину увеличиваем, и она становится больше длины полилинии. Выражение (vlax-curve-getPointAtDist pln use_l) выдает nil => ошибка. А надо сделать типа такого:

Код:

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

 (vl-load-com)

(defun _dwgru-random (/ modulus multiplier increment)
;;; Генерирует случайное вещественное число в диапазоне от 0 до 1
;;; Используется глобальная переменная *DWGRU_SEED*
  (if (not *DWGRU_SEED*)
    (setq *DWGRU_SEED* (getvar "DATE"))
  ) ;_ end of if
  (setq	modulus	65536
	multiplier
	 25173
	increment 13849
	*DWGRU_SEED*
	 (rem (+ (* multiplier *DWGRU_SEED*) increment) modulus)
  ) ;_ end of setq
  (/ *DWGRU_SEED* modulus)
) ;_ end of defun

;;;Вычисление контрольных точек трубопровода, запись ПК и координат в текстовый файл

(defun c:cp (/
	     pln
	     base_l
	     use_l
	     cp_coord
	     num
	     num_str
	     suff_str
	     suff
	     cp_coord_x
	     cp_coord_y
	     use_l_str
	     spis_str
	     poln_spisok
	     sl_ch
	     step_l
	     spisok_pr
	     coord1
	     coord2
	     f
	     x
	    )
  (setq snp (getvar "Osmode"))
  (setvar "Osmode" 0)
  (setq
    k1	   (getint "Минимальное расстояние между контрольными точками:"
	   ) ;_ end of getint
    k2	   (getint
	     "Максимальное расстояние между контрольными точками:"
	   ) ;_ end of getint
    b_name (cdr
	     (assoc 2
		    (entget
		      (car (entsel "\nУкажите блок для вставки в контр. точках:"))
		    ) ;_ end of entget
	     ) ;_ end of assoc
	   )				;(getstring "Введите имя блока:") ; имя блока для вставки в контрольных точках
    pln	   (car (entsel))		;  выбор полилинии
    base_l (vlax-curve-getDistAtParam pln (vlax-curve-getEndParam pln)) ;полная длина т/п
    use_l  0				; начальная длина пройденного пути
  ) ;_ end of setq
  (while (<= (setq sl_ch (_dwgru-random) ;  случайное число
		   use_l (+ use_l (+ (* sl_ch (- k2 k1)) k1)) ; текущее значение пройденного расстояния
	     ) ;_ end of setq
	     base_l
	 ) ;_ end of <=
    (progn
      (setq
	cp_coord (vlax-curve-getPointAtDist pln use_l) ; вычисление координаты контрольной точки
	num	 (fix (/ use_l 100))	; префикс
	suff	 (- (fix use_l) (* num 100)) ; суффикс
      ) ;_ end of setq
      (if (< num 10)
	(setq num_str (strcat "0" (itoa num)))
	(setq num_str (itoa num))
      )					; end if /// если num<10, то добавляется 0 перед числом
      (if (< suff 10)
	(setq suff_str (strcat "0" (itoa suff)))
	(setq suff_str (itoa suff))
      )					; end if /// если suff<10, то добавляется 0 перед числом
      (setq cp_coord_x (fix (nth 0 cp_coord))
	    cp_coord_y (fix (nth 1 cp_coord))
	    spis_str   (strcat (itoa (fix use_l))
			       " "
			       (strcat "ПК " num_str "+" suff_str)
			       " "
			       (itoa cp_coord_x)
			       " "
			       (itoa cp_coord_y)
		       )		; создаем строчку со всеми данными контрольной точки
      ) ;_ end of setq
      (setq poln_spisok (cons spis_str poln_spisok)) ; добавляем в список новую запись
      (command "_.insert" b_name cp_coord 1.0 0) ; вставляем блок
      (command "_.mtext"
	       (list (- cp_coord_x 10) (+ cp_coord_y 2))
	       (list (+ cp_coord_x 10) (+ cp_coord_y 12))
	       (strcat "+" suff_str)
	       ""
      )					; добавляем текст около контр. точки
    )					;end of progn
  )					;end of progn
  (setvar "Osmode" snp)
  (setq spisok_pr (reverse poln_spisok))
  (if
    (and (setq fn (getfiled "Куда сохранить?"
			    "C:\\AutoLISP_files\\cp_file.txt"
			    "txt"
			    1
		  ) ;_ end of getfiled
	 ) ;_ end of setq
	 (setq f (open fn "w"))
    ) ;_ end of and
     (progn
       (foreach x spisok_pr (princ (strcat x "\n") f))
       (close f)
     ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

[La Persona]

Do$, премного благодарен за помощь! Все заработало отлично
ЗЫ: на будущее учту, что и логические ошибки могут быть )

[Wayne Rooney]

Обращаюсь к Вам со своим вопросом.

Создал я блок динамический, назвал его ZD_001_001. Сам dwg файл назвал ZD_01_01.

Вставляю вот так вот, предварительно прописав путь:

Код:

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

 [LIB001(PIR_01,Вид сверху)]^C^C_-layer;_m;Закладные_детали;;_-insert;d:/zaklad/lib001/ZD_01_01;_scale;1;;;

Уже узнал, что инсертом у меня dwg файл файл вставляется как блок, оттого получалось вот так вот:

[IMG]http://s42.***********/i095/1202/03/f2c0a3d3e499.jpg[/IMG]

Вопрос такой. Как мне сделать(мб как-то по другому путь прописать) чтобы вставлялся динамический блок?

[Дима_]

После того как ты вставишь файл как блок у тебя в документе появяться описания всех включенных в этот файл блоков, вот их потом и вставляй, вытянуть отдельное описание блока из файла тоже конечно можно, но здесь потребуется код гораздо более продвинутого уровня нежели у тебя (можешь обратиться в поиск по вопросу "работа с неактивным документом").

[Елпанов Евгений]

Сообщение от Wayne Rooney Вопрос такой. Как мне сделать(мб как-то по другому путь прописать) чтобы вставлялся динамический блок?

Похоже, ты ищешь способ сделать файл блоком, точнее, чтоб при вставке всего файла, получался динамический блок...
Это тоже можно сделать! Открываешь файл и запускаешь редактирование блоков. У тебя появляется окно, где в столбик написаны все блоки и на самом верху строка - этот файл. При выборе этой строки, можно из всего файла сделать динамический блок. Единственное неудобство - для тестирования необходимо вставлять этот файл в другой...
Удачи!

[Wayne Rooney]

Я ищу способ доступиться к динамическому блоку, который у меня уже создан. Прочитал в книге "САПР на базе AutoCAD", что надо бы создать имитацию вставки, потом прервать ее - блок оказывается внедрен со всеми сложениями, в том числе и с нужным мне, а потом можно и доступиться до него. Но вот что-то у меня реализация хромает

Код:

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

  [LIB001(PIR_01,Вид сверху)]^C^C_-layer;_m;Закладные_детали;;(command "_.-insert" "ZD_01_01") (сommand) (command "_.-insert" "ZD_001_001");_scale;1;;;

[Jerald]

Возникла идея такого вот лиспа, думаю, многим мог бы сгодиться:

а. Вызывается команда (типа команды печати);
б. В модели рамкой выбирается область печати;
в. По заданному шаблону создаётся новый Лист с ВЭ в которую вписывается выбранная ОП;
г. Рамка выбранной ОП остаётся в ПМ, ложась на непечатный слой.

[Pavel_GP]

Здравствуйте.
Подскажите плз создание правильно лисп кода, а именно необходимо чтоб в коде вызывался слой "0", потом я пишу команды построения для этого слоя. Далее вызывался другой слой (допустим "поп"), и прописываю другие команды для уже нового слоя.
спс.

[Дима_]

Если под словосочетанием "вызывался слой" подразумеваеться как установить текущий - то для Вас наверное лучше всего подойдет _-layer _s имя_слоя

[TararykovDG]

Сообщение от Pavel_GP Здравствуйте. Подскажите плз создание правильно лисп кода, а именно необходимо чтоб в коде вызывался слой "0", потом я пишу команды построения для этого слоя. Далее вызывался другой слой (допустим "поп"), и прописываю другие команды для уже нового слоя. спс.

+ к тому, что сказал Дима_,
Вариант 1

Код:

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

 
(setq old_clayer (getvar 'clayer)) ; запомнили текущий слой
(setvar 'clayer "0")
...
(setvar 'clayer "поп") ; слой с именем "поп" должен существовать
...
(setvar 'clayerold_clayer) ; восстановили исходный слой

Вариант 2
Использовать функцию entmake и (или) entmakex, тогда и слой не надо будет переключать, можно сразу рисовать на нужном слое.
Например, рисуем текст на слое "1" и неважно какой сейчас слой установлен и если слоя "1" он будет автоматически создан

Код:

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

 
(entmake (list '(0 . "TEXT") '(8 . "1") '(10 2017.19 1203.1 0.0) '(40 . 2.5) '(1 . "Текст")))

[Pavel_GP]

Сообщение от TararykovDG + к тому, что сказал Дима_, Код: [Выделить все] (entmake (list '(0 . "TEXT") '(8 . "1") '(10 2017.19 1203.1 0.0) '(40 . 2.5) '(1 . "Текст")))

Подскажите плз, как в Вашем коде сменить стиль текста? У Вас сейчас настроен "стандарт". или ссылку dxf-группы м.б. там расписано какая группа отвечает стиль.
спс.

[TararykovDG]

Сообщение от Pavel_GP Подскажите плз, как в Вашем коде сменить стиль текста? У Вас сейчас настроен "стандарт". или ссылку dxf-группы м.б. там расписано какая группа отвечает стиль. спс.

Код:

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

 
(entmake (list '(0 . "TEXT")
               '(8 . "0")
               '(10 730.796 356.381 0.0)
               '(40 . 2.5)
               '(1 . "aaa")
               '(41 . 0.9)      ; степень растяжения
               '(51 . 0.261799)	; угол наклона букв
               '(7 . "GOST")	; стиль
               )
         )

или ссылка dxf-группы

[Pavel_GP]

Подскажите плз.
Пример:
dcl
:edit_box {label="Введите шифр:"; key="shps";
edit_width=12;
edit_limit=24;}

lsp
(action_tile "shps" "(setq shp (atof $value))")
...
(setq x_p (+ (+ x0 width) 12.))
(setq y_p (+ (+ y0 height) 12.))
(setq pt (list x_p y_p))
(setq ang 0)
(setq h 3.4)
(vl-cmdf "_.text" "_j" "_m" pt h ang shp)

Вопрос: Когда я ввожу по диалоговому окну шифр (пример: 10-11-25), то текст выводится на чертеже 10.00000000. Само значение shp получается после обработки dcl 10.00000, а не 10-11-25.

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

А почему используется atof?

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc А почему используется atof?

Спс. понял в чем =) заменил на strcat и все получилось.

[gomer]

strcat там как козе баян ибо клеить нечего
правильный код:

Код:

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

 (action_tile "accept" "(setq shp (get_tile \"shps\"))(done_dialog 1)")

[Pavel_GP]

Сообщение от gomer strcat там как козе баян ибо клеить нечего правильный код: Код: [Выделить все] (action_tile "accept" "(setq shp (get_tile \"shps\"))")

После Вашей замены, выдается сообщение:
Ошибка приложения: В команду послан неверный тип
и построения текста нет.
Подскажите в чем дело?
При моей вставке замены - вычерчивание текста происходит.
Я понимаю, что Вы хотите правильно прописать действие. Я просто подобрал команду.

[gomer]

В ващем диалоге должен быть элемент ok_cancel, тогда при нажатии Ок будет считываться значение поля shps А при нажатии Отмена можно просто закрывать диалог и выходить из программы
посмотрте еще раз на код, я добавил done_dialog... просто писал не глядя

[baaba]

Есть жилая застройка, отрисованная в автокаде. Пятна застройки были отрисованы полилиниями. Сейчас все полилинии расчленены. Мне нужно снова отрезки объёдинить в полилинии.
Руками выделяем отрезок, преобразовываем в полилинию, добавляем отрезки, объединяем в полилинию. Получился вот такой код.

Код:

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

 
; Объединяет группы отрезков в полилинии, если вершины отрезков совпадают
(defun c:mkpoly (/ nlst count entc)
	(setq nlst (ssget) count (1- (sslength nlst)))
	(while (<= 0 count)
    (setq entc (ssname nlst count))
    (if (eq "LINE" (cdr (assoc 0 (entget entc))))
      (command "_.pedit" entc "y" "j" "all" "" "")
     )
    (setq count (1- count))
   )
   (setq count nil)
)

Но он очень неэффективный. Компиляция в vlx не помогла. Наверное давно есть похожие программы. Ткните пожалуйста носом !
Во-первых каждый раз выделяю всё. Во-вторых перебираю отрезки, которые уже попали в какую-либо полилинию (например в доме минимум четыре отрезка, после объёдинения в полилинию три остальных уже перебирать не надо)

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

Из выступлений Евгения Елпанова на форумах Autodesk:

Код:

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

(defun c:ple (/ sv)
  (setq sv (getvar "peditaccept"))
  (setvar "peditaccept" 1)
  (command "_.pedit" "_m" (ssget) "" "_j" 0. "")
  (setvar "peditaccept" sv)
  (princ)
  ) ;_ end of defun

[Pavel_GP]

Не выходит построение текста из выплывающего списка.
dcl:

Код:

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

...
:popup_list {label="Ввод:"; key="b1s";
 list=
 "куст\nдерево\nдом";
 edit_width=40;
 edit_limit=24;}
...

lsp:

Код:

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

...
(action_tile "accept" "(setq b1 (get_tile \"b1s\"))")
...
(setq x_p (+ x0 50.))
  (setq y_p (- y0 15.))
  (setq pt (list x_p y_p))
  (setq ang 0)
  (setq h 3.)
  (vl-cmdf "_.text" "_j" "_m" pt h ang b1)

спс за Помощь.

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

Потому что в выпадающем списке возвращается не значение, а индекс выбранного элемента, насколько я помню.
И, кстати, построение текста будет выполняться некорректно, если у текущего текстового стиля установлена фиксированная высота.

[gomer]

Сообщение от Pavel_GP Не выходит построение текста из выплывающего списка.

заполняйте в лиспе ваш список, а потом используйте nth

[baaba]

Сообщение от Кулик Алексей aka kpblc Из выступлений Евгения Елпанова на форумах Autodesk:

Алексей, спасибо! Лиспик работает, на сколько быстрее - точно не скажу, но намного -)))

[Pavel_GP]

Сообщение от gomer заполняйте в лиспе ваш список, а потом используйте nth

Подскажите на примере.
спс.

[gomer]

как-то так...

Код:

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

// test.dcl

test : dialog {

  key = "dlg";

  : list_box {
    label = "Выберите из списка:";
    key   = "lst";
  }
  spacer;
  ok_cancel_err;

}

Код:

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

 ;;; test.lsp

(defun init_list (tile lst)
;;; Функция заполнения списка
  (start_list tile)
  (mapcar 'add_list lst)
  (end_list)
)

(defun test (title lst / dcl_id dcl_rt case)
  (new_dialog
    "test"
    (setq dcl_id (load_dialog "c:/test/test.dcl"))
  )

  (set_tile "dlg" title)
  (init_list "lst" lst)

  (defun lst_clk (idx)
    (set_tile "error"
	      (strcat "Ваш выбор: " (nth (atoi idx) lst))
    )
  )
  (defun accept_clk ()
    (if	(/= "" (setq case (get_tile "lst")))
      (done_dialog 1)
      (set_tile	"error"
		"Выберите любимое животное"
      )
    )
  )

  (action_tile "lst" "(lst_clk $value)")
  (action_tile "accept" "(accept_clk)")
  (action_tile "cancel" "(done_dialog 0)")

  (setq dcl_rt (start_dialog))
  (unload_dialog dcl_id)

  (if (zerop dcl_rt)
    (alert "Вы не любите животных?")
    (alert
      (strcat (nth (atoi case) lst) " - лучший друг человека!")
    )
  )
  (princ)
)

(test "Ваше домашнее животное"
      '("Кошка" "Собака" "Попугайчик" "Черепашка")
)

[Pavel_GP]

Сообщение от gomer как-то так...

Ув. gomer. Далее построение текста... Я так и не понял как потом идет построение текста по вашему примеру.
спс за понимание.

[gomer]

Pavel_GP, что не понятного? Если выполняется условие (zerop dcl_rt), грязно ругаете пользователя, а если нет, то организовываете ввод точки вставки и рисуете текст

[Pavel_GP]

Сообщение от gomer Pavel_GP, что не понятного? Если выполняется условие (zerop dcl_rt), грязно ругаете пользователя, а если нет, то организовываете ввод точки вставки и рисуете текст

Я понимаю, то: Построение текста:

Код:

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

 (vl-cmdf "_.text" "_j" "_m" pt h ang p)

,

pt, h, ang, - мне известны

p - нет, тут должно быть значение текста. Поэтому мне и не понятно, что мне сюда вставить. Я перебрал все значения по вашему коду, выдает ошибку не правильный тип.

[AlexSheep]

Сообщение от Pavel_GP Я перебрал все значения по вашему коду, выдает ошибку не правильный тип.

Видимо, не все перебрал
Вместо строк 42-44 в коде gomer, вставь

Код:

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

 (vl-cmdf "_.text" "_j" "_m" pt h ang (nth (atoi case) lst))

[gomer]

Замечу, что список lst может быть ассоциативным или двухуровневый, на вкус, тогда строка может быть такая (cadr (nth (atoi case) lst))

[Pavel_GP]

Здравствуйте Ув.
Подскажите , как объединить в Lisp коде, если несколько окон в DCL-коде
и setq pt будет иметь другие координаты
Пример (составитель fixo)

Код:

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

 ;;;            SingleList.lsp            ;;;
(defun C:drawtextfromlist (/ dcl_id pt tsize txt txt_list userpick)

  (setq    txt_list
     (list "alpha"       "bravo"     "charlie"   "delta"
           "echo"       "foxtrott"  "golf"       "hotel"
           "india"       "juliet"    "kilo"       "lima"
           "mike"
          )
  )
  (setq dcl_id (load_dialog "SingleList.dcl"))

  (if (not (new_dialog "textfromlist" dcl_id))
    (exit)
  )

  (start_list "lst_text")
  (mapcar 'add_list txt_list)
  (end_list)

  (action_tile "cancel" "(setq userpick nil)(done_dialog)")

  (action_tile
    "accept"
    "(progn (setq userpick T)(setq txt (nth (atoi (get_tile \"lst_text\"))txt_list))(done_dialog))"
  )

  (start_dialog)
  (unload_dialog dcl_id)


  (cond    ((= userpick nil)
     (princ "\n  Отказ пользователя... ")
    )
    ((= userpick T)
     (progn
       (if (= txt "")
         (princ "\n Забыл выбрать из списка?")
         (progn
           (princ (strcat "\n Выбран текст: " txt)

           )
           (setq pt (list 0.0 0.0))
           (setq ang 0)
           (setq h 3.)
           (vl-cmdf "_.text" pt h ang txt)
         )
       )
     )
    )
  )
  (princ)
)

Код:

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

 //         SingleList.dcl            //
textfromlist : dialog {label = "Вставка текста из списка" ;
  :list_box{label = "Какой-то список...";
    key="lst_text";
    multiple_select = false;
    fixed_width_font=true;
    width=24;
    height=12;
  }
     :row{
        fixed_width=true;  
        alignment = right;
     ok_cancel;
     }
   }

Спс. сам разобрался =)

[gomer]

Сообщение от Pavel_GP сам разобрался =)

осталось научиться правильно указывать точку вставки

[Pavel_GP]

Сообщение от gomer осталось научиться правильно указывать точку вставки

Код:

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

 (setq pt (getpoint "\n  Точка вставки: "))

в, том примере уже известны координаты точки.

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

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

[baaba]

У меня получается код примерно такого вида:

Код:

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

 
(defun afun (a b) (+ a b))
(defun bfun (a c) (* a c))
(defun c:cfun (a / d) (setq d 4) (+ a d))

В принципе, я бы мог обойтись без afun и bfun, но тогда было бы сложно разбираться с c:сfun. Код был бы слишком запутанным. Я делаю много маленьких функций, отрабатываю их, затем включаю их в основную функцию. Все переменные встроенные, передаются от функции к функции. Одна переменная, например, высота текста, "сквозная" для нескольких функций (в приведённом примере это переменная a). Мне это решение кажется немного кургузым. Есть ли какой-то третий путь? Что можно почитать?
Может быть просто вынести переменную "a" в глобальные?

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

Не советую использовать глобальные переменные, особенно с такими "информативными" названиями. Ее переопределить - как нефиг делать.
Любой даже самый простой код можно сделать запутанным, а самый сложный - достаточно легко читаемым. Ну, например:

Код:

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

 (defun fun_summ (lst)
                ;|
*    Выполняет суммирование параметров
*    Параметры вызова:
	lst    список чисел либо число. Наличие нечисловых значений недопустимо.
*    Примеры вызова:
(fun_summ 1) ; 1
(fun_summ '(1 2 3) ; 6
|;
  (cond
    ((listp lst)
     (apply (function +) lst)
     )
    (t
     (fun_summ (list lst))
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun fun_multi (lst)
                 ;|
*    Выполняет умножение параметров
*    Параметры вызова:
	lst    список чисел либо число. Наличие нечисловых значений недопустимо.
*    Примеры вызова:
(fun_multi 1) ; 1
(fun_multi '(1 2 3) ; 6
|;
  (cond
    ((listp lst)
     (apply (function *) lst)
     )
    (t (fun_multi (list lst)))
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd ()
  (fun_summ (mapcar (function fun_multi) '((16. 5. -5. 65.) 48 98. (-5. -6. -7.))))
  ) ;_ end of defun

Достаточно посмотреть на комментарии к каждой функции, и в принципе уже не сильно требуется вникать в ее код. Работает, возвращает что просят - и ладно.

[Дима_]

Сообщение от baaba (defun c:cfun (a / d) (setq d 4) (+ a d))

Я никак не могу понять почему аболютному большинству программирующих проще "насовать" абсолютно ненужных переменных - вот зачем в этом примере d??? Надо прибавить 4 - ну так что может быть проще - возьми и прибавь 4 - (defun c:cfun (a) (+ a 4)) - ВСЕ. Суть не в конкретном примере - а в "дурной традиции" что-ли.

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

Дима_, лично я вполне допускаю мысль, что приведен намеренно упрощенный пример. Возможно, даже "переупрощенный"

[gomer]

я про а уже молчу

[baaba]

Сообщение от Кулик Алексей aka kpblc Дима_, лично я вполне допускаю мысль, что приведен намеренно упрощенный пример. Возможно, даже "переупрощенный"

Спасибо за понимание! Вот пример кода:
http://pastebin.com/GvcZWHmK
Там три функции. Одна рисует многострочный текст, другая расставляет текст по списку точек горизонтально, третья - расставляет строки вертикально (я делаю небольшой лиспик для вставки спецификаций из csv, да велосипед, но мне нужно что бы велик был удобен мне). Из первой функции "насквозь", в числе прочих, идёт переменная "th" высота текста. Я думаю в данном случае имеет смысл оформлять её как [bold]внешнюю переменную[/bold], обнуляя её в конце работы программы, или делать "матрёшку" - функция в функции. Но матрёшка мне не очень нравится. Может быть есть какой-то третий путь, я что то упускаю?

Теперь у меня ещё одна проблема, есть лиспик:
http://elpanov.com/index.php?id=42#02

Он у меня прекрасно работает в Автокад 2004 под Windows:

 

(eea-get_xl_sheet (findfile "/home/ivan/work/sdata.xls") "sp1")

И возвращает ошибку в другой системе:

Код:

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

Command: (vl-load-com)
Command: (findfile "/home/ivan/work/sdata.xls")
"Z:\\home\\ivan\\work\\sdata.xls"
Command: (eea-get_xl_sheet (findfile "/home/ivan/work/sdata.xls") "sp1")
; error: bad argument type: VLA-OBJECT nil

Автокад 2000 под Wine.
Что это может быть? Может нехватает каких то библиотек?

И ещё: ищу примерчик DCL диалога, для просмотра названий листов в файле xls, с последующим выбором нужного листа, для подстановки в eea-get_xl_sheet, наверняка есть годный пример.

[gomer]

Вероятно, ключевое слово Wine. com - виндовая плюшка
насчет dcl так это не проблема. см. #1822

[Олег (jr.)]

Сообщение от baaba Цитата: Сообщение от Кулик Алексей aka kpblc Дима_, лично я вполне допускаю мысль, что приведен намеренно упрощенный пример. Возможно, даже "переупрощенный" Спасибо за понимание! Вот пример кода: http://pastebin.com/GvcZWHmK Там три функции. Одна рисует многострочный текст, другая расставляет текст по списку точек горизонтально, третья - расставляет строки вертикально (я делаю небольшой лиспик для вставки спецификаций из csv, да велосипед, но мне нужно что бы велик был удобен мне). Из первой функции "насквозь", в числе прочих, идёт переменная "th" высота текста. Я думаю в данном случае имеет смысл оформлять её как [bold]внешнюю переменную[/bold], обнуляя её в конце работы программы, или делать "матрёшку" - функция в функции. Но матрёшка мне не очень нравится. Может быть есть какой-то третий путь, я что то упускаю? Теперь у меня ещё одна проблема, есть лиспик: http://elpanov.com/index.php?id=42#02 Он у меня прекрасно работает в Автокад 2004 под Windows:

Провайдер: Microsoft.Jet.OLEDB.4.0
может не работать с твоей версией Автокада, Widows здесь не причем,
по-крайней мере Windows 7 кушает его охотно вне Автокада

[ShaggyDoc]

Провайдер: Microsoft.Jet.OLEDB.4.0 может не работать с твоей версией Автокада

Любому OleDb-провайдеру глубоко наплевать, кто с ним работает. Он "работников" и знать не должен. Ему нужен только правильный запрос.
Ошибки могут быть у клиентов провайдера.

В конкретном случае с функцией eea-get_xl_sheet и AutoCAD не при чем. Евгений совершенно правильно не использует штатные средства AutoCAD, а работает через ADO. Но его функцию надо с умом применять.

В этом кусочке кода

Код:

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

 (list ADOConnect
		     "Open"
		     (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
			     tbl
			     ";Extended Properties=;Excel 8.0;HDR=No"
		     ) ;_  strcat
		     "admin"
		     ""
		     nil
	       ) 
	     )

Записано Excel 8.0. А теперь, наверное, надо Excel 11.0 или еще какую версию, которая на компьютере есть. Возможно, определять программно.

[gomer]

Сообщение от Олег (jr.) Провайдер: Microsoft.Jet.OLEDB.4.0 может не работать с твоей версией Автокада, Widows здесь не причем,

А эксель какой? вышеупомянутая функция с экселями кроме 2003 работать стесняется

[baaba]

Может есть ещё какие-то наработки по вытягиванию данных напрямую из *.xls (желательно независимо от наличия в системе запущенного екселя)?
В принципе есть например такой парсер екселевских файлов:
http://www.wagner.pp.ru/~vitus/software/catdoc/
Вот такое ещё нашёл: http://web2.airmail.net/terrycad/LISP/GetExcel.lsp, но ещё не испробовал.

[Олег (jr.)]

Посмотри здесь
http://www.theswamp.org/index.php?to...3934#msg463934

[baaba]

Сообщение от Олег (jr.) Посмотри здесь

Имеется ввиду вот это?
http://www.theswamp.org/index.php?to...3888#msg463888

Не подходит, так как запускает в excel файл, в то время как от и так открыт. Есть ещё варианты?

[VVA]

Здесь посмотри
Data reading from Microsoft Excel not using Excel.
Attribute Import/Export with Excel
Excel read and write LISP functions

[Олег (jr.)]

Сообщение от ShaggyDoc Любому OleDb-провайдеру глубоко наплевать, кто с ним работает. Он "работников" и знать не должен. Ему нужен только правильный запрос.

А теперь объсни это 64-битному Автокаду чтобы ему тоже было наплевать как работать
с Microsoft.Jet.OLEDB

[ShaggyDoc]

Сообщение от Олег (jr.) А теперь объсни это 64-битному Автокаду чтобы ему тоже было наплевать как работать с Microsoft.Jet.OLEDB

Это забота программистов Autodesk, а не Microsoft

[Олег (jr.)]

Имеется ввиду вот это? http://www.theswamp.org/index.php?to...3888#msg463888 Не подходит, так как запускает в excel файл, в то время как от и так открыт. Есть ещё варианты?

Проверь еще раз я добавил несколько функций

[Pavel_GP]

Здравствуйте.
Подскажите плз команду, чтобы преобразовала число (пример: 0.5 или 4.32) в число 00.5 или 04.32. Необходимо два знака перед точкой.
спс

[Дима_]

(defun test (x) (strcat (if (< x 10) "0" "") (rtos x)))
з.ы. с учетом отрицательных (defun test (x) (strcat (if (< x 0) "-" "") (if (< (abs x) 10) "0" "") (rtos (abs x))))

[baaba]

Сообщение от Олег (jr.) Проверь еще раз я добавил несколько функций

Можно точный линк на код?
Вот это?
http://www.theswamp.org/index.php?to...3888#msg463888
У меня результат такой:

Код:

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

; error: Automation Error. Description was not provided.
Command: (load "read_excel")
nil

Код:

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

Command: (load "read_excel")
; error: bad argument type: VLA-OBJECT #<%catch-all-apply-error%>

Код на всякий случай вместе с *.xls во вложениях

А ещё непонятно для чего служат файлы *.cs? Вот например вот такой архивчик:
http://www.theswamp.org/index.php?ac...0;attach=14442

Код:

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

ExcelReader.cs
ExcelWriter.cs
LispFunctions.cs
ExcelLispEnglish.dll

Мне нужна функция GC-XLREAD

[Pavel_GP]

Здравствуйте.
См. пример вложение.
Подскажите функцию построение по примеру:
Есть вертикальная линия. Необходимо построить на ней поперечные линии и подписи их. Подписи это координата по У (по возрастанию). Начало координаты м.б. любым не обязательно с "0" и чередование не обязательно через "1".
спс

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

А как задаются точки и значения текстов?

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc А как задаются точки и значения текстов?

1. У начала линии есть координата (х;у) (0. 0.) и конец линии (0. 9.) (пример)
2. Значение текста есть координата по У.
3. Длина поперечной допустим в координатах (-1. 1. ) (1. 1.).......(-1. 8.) (1. 8.)

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

Имелось в виду - запрашивается у пользователя или вычисляется. Разница незначительная, конечно, но все равно

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Имелось в виду - запрашивается у пользователя или вычисляется. Разница незначительная, конечно, но все равно

вычисляются,
известны координаты начало и конца линии, как таковой линии может не быть и вообще. Линия показывает границу вычерчивания поперечников

[Олег (jr.)]

Сообщение от baaba Не подходит, так как запускает в excel файл, в то время как от и так открыт. Есть ещё варианты?

Посмотри еще раз я добавил примеры и немного функций

~'o'~

[Pavel_GP]

Почему так

Код:

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

 (setq rrr (* (- 48.69 (fix 48.69)) 100.))
  (setq rrrr (fix rrr))

Итог 68, а должно быть 69
при том же 19,29,69,79 превращаются в 18,28,68,78. С остальными все норм. Зависимость через 50.

[TararykovDG]

Сообщение от Pavel_GP Почему так Код: [Выделить все] (setq rrr (* (- 48.69 (fix 48.69)) 100.)) (setq rrrr (fix rrr)) Итог 68, а должно быть 69 при том же 19,29,69,79 превращаются в 18,28,68,78. С остальными все норм. Зависимость через 50.

Потому что, гладиолус.
(fix rrr) возвращает 68, а не 69 потому что так и должно быть, потому что rrr равно не 69.0

Код:

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

 
$ (setq rrr (* (- 48.69 (fix 48.69)) 100.))
69.0
_$ (- 69.0 rrr)
2.27374e-013 ; т. е. rrr чуть меньше 69.0, а значит (fix rrr) равно 68!!!
_$ (fix 69.0)
69

[Pavel_GP]

спс.
А как же мне выловить эту разницу, и добиться 69. Чтоб эта разница сама высчитывалась. Конечный результат должен быть десятая.

[Дима_]

Это прикол округления (и не только округления) чисел с плавающей точкой.

[Pavel_GP]

Написал функцию, вроде робит=)

Код:

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

 (defun d_cel (sek)
    (setq rrr (* (- sek (fix sek)) 100.))
    (setq rrr1 (- rrr (fix rrr)))
    (setq rrr (fix (+ rrr rrr1)))
    )

  (d_cel 48.69)

[TararykovDG]

Сообщение от Дима_ Это прикол округления (и не только округления) чисел с плавающей точкой.

ИМХО, это больше прикол представления чисел с плавающей точкой.

[Pavel_GP]

Советуете числа писать например 100.0 или 100 (без точки). Как правильнее.

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

По округлению в библиотеке готовых функций было решение.

[InFlames]

Посоветуйте какие команды мне нужны для написания следующего лиспа. Буду пытаться разобраться.

Необходимо выбранные объекты (заштрихованные окружности) расставить по вершинам полилиний. При этом полилиния может быть не одна, а несколько.
Спасибо.

[TararykovDG]

Сообщение от InFlames Посоветуйте какие команды мне нужны для написания следующего лиспа. Буду пытаться разобраться. Необходимо выбранные объекты (заштрихованные окружности) расставить по вершинам полилиний. При этом полилиния может быть не одна, а несколько. Спасибо.

InFlames, есть готовое решение Вставка объектов под заданным углом к кривой

[InFlames]

Сообщение от TararykovDG InFlames, есть готовое решение Вставка объектов под заданным углом к кривой

Спасибо, это я видел. Хорошая программа. Но для меня она немного нагружена лишними функциями. Написав свою программу я убью двух зайцев: найду простое решение для своей задачи и получу опыт в написании программы на лиспе. Только для начала, чтобы не тратить много времени на поиски нужных команд, хотелось бы получить совет о том, какие команды для начала нужны именно в этой задаче.

ДОБАВЛЕНО:
Нашел примеры, в чем-то сам разобрался. Как теперь это можно ускорить?
Если выбирать одну полилинию с двумя вершинами все быстро, но если вершин 100, то процесс виден невооруженным глазом.

Код:

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

(defun C:dots (/ x lst en)
  (setq i -1)
  (setq lst (ssget))
  (while (setq en (ssname lst (setq i (1+ i))))
    (foreach x (getCoord en)
      (command "_CIRCLE"
	       (list (atof (rtos (car x))) (atof (rtos (cadr x))))
	       "0.2"
      )
      (command "_-HATCH" "_p" "_s" "_s" (entlast) "" "")
    )
  )
)

(defun getCoord	(pl / pl)
  (vl-load-com)

  (or (eq 'VLA-OBJECT (type pl))
      (setq pl (vlax-ename->vla-object pl))
  )

  (if (eq "AcDbPolyline" (vla-get-ObjectName pl))
    (vlax-list->2D-point
      (vlax-get pl 'Coordinates)
    )
    nil
  )
)

(defun vlax-list->2D-point (lst)
  (if lst
    (cons (list (car lst) (cadr lst))
	  (vlax-list->2D-point (cddr lst))
    )
  )
)

[ashas-]

Здраствуйте. Возник такой вопрос, буду очень благодарен и признателен, если вы поможете мне найти ответ.

Где хранится информация о группах (команда "группа"), и как ее с помощью лиспа можно достать? Объекты, имя группы, пояснение?

[TararykovDG]

Сообщение от ashas- Здраствуйте. Возник такой вопрос, буду очень благодарен и признателен, если вы поможете мне найти ответ. Где хранится информация о группах (команда "группа"), и как ее с помощью лиспа можно достать? Объекты, имя группы, пояснение?

Почитай эту тему

[Никита Ремизов]

Есть блок атрибутам которого присвоены определенные значения. Хочется написать лисп, который на основании этих значений вставлял бы в определенное место листа другие блоки. Подскажите пожалуйста в каком направлении копать, какие примеры глянуть и т.п.

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

Получить указатели на атрибуты, прочитать значения атрибутов, обработать...

[Никита Ремизов]

Пожалуйста подскажите как сделать или дайте кусочек кода примерный. Необходимо лиспом прочитать значение атрибута у блока, и на основе этого значения вставить другой блок, для которого прочитанное значение будет названием

[Frigate]

Никита Ремизов,

совет - ищи тему по своему вопросу: забей в поиске присвоить значение атрибуту блока и ищи, а вообще читай справку - когда научишься в ней ориентироваться, то большинство вопросов сами уйдут (тока вот она на английском)

[Никита Ремизов]

Спасибо за совет, но вы видимо не прочитали, что мне нужно.

И о какой справке идет речь?

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

Никита Ремизов, http://www.google.ru/cse?cx=partner-...tes&gsc.page=1

[Frigate]

ПРосто в поиске гугла или яндекса, да даже этого сайта, вбей свой вопрос "извлечь значения атрибута из блока" и читай, изучай

Offtop: обалдеть, когда я начинал изучать ЛИСП, то скачал много разных учебников, перерыл этот сайт и другие схожие... что за лень у человека?

По поводу справки - есть в автокаде главное меню -> Справка -> Дополнительные ресурсы -> Справка для разработчиков.
ВОт ееродимую и изучай, ЛИСП, потом объектную модель.
Конкретно для тебя - объект BlockRef (т.е. вставка блока). Там прописаны возможные методы и свойства этого объекта. Один из методов - getAttributes. Но прописано для VBA. В лиспе ты добавляешь vla- к таким методам. И будет у тебя vla-getAttributes. А аргументы этой функции уже сам найдешь при поиске.
Второй момент - тебе нужно, чтобы вставлялся блок с именем, соответствующим значению атрибута. Здесь возможны разные варианты вставки блока. Так же ищи в поиске "вставить блок".

Также советую эту тему с первых страниц читать, не обязательно всю, но первые страниц 10-20 тебе будут полезны.

[Никита Ремизов]

Гораздо легче было бы изучать имея перед собой кусок кода, выполняющий конкретно эти действия, а в информации, которую нахожу через гугл черт ногу сломит. А изучать весь автолиса ради такой элементарной узкой задачки не очень хочется, но похоже придется(

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

Никита Ремизов, в поиске по vla-getattributes примеров полно. Всяких и разных. Я ж ссылку давал!

[Frigate]

Кулик Алексей aka kpblc,


хочетя наподобие старого деда поворчаить типа "Эх, молодеш, молодеш..."

[Никита Ремизов]

Кулик Алексей aka kpblc, так я ведь и не говорю, что там недостаточно примеров, просто вы на секундочку представьте, как человеку не владеющему лиспом в них быстро разобраться (когда там vla-getattributes где-нибудь в середине находится и бог его знает, что происходило до и происходит после). В любом случае спасибо всем за помощь

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

Последний раз: http://forum.dwg.ru/showthread.php?t=22653 + http://forum.dwg.ru/showthread.php?t=54116

[dirge]

Всем привет! Есть ли способ процедурно взорвать объекты MagiCAD с сохранением оригинала на лиспе?

Есть комманда "_magiexplode", но не нравится, что каждый раз выскакивает модальное окно с ворнингом, объекты будут удаленны и т.д, а потом просит выбрать объекты. Заранее выбрать объекты, а потом использовать комманду тоже не получается. Есть ли способы решения какие-то?

[Aminka]

Доброго всем времени суток!

Господа, вопрос, пожалуй, дурацкий, но чайникам можно и такое.
Есть у меня блок, который я посредством автолиспа explode-ом разбиваю на линии и пытаюсь найти его геометрический центр. При разбитии получаю вариант с безопасным массивом, который преобразую в список сылок на объекты. Потом мне надо из эотого списка выделить сключительно линии, проигнорировав атрибуты и тексты.
То есть все выглядит просто - берем каждый элемент списка и проверяем его на причастность к линиям. Но найти функцию такую в Axtive-X не могу. Текст, написанный на лиспе - длинный и пугающий, приходится применять функции преобразования.


(setq temp (vla-explode (vlax-ename->vla-object (entlast))))
(setq temp_list (vlax-safearray->list (vlax-variant-value temp)))

(setq points_list nil)
(foreach s temp_list (if (= (cdr(assoc 0 (entget (vlax-vla-object->ename s)))) "LINE")) (progn (setq p1 (cdr(assoc 10 (entget (vlax-vla-object->ename s))))) (setq p2 )cdr(assoc 12 (entget (vlax-vla-object->ename s)))) (setq point_list (list point_list p1 p2))))))


Есть ли vla-функции, которые идеентичны " (= (assoc 0 (entget (vlax-vla-object->ename s))) (0. "LINE"))" т.е. позволяют вытащить тип т вла-объекта?

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

(= (strcase (vla-get-objectname s)) "ACDBLINE")

[Дима_]

+ к тому если вдруг окажется что нужны все же не только линии, а какая-либо группа объектов, то, как вариант, использовать (vlax-property-available-p ...)

[Aminka]

спасибо, почитаю Полищука про эти функции.

[Serg57]

Доброго всем дня (ночи)!
Прошу помощи в разъяснении странной ситуации, которая не дает мне спать уже вторую неделю. В своих «лиспах» я использую обработчик ошибок:

Код:

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

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; обработчик ошибок
  (setq OLD_ERROR *error*)
  (setq cmd (getvar "cmdecho"))
  (setq blpm (getvar "blipmode"))
  (setq apsz (getvar "aperture"))
  (setq osmd (getvar "osmode"))
  (setq cltp (getvar "celtype"))
  (setq ccol (getvar "cecolor"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; функция ошибок

 (defun *error* (msg)
       (setvar "cmdecho" cmd)
       (setvar "blipmode" blpm)
       (setvar "celtype" cltp)
       (setvar "cecolor" ccol)
       (setvar "aperture" apsz)
       (setvar "osmode" osmd)
(if OLD_ERROR
    (setq *error* OLD_ERROR)
  ) ;_ end of if
   (princ)
      )

И столкнулся со странной вещью, на домашнем компьютере функция работает, а на рабочем нет. Стал экспериментировать с разными компьютерами и заметил, что где стоит процессор АМД все нормально, а где процессор Интел – обработчик ошибок не работает.
Может, кто встречался с подобной ситуацией?
Сейчас пытаюсь заменить функцию *error* на vl-catch-all-error-message (может это поможет), переварил кучу информации, но не могу сообразить, как ее сделать одинаковой для всех моих лиспов. Например, свою функцию *error*, я тупо копирую из одной программы в другую, мне достаточно только, чтобы восстановились перечисленные выше системные переменные при нажатии клавиши “Esc”.

[Дима_]

Сообщение от Serg57 что где стоит процессор АМД все нормально, а где процессор Интел – обработчик ошибок не работает.

Offtop: за исключением пятницы 13-го?

[Serg57]

Извините, если не по теме, просто пишу первый раз и не ориентируюсь куда обращаться, поэтому и выбрал раздел для «чайников».

[VVA]

Serg57, Используй *error* как локальную функцию, тогда отпадет необходимость восстанавливать старый обработчик ошибок
http://autolisp.ru/2009/09/13/error-catch/
http://www.lee-mac.com/errorhandling.html

[gomer]

Сообщение от Serg57 И столкнулся со странной вещью, на домашнем компьютере функция работает, а на рабочем нет. Стал экспериментировать с разными компьютерами и заметил, что где стоит процессор АМД все нормально, а где процессор Интел – обработчик ошибок не работает.

А что собственно не работает?

[Serg57]

VVA спасибо, в понедельник попробую на работе, так как дома у меня АМД (еще раз простите, что не в тему) и функция *error* работает и в таком виде, как я прислал.

gomer
Ситуация, например, такая: я черчу белыми линиями (основные линии) на черном экране, линии разрезов красные линии (тонкие). На линии разрезов написал программку, которая перед простановкой разреза переключает цвет на красный и устанавливает определенные привязки, а после выполнения команды восстанавливает исходные привязки и цвет.[/FONT]
[FONT=Times New Roman]Так вот, если в момент запроса точки нажать кдавишу «Esc», то привязки и цвет не восстанавливаются (это на рабочем компьютере), а на домашнем все нормально *ERROR* срабатывает.

[gomer]

у меня к сожалению амд, а на работе автокада нет, причины глюка могут быть самые разные, но все ошибки элементарно проверяются с помощью alert, если уж vlide не используется для отладки

Код:

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

 (defun start_cmd ()
;;; начальная функция
  (setq
	cmd  (getvar "cmdecho")
	blpm (getvar "blipmode")
	apsz (getvar "aperture")
	osmd (getvar "osmode")
	cltp (getvar "celtype")
	ccol (getvar "cecolor")

	*olderr* *error*
	*error*  temperr
  )
)
(defun end_cmd ()
;;; конечная функция
  (princ "\nВосстановление системных переменных...")
  (setvar "cmdecho"   cmd)
  (setvar "blipmode" blpm)
  (setvar "celtype"  cltp)
  (setvar "cecolor"  ccol)
  (setvar "aperture" apsz)
  (setvar "osmode"   osmd)
  (setq *error*  *olderr*)
  (princ)
)
(defun temperr (msg)
;;; обработчик ошибок
  (princ (strcat "\nОшибка: " msg))
  (end_cmd)
)
(defun c:test ( / pt1 pt2)
  (start_cmd)
  (setvar "cecolor" "8") ; вообще это очень глупая строка, только для теста
  (if
	(and (setq pt1 (getpoint "\n1я точка: "))
		 (setq pt2 (getpoint pt1 "\n2я точка: "))
	)
    (setvar "cecolor" 1) ; генерируем ошибку
  )
  (end_cmd)
)

вот попробуйте погонять простой тестовый пример, вопросы: какой цвет становится текущим, и что в командной строке будет написано

[Alexg-12]

Есть код ЛИСП, написанный Кулик Алексей aka kpblc. Создания вспомогательных линий в отдельном слое. Помогите разобраться, как работает.
Возможно в теме и есть подобные примеры, но 100 стр форума - это очень много.
С книгами Полещука знаком. Читаю. Описание всех функций все нашел, но как они все вместе работают, я не понял.
Например: не понял, как условием функции IF может быть отрицание NOT. А функция "vl-catch-all-error-p" возвращает T или NILL. (if (not (vl-catch-all-error-p... - это получается что: (если (не (истина/лож)... Не понятно.
Хотелось бы построчный комментарий.
Зачем тут Lambda?

Код:

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

 
08                                (function 
09                                  (lambda () 
10                                    (vla-item (vla-get-layers adoc) layer) 
11                                    ) ;_ end of lambda 
12                                  ) ;_ end of function

Спасибо.

Код:

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

 

01    (vl-load-com) 
02     
03    (defun c:dwg-xline (/ adoc sysvar layer)
04      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
05      (setq layer  "ИмяСлоя"
06            layer  (if (not (vl-catch-all-error-p
07                              (vl-catch-all-apply
08                                (function
09                                  (lambda ()
10                                    (vla-item (vla-get-layers adoc) layer)
11                                    ) ;_ end of lambda
12                                  ) ;_ end of function
13                                ) ;_ end of vl-catch-all-apply
14                              ) ;_ end of vl-catch-all-error-p
15                            ) ;_ end of not
16                     layer
17                     (vla-get-name (vla-add (vla-get-layers adoc) layer))
18                     ) ;_ end of if
19            sysvar (mapcar
20                     (function
21                       (lambda (x / tmp)
22                         (if (setq tmp (getvar (car x)))
23                           (progn
24                             (setvar (car x) (cdr x))
25                             (cons (car x) tmp)
26                             ) ;_ end of progn
27                           ) ;_ end of if
28                         ) ;_ end of lambda
29                       ) ;_ end of function
30                     (list (cons "clayer" layer))
31                     ) ;_ end of mapcar
32            ) ;_ end of setq
33      (vl-catch-all-apply
34        (function
35          (lambda ()
36            (command "_.xline")
37            (while (/= (getvar "cmdactive") 0) (command pause))
38            ) ;_ end of LAMBDA
39          ) ;_ end of function
40        ) ;_ end of VL-CATCH-ALL-APPLY
41      (foreach item sysvar
42        (setvar (car item) (cdr item))
43        ) ;_ end of foreach
44      (vla-endundomark adoc)
45      (princ)
46      ) ;_ end of defun

[Дима_]

if имеет 3 (или 2) аргумента - условие, действие если да, [действие если нет], соответственно если действие_ДА должно выполняться при не "выполнении" условия, его "оборачивают" в (not....). В автолиспе нет как таковых отдельных булевых типов, вместо них используються в качестве false - пустой список - это "синонимы" (), '(), nil или любой не определенный символ, а в качестве true - используется любое другое значение.

Зачем тут Lambda?

лямбда это функция которая возращает, а не выполняет функцию, то есть vl-catch... надо передать что (какую функцию) выполнять и с какими аргументами - понять эту разницу ИХМО некоторые не могут по очень долго.

[gomer]

Сообщение от Alexg-12 Зачем тут Lambda?

Хороший вопрос
Вот классический вариант выглядит проще гораздо

Код:

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

 (vl-catch-all-apply
  (function vla-item)
  (list
    (vla-get-layers
      (vla-get-activedocument (vlax-get-acad-object))
    )
    "0"
  )
)

[Дима_]

To Gomer вышеприведенный пример будет будет работать только с "чистыми" функциями (которые - не буду скрывать мне импонируют гораздо больше), но в кодах Алексея (не в коем случае не в обиду) всегда во главе стоит "шаблонность" используемого кода, то есть как у Вас - безусловно "красивей", по крайней мере с моей точки зрения, но КРЫС'овский вариант, более "безпроблемный", особенно если "совать" его в любую императивную конструкцию - я, например, их всячески избегаю - за что меня переодически здесь ругают, а Крыс их "не боится".

[Alexg-12]

Очень сложная для новичка тема - функция обработки ошибок. Как она работает в данном примере? Мало хороших разобранных примеров по этой теме в интернете да и у Полещука.
Почему тут в 16 строке стоит "Layer". Условие (not) уже закончилось, а выполняемое действие еще не началось. Или я что-то не понял....

[gomer]

апще, это не лучший пример, обо не стоит забывать

Код:

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

 (tblsearch "LAYER" layer)

[Дима_]

"действие" и "значение" в лиспе есть одинаковые понятия if это тоже функция (как и все в лиспе) - которая тоже возращает значение - то есть if может (и в большинстве случаев "правильного" использования) не задает что делать, а возращает нужный результат.
То есть в "классическом" программировании:

Код:

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

 (if (= a b) (princ "Равно") (princ "Не равно"))

в функциональном:

Код:

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

 (princ (if (= a b) "Равно" "Не равно"))

результат будет одинаков - подходы разные.

[gomer]

ой, страничка закончилась, ну я закончу мысль свою, громоздкая vl-catch-all-apply тут только потому, что vla-Item выдает ошибку с прерыванием при отсутствии искомого слоя

[Alan]

Сообщение от Alexg-12 Есть код ЛИСП, написанный Кулик Алексей aka kpblc. Создания вспомогательных линий в отдельном слое. Помогите разобраться, как работает.

Вся эта тема начиналась с этого вопроса

Возможно в теме и есть подобные примеры, но 100 стр форума - это очень много.

Если бы у меня перед глазами были эти 100 стр., когда я начинал, я бы м.б. научился программировать на Лиспе.
Ни какой Полещук (извините, Ник.Ник., за эти слова - не хотел обидеть ) такого не напишет.
Его книги прекрасные справочники и учебники, а в этой теме разобрали как надо работать с ЛИСП и дали кучу практических решений.

[gomer]

Сообщение от Alan Если бы у меня перед глазами были эти 100 стр., когда я начинал, я бы м.б. научился программировать на Лиспе.

ну это вряд ли

[Alexg-12]

В основном люди занимаются LISP'ом, что бы адаптировать AUTOCAD под вполне конкретную определенную задачу. Ну или несколько таких задач. Базовые принципы программирования - это не сложно. (Мне в частности помогла книга Дэн Эбботта). Но капни чуть-чуть глубже и все! Невозможно самому ни в чем разобраться. И чисто физически нет времени перечитывать всю тему, ибо и так куча времени ушла на книги Полещука (имхо тяжело для понимания он пишет), да и люди все рабочие и семейные. Так что проще и легче спросить конкретно про то, что тебе надо. Опытным людям, я считаю, не составит труда повторно ответить на какие-то вопросы ну или отослать по нужному адресу. Да и тему я полистал - бегло, конечно, но здесь мало относящегося к моему вопросу. (виноват - мог и не заметить)
вернемся к коду:
Все таки я не понял, зачем "layer" в 16 строке.
А то, что происходит после 18 строки, я ваапще только название функцих знакомых встречаю.... Ваппще ничего не понятно.

Код:

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

 
01    (vl-load-com)
02    
03    (defun c:dwg-xline (/ adoc sysvar layer)
04      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
05      (setq layer  "ИмяСлоя"
06            layer  (if (not (vl-catch-all-error-p
07                              (vl-catch-all-apply
08                                (function
09                                  (lambda ()
10                                    (vla-item (vla-get-layers adoc) layer)
11                                    ) ;_ end of lambda
12                                  ) ;_ end of function
13                                ) ;_ end of vl-catch-all-apply
14                              ) ;_ end of vl-catch-all-error-p
15                            ) ;_ end of not
16                     layer
17                     (vla-get-name (vla-add (vla-get-layers adoc) layer))
18                     ) ;_ end of if
19            sysvar (mapcar
20                     (function
21                       (lambda (x / tmp)
22                         (if (setq tmp (getvar (car x)))
23                           (progn
24                             (setvar (car x) (cdr x))
25                             (cons (car x) tmp)
26                             ) ;_ end of progn
27                           ) ;_ end of if
28                         ) ;_ end of lambda
29                       ) ;_ end of function
30                     (list (cons "clayer" layer))
31                     ) ;_ end of mapcar
32            ) ;_ end of setq
33      (vl-catch-all-apply
34        (function
35          (lambda ()
36            (command "_.xline")
37            (while (/= (getvar "cmdactive") 0) (command pause))
38            ) ;_ end of LAMBDA
39          ) ;_ end of function
40        ) ;_ end of VL-CATCH-ALL-APPLY
41      (foreach item sysvar
42        (setvar (car item) (cdr item))
43        ) ;_ end of foreach
44      (vla-endundomark adoc)
45      (princ)
46      ) ;_ end of defun

[gomer]

Сообщение от Alexg-12 Все таки я не понял, зачем "layer" в 16 строке.

(setq layer (if layer layer layer)) так понятно?
(setq layer layer) или так

Сообщение от Alexg-12 А то, что происходит после 18 строки, я ваапще только название функцих знакомых встречаю.... Ваппще ничего не понятно.

(setvar 'clayer layer) все понятно

[Alexg-12]

Сообщение от gomer Хороший вопрос Вот классический вариант выглядит проще гораздо Код: [Выделить все] 1 (vl-catch-all-apply 2 (function vla-item) 3 (list 4 (vla-get-layers 5 (vla-get-activedocument (vlax-get-acad-object)) 6 ) 7 "0" 8 ) 9 ) [/lisp][/code]

Зачем нужна такая сложная конструкция для получения элемента? Зачем для получения элемента использовать "vl-catch-all-apply". Что значит строка (function vla-item) и зачем она нужна? Зачем тут "list"?

[Дима_]

По строкам:
1. исполнить игнорируя ошибки
2. функцию получения элемента
3. примененную к
4. коллекции слоев
5. активного документа, автокада
7. с именем "0"

[Alexg-12]

Спасибо!!
Появляется вопрос. А function зачем здесь? (function - связывает и оптимизирует функцию. Полещук.) Так что vla-item без нее работать не будет?
"vl-catch-all-apply" Нужна только для игнорирования ошибки?
А вот это темный лес: (зачем тут foreach, зачем тут mapcar)

Код:

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

 
19        sysvar (mapcar20                 (function
21                   (lambda (x / tmp)
22                     (if (setq tmp (getvar (car x)))
23                       (progn
24                         (setvar (car x) (cdr x))
25                         (cons (car x) tmp)
26                         ) ;_ end of progn
27                       ) ;_ end of if
28                     ) ;_ end of lambda
29                   ) ;_ end of function
30                 (list (cons "clayer" layer))
31                 ) ;_ end of mapcar
32        ) ;_ end of setq
33  (vl-catch-all-apply
34    (function
35      (lambda ()
36        (command "_.xline")
37        (while (/= (getvar "cmdactive") 0) (command pause))
38        ) ;_ end of LAMBDA
39      ) ;_ end of function
40    ) ;_ end of VL-CATCH-ALL-APPLY
41  (foreach item sysvar
42    (setvar (car item) (cdr item))
43    ) ;_ end of foreach
44  (vla-endundomark adoc)
45  (princ)
46  ) ;_ end of defun

[ShaggyDoc]

"vl-catch-all-apply" Нужна только для игнорирования ошибки?

Для предотвращения разрушения (прерывания) программы в случае ошибки. Это самая замечательная функция, появившаяся в VisualLisp.
Действует наподобие конструкции

Код:

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

try
... попробовать выполнить какие-то действия
except
.... выполнить в случае ошибки
end

в других языках программирования. Т.е. это ловушка ошибок.

Применять vl-catch-all-apply надо в связке с vl-catch-all-error-p и vl-catch-all-error-message.

Чтобы не мучиться каждый раз, надо сделать библиотечную функцию наподобие:

Код:

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

 (defun ru-error-catch
       (protected_expression on_error_expression / catch_error_result)
  (setq catch_error_result (vl-catch-all-apply protected_expression))
  (if (and (vl-catch-all-error-p catch_error_result) on_error_expression)
    (apply on_error_expression (list (vl-catch-all-error-message catch_error_result)))
    catch_error_result
  )
)

Теперь, не зная даже как это работает, можно применять в виде:

Код:

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

 (ru-error-catch
    (function (lambda ()
                ;;; защищаемое выражение  
                (
                
                )
                ;;; То что вернет - будет результатом
              )
    ) 
    (function
      (lambda (err_msg)
        ;; если надо - выводим сообщение. err_msg подставит Автокад
        (princ (strcat "\nОШИБКА такой-то функции: " err_msg))
        ;; возвращаем NIL при ошибке
        nil
      )
    )
  )

Пример применения. Допустим, нужно удалить ПСК. Но нельзя удалить текущую ПСК и нельзя удалить несуществующую.
Можно, конечно, предварительно проверять эти условия, а можно и применить ловушку ошибок

Код:

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

 (defun ru-3d-ucs-delete (ucs_obj)
  (ru-error-catch
    (function (lambda ()
                ;; Это действие, в котором может возникнуть ошибка	 
                (vla-delete ucs_obj)
              )
    )
    (function (lambda (x)
	            ;; А здесь действие в случае ошибки
                ;; (princ "\nОШИБКА: Нельзя удалить действующую ПСК")
                nil
              ) 
    ) 
  ) 
  (princ)
) 

Это очень простой случай, где можно проверить все условия. А бывает, что ошибка может возникнуть из-за множества причин, в том числе из-за действий пользователя. Например, нажатия ESC когда не надо, но без "вылета" программы, который в этом случае произойдет без ловушки ошибок.

[gomer]

вот мой вариант, надеюсь разберетесь

Код:

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

 (defun c:dwg-xline (/ *error* adoc layer clyr)
  (defun *error* (msg)
    (setvar 'clayer clyr)
    (vla-endundomark adoc)
    (princ)
  )
  (vl-load-com)
  (vla-startundomark
    (setq
      layer "ИмяСлоя"
      clyr  (getvar 'clayer)
      adoc  (vla-get-activedocument
	      (vlax-get-acad-object)
	    )
    )
  )

  (if (null (tblsearch "LAYER" layer))
    (vla-put-Color (vla-add (vla-get-layers adoc) layer) acRed)
  )

  (setvar 'clayer clayer) ; ой, недоглядел

  (command "_.xline")
  (while (/= 0 (getvar "cmdactive")) (command pause))

  (*error* nil)

)

[Alexg-12]

Да.
Понятнее на много.
Спасибо.

[gomer]

Немного недоглядел, изменил код #1911

[Alexg-12]

Сообщение от gomer (*error* nil)

а как эта строка отрабатывается? Т.е. понятно, что она отрабатывает функцию defun *error* (msg), но это странный вызов какой-то....

[gomer]

Сообщение от Alexg-12 это странный вызов какой-то....

чем же он странный?

[Кот Пушок]

Помигите.
Делаю первые шаги в лиспе.
Имеется треугольник, из полилинии, который я пытаюсь размножить вокруг точки "0,0"

Записал вот таким вот образом:

(command "_pline" "0,3.0902" "1.3876,5.7295" "1.3876,5.7295" "-1.3876,5.7295" "-1.3876,5.7295" "0,3.0902" "")
(command "_array" "last" "p" "0,0" "5" "360" "_y" "")

А оно не работает.
Как нужно записать?

[gomer]

(command "_pline" "0,3.0902" "1.3876,5.7295" "-1.3876,5.7295" "_close")
(command "_array" "last" "" "p" "0,0" "5" "360" "_y" "")

[Кот Пушок]

Спасибо!

Надо же, такое пропустил...
Смешно даже.

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

gomer, у тебя код какой-то странный... Часть кода универсальна, часть - только для английской версии.

[gomer]

А, да, ну, не мое, не жало
это такое домашнее задание, пусть сам разбирается

[Кот Пушок]

И еще вопрос.
Создаю новый слой:
(COMMAND "_layer" "_n" "MH-Hidden-Medium" "_c" "55" "MH-Hidden-Medium" "")

или:
(COMMAND "_layer" "_n" "MH-Center" "_c" "115" "MH-Center" "")

В первом случае нужна линия hidden, во втором - center.

Как это записать, чтобы заработало?

В выделенным красным цветом местах пытался писать "_h" "_hidden" "hidden" "_c" "_center" "center" - ничего не получилось.

А таки да - у меня английская версия автокада.

[gomer]

(command "_layer" "_n" "MH-Hidden-Medium" "_c" "55" "MH-Hidden-Medium" "_l" "HIDDEN" "MH-Hidden-Medium" "")

[Кот Пушок]

Сообщение от gomer (command "_layer" "_n" "MH-Hidden-Medium" "_c" "55" "MH-Hidden-Medium" "_l" "HIDDEN" "MH-Hidden-Medium" "")

Спасибо огромное!
Теперь понял, что _с было для определения цвета, а я посчитал, что это для сплошной линии...

Красота!

Теперь буду шагать дальше.

[gomer]

Сообщение от Кот Пушок Красота! Теперь буду шагать дальше.

Шагай, только смотри что тебе акад пишет

[Кот Пушок]

Еще вопрос, будьте добры, пожалуйста.
В списке слоёв имеется слой:

(command "_layer" "_n" "Worklines" "_c" "53" "Worklines" "_l" "continuous" "Worklines" "")

Его нужно запретить для печати.
Как это записать в Лиспе?

[gomer]

Сообщение от Кот Пушок Его нужно запретить для печати. Как это записать в Лиспе?

я же сказал см. командную строку, есть опция Plot (Plot/No Plot), а дальше по аналогии, что сложного?

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

А вот не проще ли создавать / модифицировать слой без командных методов?

[Кот Пушок]

Сообщение от gomer я же сказал см. командную строку, есть опция Plot (Plot/No Plot), а дальше по аналогии, что сложного?

Не сложно, когда знаешь, как записать, чтобы лисп работал.

"без командных методов". Один слой создать можно. Да и несколько не проблема.

Я делаю заготовку шаблона из 50-ти, который будет загружаться при начале работы.

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

А потом к файлу, с таким трудом подготовленному, будет применен _.purge. И все, аллес!

[Кот Пушок]

Сообщение от Кулик Алексей aka kpblc А потом к файлу, с таким трудом подготовленному, будет применен _.purge. И все, аллес!

Спасибо за помощь.

Премного благодарен.

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

Как один из вариантов: http://kpblc.blogspot.com/2009/07/txt.html

[Кот Пушок]

Сообщение от Кулик Алексей aka kpblc Как один из вариантов: http://kpblc.blogspot.com/2009/07/txt.html

Спасибо за информацию. С работы у меня, к сожалению, не открывается, посмотрю дома.
Любая информация будет мне на данном этапе полезна - грЫзём гранит науки.

Сейчас записал так:

(command "_layer" "_n" "Worklines" "_c" "53" "Worklines" "_l" "continuous" "Worklines" "_plot" "no" "Worklines" "")

Заработало.

Уря!

Дальше буду изучать, как защитить созданный список слоёв от редактирования.

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

Сообщение от Кот Пушок как защитить созданный список слоёв от редактирования.

Вариант 1: поместить его напрямую в код.
Вариант 2: поместить настройки в сторонний текстовый файл, располагаемый на сервере, и файл закрыть от редактирования.
Вариант 3: поместить настройки в сторонний dws-файл, располагаемый на сервере, и файл подключать автоматически
Вариант 4: поместить настройки в сторонний dwg-файл, и-далее-все-то-же-самое
Вариант 5: ...

[Кот Пушок]

Сообщение от Кулик Алексей aka kpblc Вариант 5: ...

Да, тут есть над чем работать.

Я видел список слоёв, под которым помещен отдельный "список комманд", запрещающих редактирование.
Не пробовал еще, как он работает, да и прочитать эти команды я пока не могу.

Ну, да что-то будет сделанно.
Даже если и применить Purge All , можно потом перезагрузить лисп, и слои вернутся на место.
Так што - буду работать...

[gomer]

Сообщение от Кот Пушок Не сложно, когда знаешь, как записать, чтобы лисп работал.

важно не столько знать как, а понимать что ты хочешь + курить мануалы
Кот Пушок, ну вот ты уже знаешь как создавать слой с опциями, даже несколькими, как их добавлять в конец лисп-выражения, печатаемость слоя - тоже опция, чтоб ее применить, ее также надо добавить как и цвет, тип линии... Просто вызови команду -layer и смотри последовательность ввода, чтоб сделать слой непечатаемым

[Кот Пушок]

Сообщение от gomer Просто вызови команду -layer и смотри последовательность ввода, чтоб сделать слой непечатаемым

Это я делал.
Я знаю, как работать с коммандной строкой.
А вот как записать - не сразу понял.

Писал "_No plot" "N" "plot", еще чего-то, пока не додумался до "_plot" "no"

Не, я ж конешно, понимаю, што гуру любят повыделоваться над новичками, тута ничего не поделаешь.

Но вот почему я такой дурной - если меня что-то спросят, я возьму, да и расскажу.

[gomer]

Сообщение от Кот Пушок Я знаю, как работать с коммандной строкой. А вот как записать - не сразу понял. Писал "_No plot" "N" "plot", еще чего-то, пока не додумался до "_plot" "no"

Что вводишь в командной строке, то и записываешь в (command ... на то это и командный метод называется

[Олег К.]

>> Кот Пушок
Для ZWCADa 2008 написал лисп создания слоев по запросу, к сожалению, там он работает частично, зато в AutoCADe все замечательно. Для каждого слоя сделал кнопку с макросом на панельке. Можно, конечно, задавать слой автоматом при черчении определенных элементов (была тут тема о простановке размеров на отдельном слое), но я так и не смог объяснять это ZWCADу.
Посмотрите, может пригодится чего.

Еще обнаружил в 2006-8 автокадах такое ограничение для команд и функции "entmake"- если в слое используется тип линии отсутствующий в чертеже, то слой создан не будет. Приходится сначала создавать тип линии, а потом уже слой.

[Кот Пушок]

Сообщение от gomer Что вводишь в командной строке, то и записываешь в (command ... на то это и командный метод называется

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

Моя строка выглядела так:

Command: _la
-LAYER
Current layer: "0"
Enter an option
[?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Fre
eze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: p

Enter a plotting preference [Plot/No plot] <Plot>: n

Enter layer name(s) for this plot preference <0>:

А лисп заработал только после "_plot" "no" - но, как я уже говорил, для того, чтобы составить именно такое сочетание, мне пришлось поломать голову. Недолго, но пришлось.

Ну, да дело уже прошлое, сейчас список слоев на просмотре у босса, как отредактирует названия, толщину линий и пр, буду заниматься дальше.
Назрела необходимость для наших двух оффисов создать систему слоев, удобную НАМ для пользования, до этого пользовались системой, созданной "головным оффисом".
А никого, кто знает лисп, у нас здесь нет.
Вот, решил попробовать я.

Сообщение от Олег К. Для ZWCADa 2008 написал лисп создания слоев по запросу

Премного благодарен. Буду изучать.

У меня в начале было в распоряжении два списка слоев, но:
Один список вообще не заработал, второй заработал, но "_с" я посчитал, служит для задания линии "continuous", а потом, когда ничего не получилось, ес-сно, gomer написал коммандную строку, в которой мне, наконец, стало ясно, что от чего зависит.

Вот такое вот - обучение Лиспу на примере.

[gomer]

Кот Пушок, когда ты познаешь лисп, твой мир изменится! Ты когда-нибудь слышал о деревьях?
Вот твое меню команды слой - то самое дерево, или даже не дерево, а лабиринт. Сначала перед тобой множество дверей-опций, ты открываешь одну из них, выбирая опцию Plot и вдруг перед тобой еще перед тобой две двери - Plot и No plot. Откроешь любую и ты снова в начале лабиринта, но ты уже прошел немалый путь и твой новый слой не будет печататься. Вот почему твой код выглядит, как

Код:

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

 (command "_.-layer" ... "_p" "_n" "имя_слоя"  ...)

Обрати внимание, дружок, на заглавные буквы опций, это твои ключи, они должны подходить к дверям лабиринта. Только не забывай постоянно выкрикивать имя слоя, а то никогда из лабиринта не выберешься.
зы, сорри за стеб, вот так это должно выглядеть, имхо

[Кот Пушок]

Сообщение от gomer Кот Пушок, когда ты познаешь лисп, твой мир изменится!

Да, я в самом деле иногда чувствую себя как кот, сидящий на конце ветки дерева.
Ну, или в лабиринте.
Есть чему учиться, но иногда в учебнике дается пример, а до конца не поясняется.
Или не знаешь просто, на что обратить внимание в первую очередь.
Вот и выходит лабуда.

А это то, что у меня получилось, с твоей помощью:

(defun c:MH-lay ()
(command "_layer" "_n" "Background" "_c" "252" "Background" "_l" "continuous" "Background" "")
(command "_layer" "_n" "Background-Hidden" "_c" "252" "Background-Hidden" "_l" "hidden" "Background-Hidden" "")

; здесь список из еще почти 50 слоёв

(command "_layer" "_n" "TitleBlkText" "_c" "white" "TitleBlkText" "_l" "continuous" "TitleBlkText" "")
(command "_layer" "_n" "Worklines" "_c" "53" "Worklines" "_l" "continuous" "Worklines" "_plot" "no" "Worklines" "")
(command "_layer" "_s" "0" "")
)

Понемногу продвигаюсь вперд по тернистым тропам Лиспа.

Написал набросок опоры подшипника головного барабана конвейера, рисует, забавно.
Теперь изучаю, как сделать, чтобы задавать различные размеры подшипников, разную высоту от платформы до центра барабана, и т.д.

Читаю, грызу гранит, глядишь, может, чего и выйдет.

[gomer]

Сообщение от Кот Пушок Понемногу продвигаюсь вперд по тернистым тропам Лиспа.

Похоже что ты идешь не в ту сторону, Пушок. Переходи на темную сторону, у нас вкусные печеньки

Сообщение от Кот Пушок А это то, что у меня получилось, с твоей помощью:

А зачем? Чтоб нарисовать печеньку в определенном слое нужен всего лишь один слой... остальное мусор, мусор обычно хранят в шаблонах, а контролируют с помощью стандартов оформления, о чем тут уже сказали... Кстати, есть еще замечательная утилитка - LayerCreator. Там все уже написано до нас

Сообщение от Кот Пушок Теперь изучаю, как сделать, чтобы задавать различные размеры подшипников,

это ты можешь и без лиспа сделать, в виде дин. блока, а вставлять с палитры инструментов, например

Сообщение от Кот Пушок разную высоту от платформы до центра барабана, и т.д.

ну вот ты уже и подошел к параметрическому черчению, это уже прогресс, теперь изучай функции ввода/вывода информации а ля get*** А когда надоест, переходи к диалогам

[Кот Пушок]

Сообщение от gomer теперь изучай функции ввода/вывода информации а ля get*** А когда надоест, переходи к диалогам

Помогите!

Пишу:

(defun c:str ()
(info)
(draw)
)
(defun info ()
(princ "Please click a point: ")
(setq pt (getpoint))
(setq d (getreal "\nEnter distance in inches: "))
)
(defun draw (/ pt)
(command "_line" pt d "")
)

Хочу нарисовать линию любой задаваемой длины.
Нифига не выходит...

[gomer]

Отрезок строится по 2м точкам, а не по точке и расстоянию в никуда

[Кот Пушок]

Сообщение от gomer Отрезок строится по 2м точкам, а не по точке и расстоянию в никуда

Пробовал писать

(command "_line" pt "@0,d" "") все равно d не читает.

а вот так работает:

(setq startpt (getpoint "Select the start point:"))
(setq endpt (getpoint "Select the end point"))
(command "_line" startpt endpt "")

в любом направлении пишет отрезок, не зависимо ОРТО включенно или нет.

Не пойму, как переменную правильно ввести...

[gomer]

(command "_line" pt (strcat "@0," (rtos d)) "") как-то так...
Ну основное в функции draw переменная pt локализована и равна nil а отрезок из ниоткуда, также трудно построить, как и отрезок в никуда

[Кот Пушок]

Сообщение от gomer (command "_line" pt (strcat "@0," (rtos d)) "") как-то так...

Ох, горе мне, горе мне...
Увы мне, окаянному (с)


Спасибо!

[Кот Пушок]

Хе-хе.

Код:

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

 (defun c:slot (/ p d L R)
(setq p (Getpoint "Select point: "))
(setq d (Getreal "Identify Slot Diameter: "))
(setq L (Getreal "Identify Slot Lengths: "))
(setq R (Getreal "Specify Rotation Angle: "))
(Draw p d L R)
)
(prompt "slot, ")
(defun Draw (p d L R / p1 p2 p3 p4 p5 p6 x y det)
(setq
x (nth 0 p)
y (nth 1 p)
p1 (list (- x (/ (- L d) 2.0)) (+ y (/ d 2.0)))
p2 (list (+ x (/ (- L d) 2.0)) (+ y (/ d 2.0)))
p3 (list (+ x (/ (- L d) 2.0)) (- y (/ d 2.0)))
p4 (list (- x (/ (- L d) 2.0)) (- y (/ d 2.0)))
p5 (list (- x (/ (- L d) 2.0)) y)
p6 (list (+ x (/ (- L d) 2.0)) y)
)
(command "_osnap" "_none")
(command "_pline" p1 p2 "_arc" "_ce" p6 "_a"
-180 "_l" p3 p4 "_arc" "_ce" p5 "_a"
-180 "_cl" ""
)
(command "_rotate" "_last" "" p1 R "")
(command "_osnap" "int,cen,end,ins")
(prompt "Draw ")
)

рисует slot (не знаю, как это по-русски) любой длины, любого диаметра, под любым углом.

Лёд тронулся, господа присяжные заседатели!
Лёд тронулся

[Дима_]

Ну раз тронулся - поскорей забывайте командные методы рисования и вперед DXF/VLA.

[gomer]

Сообщение от Кот Пушок рисует slot (не знаю, как это по-русски)

Видимо шпоночный паз

Сообщение от Дима_ у раз тронулся - поскорей забывайте командные методы рисования и вперед DXF/VLA.

Да погодите вы, дайте поиздеваться над животными, ну хоть здесь
А первых строках своего письма, хочется предположить, что динамический блок в данном случае предпочтительнее
А во-вторых, жмите F2 и смотрите что вы там наворотили

[Кот Пушок]

А во-вторых, жмите F2 и смотрите что вы там наворотили

Но рисует же.

А что там неправильно?

[gomer]

Сообщение от Кот Пушок А что там неправильно?

да много чего? основная ошибка как раз с "" в command
ну вот хотя б так, хотя это тоже концептуально плохой код

Код:

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

 (defun C:SLOT (/ *error* aDoc p d L R osm p1 x y p2 p3 p4 p5 p6)
  (defun *error* (msg) (princ))
  (setvar 'cmdecho 1)
  (if (and (setq p (getpoint "\nSelect insertion point: "))
	   (setq d (getreal "\nIdentify Slot Diameter: "))
	   (setq L (getreal "\nIdentify Slot Lengths: "))
	   (setq R (getreal "\nSpecify Rotation Angle: "))
      )
    (progn
      (vl-load-com)
      (setq
	osm (getvar 'osmode)
	x   (nth 0 p)
	y   (nth 1 p)
	p1  (list (- x (/ (- L d) 2.0)) (+ y (/ d 2.0)))
	p2  (list (+ x (/ (- L d) 2.0)) (+ y (/ d 2.0)))
	p3  (list (+ x (/ (- L d) 2.0)) (- y (/ d 2.0)))
	p4  (list (- x (/ (- L d) 2.0)) (- y (/ d 2.0)))
	p5  (list (- x (/ (- L d) 2.0)) y)
	p6  (list (+ x (/ (- L d) 2.0)) y)
      )
      (vla-StartUndoMark
	(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
      )
      (setvar 'cmdecho 0)
      (setvar 'osmode 0)
      (command "_.pline"     p1	    p2	   "_a"	  "_ce"	 p6	"_a"
	       -180   "_l"   p3	    p4	   "_a"	  "_ce"	 p5	"_a"
	       -180   "_cl"
	      )
      (if (/= R 0.0)
	(command "_.rotate" "_l" "" p1 R)
      )
      (setvar 'cmdecho 1)
      (setvar 'osmode osm)
      (vla-EndUndoMark aDoc)
    )
  )
  (princ)
)

[Кот Пушок]

Сообщение от gomer да много чего? основная ошибка как раз с "" в command ну вот хотя б так, хотя это тоже концептуально плохой код

Ну, к этому я пока еще не дошел.

Я ж говорил, первые шаги и первые попытки.
Учусь, так сказать.

А за помощь - спасибо.

Буду дальше биться головой ап стену.
Постараюсь на следующей неделе разобраться в этом "концептуально" плохом коде.

[Олег (jr.)]

Еще один неконцептуальный

Код:

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

(defun c:slt (/ *error* ang osm ped pt rad len)
(defun *error* (msg) 

    (cond ((not msg)) 
     ((vl-position 
             msg 
             '("Function cancelled" "quit / exit abort" "console break") 
           ) 
          ) 
          ((princ (strcat "\nSlot Command Error: " msg))) 
    )
    (command)
    (command "undo" "e")
    
	(setvar "cmdecho" 0)
	(if osm
	  (setvar "osmode" osm))
	(if ped
	  (setvar "peditaccept" ped)) 
   
       (setvar "cmdecho" 0) 
    (princ) 
  )
  
 ;;   ------------------    main part   -------------------------    ;;
  
(command "undo" "be")
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq ped (getvar "peditaccept"))
(setq pt (getpoint "\nInsertion point of slot:  "))
(setq rad (getdist pt "\nRadius:  "))
(setq len (getdist pt "\nLength:  "))
(setq ang (getangle pt "\nRotation angle:  "))
(setq lst (entlast))
(command "arc"
	 "c"
	 pt
	 (polar pt (+ (/ pi 2) ang) rad)
	 "a"
	 "180")
(command "line"
	 ""
	 (polar (getvar "lastpoint") rad len)
	 "")
(command "arc"
	 ""
	 (polar (getvar "lastpoint") (+ (/ pi 2) ang) (* 2 rad)))
(command "line"
	 ""
	 (polar (getvar "lastpoint") (+ pi ang) len)
	 "")
;; gather all of the creared entities
(setq sset (ssadd))
(while (setq next (entnext lst))
  (ssadd next sset)
  (setq lst (entnext lst))
  );; end of gathering
(setvar "peditaccept" 1)
(command "pedit" "m" sset "" "j" "" "")
(command "erase" sset "")
(*error* nil)  
(princ)
)

[Кот Пушок]

Сообщение от Олег (jr.) Еще один неконцептуальный

Спасиба!

Вот ведь как...

[papelard]

Добрый день, у меня вопрос по замечательному лиспу, который похоже написал Кулик Алексей aka kpblc, поэтому надеюсь с топиком я не промахнулся.
Лисп автоматически последовательно нумерует точки, а затем экспортирует их координаты в txt/csv-файл. Работает он отлично, но у него есть один недостаток: если ты промахнулся мимо нужной точки отменить действие увы нельзя. Комбинация <Ctrl>+<Z> выдает сообщение "Неверная точка", а нажатие клавиши <Esc> завершает нумерацию и появляется окно выбора папки для сохранения результатов.
Буду очень благодарен если вы поможете это исправить.

Код:

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

 (vl-load-com)

(defun c:pt2file (/ adoc file handle pt lst count blk_name blk_def blk_ref)
  (if (/= (type (setq count (vl-catch-all-apply
                              (function
                                (lambda ()
                                  (initget 6)
                                  (getint "\nВведите начальный номер точки <1> : ")
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              ) ;_ end of vl-catch-all-apply
                      ) ;_ end of setq
                ) ;_ end of type
          'int
          ) ;_ end of /=
    (setq count 1)
    ) ;_ end of if
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (/= (type
            (setq blk_def (vl-catch-all-apply
                            (function (lambda () (vla-item (vla-get-blocks adoc) (setq blk_name "inoe.kpblc.point"))))
                            ) ;_ end of vl-catch-all-apply
                  ) ;_ end of setq
            ) ;_ end of type
          'vla-object
          ) ;_ end of /=
    ((lambda (/ circle att)
       (setq blk_def (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) blk_name)
             circle  (vla-addcircle blk_def (vlax-3d-point '(0. 0. 0.)) 1.)
             att     (vla-addattribute blk_def
                                       2.5
                                       acattributemodepreset
                                       "Номер точки"
                                       (vlax-3d-point '(1. 1. 0.))
                                       "PointNumber"
                                       "-"
                                       ) ;_ end of vla-AddAttribute
             ) ;_ end of setq
       (vlax-for ent blk_def
         (vla-put-color ent 0)
         (vla-put-lineweight ent aclnwtbyblock)
         (vla-put-linetype ent "Continuous")
         (vla-put-layer ent "0")
         ) ;_ end of vlax-for
       (vla-put-color circle 1)
       ) ;_ end of lambda
     )
    ) ;_ end of if

  (while (= (type (setq pt (vl-catch-all-apply
                             (function
                               (lambda ()
                                 (trans (getpoint "\nУкажите точку <Хватит> : ") 1 0)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'list
            ) ;_ end of =
    (setq blk_ref (vla-insertblock (vla-get-modelspace adoc) (vlax-3d-point pt) blk_name 1. 1. 1. 0.))
    (vla-put-textstring (car (vlax-safearray->list (vlax-variant-value (vla-getattributes blk_ref))))
                        (itoa count)
                        ) ;_ end of vla-put-textstring
    (setq lst   (cons (cons count pt) lst)
          count (1+ count)
          ) ;_ end of setq
    ) ;_ end of while
  (if (and (setq file (getfiled "Укажите файл для сохранения результатов"
                                (vl-filename-base (getvar "dwgname"))
                                "txt;csv"
                                1
                                ) ;_ end of getfiled
                 ) ;_ end of setq
           (/= file "")
           ) ;_ end of and
    (progn
      (vl-catch-all-apply
        (function
          (lambda ()
            (setq handle (open file "w"))
            (write-line "№;x;y" handle)
            (foreach item (reverse lst)
              (write-line (strcat (rtos (car item) 2 0) ";" (rtos (cadr item) 2 3) ";" (rtos (caddr item) 2 3))
                          handle
                          ) ;_ end of write-line
              ) ;_ end of foreach
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      (vl-catch-all-apply (function (lambda () (close handle))))
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

(princ "\nType pt2file to run command")
(princ)

И еще, если можно, хотелось бы чтоб номер точки подписывался в выноске в виде n / z, где n - номер точки (атрибут блока), а z - общее количество точек (его можно вводить через командную строку)

[papelard]

Ребят, пожалуйста, помогите разобраться. Сам я человек от программирования далекий - неделю разбирался как в лиспе заштриховать кружок и шрифт у текста поменять .
По поводу отмены введеной точки могу только догадываться что надо разбираться с функциями vla-startundomark и vla-endundomark которые в этом лиспе уже есть но я не совсем понимаю как они работают.
По поводу выноски догадываюсь что в этот фрагмент лиспа

Код:

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

(setq blk_def (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) blk_name)
	             circle  (vla-addcircle blk_def (vlax-3d-point '(0. 0. 0.)) 1.)
	             att     (vla-addattribute blk_def
	                                       2.5
	                                       acattributemodepreset
	                                       "Номер точки"
	                                       (vlax-3d-point '(1. 1. 0.))
	                                       "PointNumber"
	                                       "-"
	                                       ) ;_ end of vla-AddAttribute
	             ) ;_ end of setq

надо вписать функцию vla-addleader, как работает которая я опять же не разобрался, и как связать выноску с атрибутом тоже не понимаю.

Может кто из старожилов форума подскажет тему (если такая есть на форуме) которая поможет мне с этим разобраться

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

Со временем абсолютный "затык", поэтому попытаюсь объяснить кратко:
#1957 - это создание описания блока и его наполненности, не более того. Чтобы сделать то, что хочется, надо переделывать кусок

Код:

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

   (while (= (type (setq pt (vl-catch-all-apply
                             (function
                               (lambda ()
                                 (trans (getpoint "\nУкажите точку <Хватит> : ") 1 0)
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'list
            ) ;_ end of =
;;; <...>
    ) ;_ end of while

Причем переделывать надо именно условие while в части получения точки.

[papelard]

да уж, дело ясное что дело темное

[Alevtina R]

добрый вечер! Недавно начала осваивать лисп, возникла вот такая загвоздка: как сделать, чтоб программа создавала блок, если его нет в чертеже, а если есть, то использовала то что есть? тут вроде как нужна функция if. как узнать есть ли описание блока в чертеже?
вот она програмка, писала сама, только не смейтесь
(defun C:ci (/ sc1 rad1 ci1)
(setq sc1 (getdist "\nМасштаб <100>: "))
(if (= sc1 nil)
(setq sc1 100)
);if
(setq rad1 (* 0.8 sc1))
(command "._CIRCLE" "0,0" rad1)
(setq ci1 (entlast))
(command "._BLOCK" "v" (list 0 (- rad1)) ci1 "")
(command "._MEASURE" pause "_B" "v" "" pause pause)
(command "._GROUP" "" "*" "" "_p")
)

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

Для поиска описания блока можно воспользоваться (tblsearch "block" <Имя блока в кавычках>)

[Alevtina R]

Не получается..
точнее когда описание блока есть в файле программа работает, а когда описания блока нет выдает:
Масштаб <100>:
; ошибка: неверная функция: ""
в чем может быть ошибка?

(defun C:ci (/ sc1 rad1 ci1 vs1)
(setq s1 (tblsearch "block" "v"))
(if (= s1 nil)
((setq sc1 (getstring "\nМасштаб <100>: "))
(if (= sc1 nil)
(setq sc1 100)
);if
(setq rad1 (* 0.8 sc1))
(command "._CIRCLE" "0,0" rad1)
(setq ci1 (entlast))
(setq vs1 (list 0 (- rad1)))
(command "._BLOCK" "v" vs1 ci1 "")
)
);if
(command "._MEASURE" pause "_B" "v" "" pause pause)
(command "._GROUP" "" "*" "" "_p" "")
(princ)
)

[gomer]

Сообщение от Alevtina R Не получается..

и не получится, потому что надо знать что делаешь!

Сообщение от Alevtina R ((setq sc1 (getstring "\nМасштаб <100>: "))

Здесь сразу 2 ошибки

Код:

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

 (defun C:CI (/ sc1 s1 rad1 vs1 ci1)

  (setq sc1 (getreal "\nМасштаб <100>: "))

  (or sc1 (setq sc1 100.))

  (if (not (setq s1 (tblsearch "BLOCK" "v")))
    (progn
      (setq rad1 (* 0.8 sc1)
	    vs1	 (list 0. (- rad1))
      )
      (command "._CIRCLE" "0,0" rad1)
      (setq ci1 (entlast))
      (command "._BLOCK" "v" vs1 ci1 "")
    )
  )

  (command "._MEASURE" pause "_B" "v" "" pause pause)
  (command "._GROUP" "" "*" "" "_p" "")

  (princ)
)

вот так чет там рисует

[Alevtina R]

спасибоздорово, все рисует!
Ну да, я не совсем знаю что делаю.. потому что я только учусь..

[gomer]

объясняю, вы спрашиваете строку (getstring), потом используете ее как вещественное число, ну и со скобками запутались

[Alevtina R]

Добрый вечер! При вставке блоков через программу блоки поворачиваются на некоторый угол, (правда не все, а только некоторые). Не пойму это у меня программа с косяком или сами блоки?
Снова не пойму где я не так делаю..программу и файл прилагаю.
Программа:

Код:

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

 (defun errorinsc (message)
  (command)
  (setvar "CMDECHO" cm1)
  (setvar "CECOLOR" cc1)
  (setvar "CELTYPE" clt1)
  (setvar "CELWEIGHT" clw1)
  (setvar "CLAYER" la1)
  (setq *error* existError)
  (prompt "\nСистемные переменные восстановленны: ")
  (princ)
);defun errorinsc3
(defun C:INA (/ existError in1 cm1 cc1 clt1 clw1 la1 er1)
  (setq existError *error*)
  (setq *error* errorinsc)
  (setq cm1 (getvar "CMDECHO")
	cc1 (getvar "CECOLOR")
	clt1 (getvar "CELTYPE")
	clw1 (getvar "CELWEIGHT")
        la1 (getvar "CLAYER")
  );setq
  (setvar "CMDECHO" 0)
  (command "._UNDO" "_be")
  (command "._INSERT" "библиотека блоков оформления.dwg" "0,0" "" "" "")
  (setq er1 (entlast))
  (command "._ERASE" er1 "")
  (command "._LAYER" "_N" "В-ОФОРМЛЕНИЕ" "_C" "250" "В-ОФОРМЛЕНИЕ" "_Lw" 0.20 "В-ОФОРМЛЕНИЕ" "_S" "В-ОФОРМЛЕНИЕ" "")
  (setvar "CECOLOR" "BYLAYER")
  (setvar "CELTYPE" "BYLAYER")
  (setvar "CELWEIGHT" -1)
  (or sc1 (setq sc1 (getreal "\nМасштаб: ")))
  (setq in1 (getpoint "Точка вставки: "))
  (while in1
    (command "._INSERT" "фигурная скобка" in1 sc1 sc1 "0")
    (setq in1 (getpoint "Точка вставки: "))
  );while
  (command "._UNDO" "_end")
  (setvar "CMDECHO" cm1)
  (setvar "CECOLOR" cc1)
  (setvar "CELTYPE" clt1)
  (setvar "CELWEIGHT" clw1)
  (setvar "CLAYER" la1)
  (setq *error* existError)
  (princ)
);defun ina

[gomer]

OSMODE отключить забыла

[Alevtina R]

Всё равно поворачивает эти 2 блока "линия разрыва" и "фигурная скобка", все остальные еще 10 штук вставляются нормально с привязкой и в любом варианте команды "._INSERT".

Пробовала значения 0, 20535, 16384 и через кнопку отключать. Попробовала разные варианты команды "._INSERT"
на варианты:
(command "._INSERT" "фигурная скобка" in1 sc1 sc1 "0")
(command "._INSERT" "фигурная скобка" in1 sc1 sc1 "")
вставляет и поворачивает
на вариант:
(command "._INSERT" "фигурная скобка" in1 sc1 sc1 pause)
1 раз вставляет, а дальше пишет:
"Точка вставки: Точка вставки:
Неверное определение рамки.
Системные переменные восстановленны:"

[gomer]

1. Поспешили вы, Алевтина, глушить вывод в командную строку, дело то не в привязках оказалось
2. Учитесь разбивать программы на фрагменты и выстраивать их логику
3. Ну вот так у меня получилось:

Код:

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

 (defun errorinsc (message)

  (end_cmd)

)

(defun start_cmd ()
  (setq existError *error*)
  (setq *error* errorinsc)
  (setq
    osm	 (getvar "OSMODE")
    cm1	 (getvar "CMDECHO")
    cc1	 (getvar "CECOLOR")
    clt1 (getvar "CELTYPE")
    clw1 (getvar "CELWEIGHT")
    la1	 (getvar "CLAYER")
  )
  (setvar "OSMODE" 0)
  (setvar "CMDECHO" 0)
  (command "._UNDO" "_be")
)

(defun end_cmd ()
  (command "._UNDO" "_end")
  (setvar "CMDECHO" cm1)
  (setvar "CECOLOR" cc1)
  (setvar "CELTYPE" clt1)
  (setvar "CELWEIGHT" clw1)
  (setvar "CLAYER" la1)
  (prompt "\nСистемные переменные восстановлены")
  (setq *error* existError)
  (princ)
)



(defun C:INA (/ in1 osm cm1 cc1 clt1 clw1 la1 er1)

  (start_cmd)

  (if (not (tblsearch "BLOCK" "библиотека блоков оформления"))
   (progn (command
      "_.INSERT"	    "библиотека блоков оформления.dwg"
      "S"		    1			  "0,0"
      0
     )
    (command "_.ERASE" (entlast) ""))
  )

  (if (not (tblsearch "LAYER" "В-ОФОРМЛЕНИЕ"))
    (command
      "._LAYER"	    "_N"	  "В-ОФОРМЛЕНИЕ"
      "_C"	    "250"	  "В-ОФОРМЛЕНИЕ"
      "_Lw"	    0.20	  "В-ОФОРМЛЕНИЕ"
      "_S"	    "В-ОФОРМЛЕНИЕ"		""
     )
  )


  (setvar "CECOLOR" "BYLAYER")
  (setvar "CELTYPE" "BYLAYER")
  (setvar "CELWEIGHT" -1)

  (if (or *sc1* (setq *sc1* (getreal "\nМасштаб: ")))

    (while (setq in1 (getpoint "Точка вставки: "))
      (command "_.INSERT" "фигурная скобка" "_S" *sc1* in1 0)

    )
  )

  (end_cmd)
)

[Alevtina R]

А можно пояснить как это делается, хотя бы на примере этой программы?

(command "_.INSERT" "фигурная скобка" "_S" *sc1* in1 0)
что значит "_S" ?

[gomer]

попробуйте вручную ввести -INSERT, и посмотреть опции команды, это масштаб вставки блока
Важно понимать какие события происходят в команде, следовательно какие режимы можно выделить в отдельные функции. Их можно унифицировать и использовать в других командах
Ну вот, так получилось, чуть посложнее:

Код:

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

 (defun errorinsc (message)
  ;; тут желательно добавить обработчик ошибок
  ;; по нажатию ESC
  (end_cmd)

)

(defun start_cmd ()
  ;; начинаем нашу команду
  (vl-load-com)

  (if (logand 8 (getvar "UNDOCTL")) ; заканчиваем предыдущую группу UNDO
    (vla-EndUndoMark
      (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
  )

  (vla-StartUndoMark adoc) ; начинаем новую группу UNDO

  ;; настраиваем вывод служебных сообщений
  (if (setq *NOMUTE* T)
    (princ "\nСохранение системных переменных")
  )
  ;; сохраняем системные пременные
  (setq
    osm	       (getvar "OSMODE")
    cm1	       (getvar "CMDECHO")
    cc1	       (getvar "CECOLOR")
    clt1       (getvar "CELTYPE")
    clw1       (getvar "CELWEIGHT")
    la1	       (getvar "CLAYER")
    existError *error* ; и 'системный' обработчик ошибок
    *error*    errorinsc
  )
)

(defun end_cmd ()
  ;; возвращаем системные пременные
  (setvar "CMDECHO" cm1)
  (setvar "CECOLOR" cc1)
  (setvar "CELTYPE" clt1)
  (setvar "CELWEIGHT" clw1)
  (setvar "CLAYER" la1)
  (if *NOMUTE*
    (princ "\nСистемные переменные восстановлены")
  )
  (setq *error* existError)

  (vla-EndUndoMark adoc)		; заканчиваем команду
  (princ)
)

(defun set_ui_mode ()
  (setvar "CMDECHO" 1)			; отображаем пользовательский ввод
  (setvar "OSMODE" osm)			; здесь устанавливаем значение по вкусу
  (setvar "CLAYER" la1)			; делаем незаметным именение слоя
)

(defun set_insert_mode ()
  (setvar "CMDECHO" 0)                         ; глушим вывод в командную строку
  (if (not (tblsearch "LAYER" "В-ОФОРМЛЕНИЕ"))
    (command				; создаем слой, если его нет
      "._LAYER"	    "_N"	  "В-ОФОРМЛЕНИЕ"
      "_C"	    "250"	  "В-ОФОРМЛЕНИЕ"
      "_Lw"	    0.20	  "В-ОФОРМЛЕНИЕ"
      "_S"	    "В-ОФОРМЛЕНИЕ"		""
     )
    (setvar "CLAYER" "В-ОФОРМЛЕНИЕ")	; или устанавливаем текущим
  )

  (setvar "OSMODE" 0)			; убираем привязку
  (setvar "CECOLOR" "BYLAYER")
  (setvar "CELTYPE" "BYLAYER")
  (setvar "CELWEIGHT" -1)
)

(defun insert_blklib ()
  (if (not (tblsearch "BLOCK" "библиотека блоков оформления"))
   (progn
    (command
      ;; здесь еще желательно добавить проверку существования
      ;; файла библиотеки. Как по мне, лучше хранить блоки в
      ;; отделном файле
      "_.INSERT"	    "библиотека блоков оформления.dwg"
      "S"		    1			  "0,0"
      0
     )
    (entdel (entlast)) ; удаляем блок
    )
  )
)


(defun C:INA (/ adoc in1 osm cm1 cc1 clt1 clw1 la1 er1)

  (start_cmd)				; сохраняем системные переменные

  ;; выбираем масштаб или завершаем команду
  ;; это первый источник возможной ошибки  
  (if (or *sc1* (setq *sc1* (getreal "\nМасштаб: ")))
    (progn

      (set_ui_mode)			; включаем режим пользовательского ввода

      ;; получаем точку вставки блока
      ;; это второй источник возможной ошибки
      (setq in1 (getpoint "Точка вставки: "))

      (set_insert_mode)			; перключаемся в режим вставки блока

      (insert_blklib)			; вставляем библиотеку, если ее нет в файле

      ;; вставляем блок, можно было бы объединить с предыдущей функцией,
      ;; но иногда приходится вставлять несколько блоков сразу
      (command "_.INSERT" "фигурная скобка" "_S" *sc1* in1 0)

      ;; повторяем действия
      (while (progn (set_ui_mode)
		    (setq in1 (getpoint "Точка вставки: "))
	     )
	(set_insert_mode)
	(command "_.INSERT" "фигурная скобка" "_S" *sc1* in1 0)
      )
    )
  )
  
  (end_cmd)
  
)

Offtop: ps ох, чет я не соображаю, видимо ноябрь...

[Alevtina R]

Спасибо пойду изучать

[Alevtina R]

Можно поподробнее про проверку существования файла библиотеки или ссылочку какую-нибудь
я чего-то ничего не нашла..

[gomer]

Сообщение от Alevtina R Можно поподробнее про проверку существования файла библиотеки

самый простой способ:

Код:

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

 (if (setq fn (findfile "blklibpath/blk_lib.dwg")) 
  (command "_.INSERT" fn nil)
)

[dirge]

Ребята, всем привет! Подскажите можно ли из лиспа вытащить имя свойства объекта?

[papelard]

У меня вопрос к знатокам.
Мне необходимо чтобы лисп создавал *.CSV файл в котором помимо координат и номеров точек должен присутствовать текст с формулой которая содержит символы √ и Δ.

Так вот если лисп сохранен в кодировке ANSI то эти символы в CSV заменяются на “v” и “?” и приходится в Notepad++’е конвертировать CSV в UTF-8 а после уже делать замену символов.

Если же лисп сохранить в кодировке UTF-8 то весь русский текст лиспа в AutoCAD-е превращается в набор иероглифов, а полученный CSV если его открывать в Notepad++ выглядит вроде как и надо бы, но если открывать его в excel’е весь русский текст превращается в иероглифы. И программа для которой по идее и создается этот CSV не хочет импортировать данные из него.

Так вот собственно вопрос. Как сделать так, чтобы символы √ и Δ и русский текст отображались корректно в экспортированном CSV-файле, а русский текст не превращался в иероглифы в AutoCAD’е и вообще возможно ли это?

[gomer]

Что-то видно все профессионалами стали в лиспе, что ж апну темку. Вопрос таков, точнее не вопрос, а просьба подтвердить ситуацию: Есть функция getdist, которая нормально работает во всех случаях, кроме как в связке с action_tile, в этом случае просто возвращает nil, даже не предлагая указать расстояние. Об этом не написано ни в справке, ни у Н. Полещука, у которого, да и не только у него, припасен бубен в виде конструкции cond. Замечу, что в брикскаде getdist работает, но при нажатии Esc программа завершается несмотря на бубен. Если кому интересно, вот пример кода, который красив, но не работает:

Код:

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

 (defun test ( / *error* accept_clk cancel_clk ok1_clk step tmp)

  (vl-load-com)

  (defun *error* ()
   (princ)
  )
  (defun ok1_clk ()
	(done_dialog 2)
	(setq
	  tmp
	  (vl-catch-all-apply
			 'getdist
			 '("\nУкажите размер сетки <Отмена>: ")
	  )
	)
	(cond
	  ((= 'REAL (type tmp))
		(setq n_razm (vl-princ-to-string tmp))
	  )
	  ((vl-catch-all-error-p tmp)
		(princ (vl-catch-all-error-message tmp))
	  )
	  (T (princ (type tmp)))
	)
  )

  (defun accept_clk ()
    (done_dialog 1)
  )

  (defun cancel_clk ()
    (done_dialog 0)
  )

  (or n_razm (setq n_razm "1.00"))
  (setq step 2)


  (if (> 0 (setq dcl_id (load_dialog "test")))
	(progn
	  (alert "Ошибка загрузки диалога")
	  (exit)
	)
  )

  (while (> step 1)
	(if (null (new_dialog "dlg" dcl_id))
	  (progn
		(alert "Ошибка создания диалога")
		(exit)
	  )
	)

	(set_tile "razm" n_razm)
	(action_tile "ok1"    "(ok1_clk)")
	(action_tile "accept" "(accept_clk)")
	(action_tile "cancel" "(cancel_clk)")

	(setq step (start_dialog))
  )
  (unload_dialog dcl_id)
)

и диалог:

Код:

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

dlg: dialog {
  label="Пример";
  : row {
	: edit_box{ label="Размер сетки: "; key="razm"; edit_width=8;edit_limit=8; }
	: retirement_button { key="ok1"; label=">>";}
  }
  spacer;
  ok_cancel;
}

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

Шансов сейчас проверить нет, поэтому в качестве варианта: закрыть диалог, получить результат ввода, снова сформировать диалог и показать его. Кажется, другого варианта для использования dcl нету..

[alega11]

Спасибо огромное!

Up.
_________

код с копированием работает на ура.
НО очень надо чтобы инкрементирование происходило при создании новой мультивыноски.
Своих мозгов подправить код не хватает.
ОЧЕНЬ НАДО, каждый день сотни выносок вручную нумерую.
Спасибо.

[perpetule]

Практически первый опыт, да и не написание, а переделка от проффи lee mac и др., но работает как хотел. Выношу на суд и доработку.
txt2att.lsp
команда вызова txt2att

Последовательно.
Чертим в модели приблизительно начинку блока, вместо атрибутов используем однострочный текст, с желаемыми св-вами.
Вызываем txt2att
Выбор рамкой и конвертация одного/нескольких однострочных текстов в атрибуты (и таг и подсказка и сод - бывшее значение содержания текста).
По выходу из выбора рамкой текста ставшего атрибутами, имеем в буфере ОС текстовую строку вида годмесяцчисло.часминутасекунда,
за сим из лиспа вызывается диалоговое окно создания блока, где по желанию используем или нет то что торчит текстовой строкой в буфере, далее работаем как обычно, вторично указывая границы создаваемого блока ,
ну и все остальные галки по желанию, как обычно. На выходе имеем готовый статичный блок с готовыми атрибутами.

Что хотелось бы добавить - имя юзверя/пользователя - в конце строки (предполагается что таковых мер будет достаточно для уникального автоматом сформированного названия блока, вопрос конечно спорный).

Код:

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

 ;;; http://www.cadtutor.net/forum/showthread.php?33866-Convert-text-to-attribute
;;;  Try this for multiple selections
;;;  Convert text to attribute
;;;  thanx david. that works like a dream
;;;  David Bethel Not woking when the text has spaces
;;;  This should deal with spaces - Lee Mac
;;;  above code dealing with space not spaces the routine can deal with txt txt but cant with txt txt txt txt
;;;  Latest code Lee Mac 27th May 2010
;;;  http://www.cadtutor.net/forum/showthread.php?33866-Convert-text-to-attribute/page3
;;;  Txt2Att  (Lee_Mac)
;;; Converts Single-line Text to Attribute Definition
;;;   ^C^C(IF (NULL C:txt2att)(LOAD "txt2att.lsp"));txt2att;
;; Txt2Att  ( Lee Mac )
;; Converts Single-line Text to Attribute Definition
;; 
;;  +  tc71  вызов диалогового окна редактора блоков, 
;;  с помещением в буфер обменыа оси текущей даты и времени
;;


(defun c:txt2att ( / StringSubst RemovePairs ss ent eLst str dx73 )
  (vl-load-com)
  ;; Lee Mac  ~  27.04.10

  (defun StringSubst ( new pat str )
    (while (vl-string-search pat str)
      (setq str (vl-string-subst new pat str))
    )
    str
  )

  (defun RemovePairs ( lst pairs )
    (vl-remove-if
      (function
        (lambda ( pair )
          (vl-position (car pair) pairs)
        )
      )
      lst
    )
  )

  (if (setq ss (ssget "_:L" '((0 . "TEXT"))))
    
    ( (lambda ( i )
        
        (while (setq ent (ssname ss (setq i (1+ i))))
          (setq eLst (entget ent)
                str  (StringSubst "_" " " (cdr (assoc 1 eLst)))
                dx73 (cdr (assoc 73 eLst)))

          (setq eLst (RemovePairs eLst '( 0 100 1 73 )))

          (if (entmake (append '( (0 . "ATTDEF") ) eLst (list (cons 70    0)
                                                              (cons 74 dx73)
                                                              (cons 1   str)
                                                              (cons 2   str)
                                                              (cons 3   str))))
            (entdel ent)
          )
        )
      )
      -1
    )
  )
(today)
(command "_BMAKE")
 (princ))                                                                                                               ;_ end of defun txt2att   далее функции
;;; 
;;; ---------------------------------------------------------------------------------------------------------------------------------------------	 
;;;   http://www.afralisp.net/autolisp/tutorials/date-and-time-stamping.php
;;;   (today)
;;;   (time)
;;; ---------------------------------------------------------------------------------------------------------------------------------------------
;;; Small Fish Michael Puckett	
;;; http://www.cadtutor.net/forum/showthread.php?45468-Copy-from-command-line&
;;;   (CurNamePath)
;;;   (SetClipBoardText "" )
;;;   (GetClipBoardText)
;;;   
;;;   
;;;   
;;;   
;;; ---------------------------------------------------------------------------------------------------------------------------------------------	 
(defun TODAY ( / d yr mo day)          ;define the function and declare all variabled local
(vl-load-com)
(setq d (rtos (getvar "CDATE") 2 6)    ;get the date and time and convert to text
          yr (substr d 3 2)            ;extract the year
          mo (substr d 5 2)            ;extract the month
	  day (substr d 7 2)           ;extract the day
)                                      ;setq
     (strcat day "-" mo "-" yr)        ;string 'em together
(SetClipBoardText d)
(princ)
)                                      ;defun
;;; ---------------------------------------------------------------------------------------------------------------------------------------------	 
(defun TIME ( / d hr m s)               ;define the function and declare all variables as local
(vl-load-com)
(setq d (rtos (getvar "CDATE") 2 6)     ;get the date and time and convert to text
hr (substr d 10 2)	                ;extract the hour
m (substr d 12 2)                       ;extract the minute
s (substr d 14 2)                       ;extract the second
)                                       ;setq
(strcat hr ":" m ":" s)                 ;string 'em together
(SetClipBoardText d)
(princ) 
)                                       ;defun
;;; 
;;; ---------------------------------------------------------------------------------------------------------------------------------------------	                                                                                                             
;;; устанавливает в переменную text и БО имя и путь активного чертежа  
;;; ---------------------------------------------------------------------------------------------------------------------------------------------
;_ begin of defun
(defun CurNamePath (/ acadx doc dwg text htmlfile result )
(vl-load-com)
(setq acadx (vlax-get-acad-object) doc (vla-get-activedocument acadx) dwg (vla-get-name doc) path (vla-get-path doc)
);setq
(princ (strcat path "\\"  dwg ))
(setq text (strcat path "\\" dwg ))
(SetClipBoardText text)
(princ "\nThe above line has been copied. You can now ")
(princ "\npaste into an email or any other application." )
(princ)
)                                                                                                             ;_ end of defun
;;; 
;;; ---------------------------------------------------------------------------------------------------------------------------------------------	 
;;; устанавливает в БО переменную text
;;; пример вызова (SetClipBoardText "" )
;;; ---------------------------------------------------------------------------------------------------------------------------------------------
(defun SetClipBoardText ( text / htmlfile result )                                    ;_ begin of defun
(vl-load-com)
;; Caller's sole responsibility is to pass a
;; text string. Anything else? Pie in face.
(setq result
(vlax-invoke
(vlax-get
(vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow)
'ClipBoardData
)
'SetData "Text" text)
)
(vlax-release-object htmlfile)
text
)                                                                                                             ;_ end of defun
;;; ---------------------------------------------------------------------------------------------------------------------------------------------	                                                                                                             
;;; получает из КС и устанавливает в переменную text 
;;; ---------------------------------------------------------------------------------------------------------------------------------------------
(defun GetClipBoardText( / htmlfile result )                                            ;_ begin of defun
(vl-load-com)
(setq result
(vlax-invoke
(vlax-get
(vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow)
'ClipBoardData
)
'GetData "Text")
)
(vlax-release-object htmlfile)
result
)                                                                                                               ;_ end of defun

дубль

[Michael!]

Привет, братцы!
Вопрос по функции ssget.
Выбираю я значит некоторое количество примитивов с помощью рамки и присваиваю этот набор переменной. В набор входят линии, арки, окружности, текст, размеры. Но, из всего этого набора мне нужны только линии, арки и окружности. Значит надо исключить ненужные примитивы из набора.
Но что-то тут с именами примитивов не понятно мне - как их выцепить из набора? получается что-то вида <Entity name: 7dc84328>, а для ssdel наверное всетаки нужно только 7dc84328.
Или есть какой более простой способ?
Спасибо.
(программка приложена)

Код:

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

 

(setq ss (ssget))

(setq quent (sslength ss))
(print "quent")
(setq i 0)
	(while (< i quent)
		
		(if (= "LINE" (cdr (assoc 0 (setq elist (entget (ssname ss i))))))
			(progn
			(print (ssname ss i))
			(print i)
			); progn

				(progn
				(setq nmp (ssname ss i))
				(print nmp)
				(print i)
				(ssdel nmp ss)
				);progn
		); end if
(setq i (+ 1 i))
	); end while

[Дима_]

Сообщение от Michael! Но, из всего этого набора мне нужны только линии, арки и окружности... Или есть какой более простой способ?

Код:

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

 (ssget '((-4 . "<OR") (0 . "LINE") (0 . "ARC") (0 . "CIRCLE") (-4 . "OR>")))

[gomer]

Код:

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

 (ssget '((0 . "LINE,ARC,CIRCLE")))

[Michael!]

Да, это я пробовал, но видимо в синтаксисе что-то напутал и он выбирал все линии, арки и окружности во всем файле.

Круто! Спасибо! все решается оказывается так.

[Jerald]

С чем может быть связано вот такое ругательство:
; error: extra cdrs in dotted pair on input

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

Сообщение от Jerald С чем может быть связано вот такое ругательство: ; error: extra cdrs in dotted pair on input

С неверным кодом, например.

[Do$]

Сообщение от Jerald С чем может быть связано вот такое ругательство: ; error: extra cdrs in dotted pair on input

Учитесь пользоваться инструментами отладки, определяющие место в коде, в котором возникла ошибка и прерывающие выполнение программы при возникновении ошибки. Возникла ошибка - программа прервалась - просим показать где и проверяем все входящие параметры функции. Вопросы подобного плана отпадут сами собой.

[Jerald]

Инструменты отладки не помогли, вот код: (код не мой, я просто пытаюсь запустить код из примера)

Код:

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

  (defun rcl ( / )

; Начальные значения списков радиусов (list rad) и центров (list cen) (setq list_rad '() list_cen '())

; Создание набора из кругов на слое HOLES

(setq nab_cir (ssget "_X" (list (cons 8 "HOLES") (cons 0 "CIRCLE"))))

; Проверка, сформировался ли набор nab cir

; (если нет, то предыдущая операция вернет nil)

(if (null nab_cir)

(progn

(princ "\пНет кругов на слое HOLES. "); сообщение об отсутствии

(princ); тихий выход

); конец progn

(progn

(setq i -1 nab_len (sslength nab_cir))

; Цикл по количеству элементов набора nab_cir

(repeat nab len

(setq i (1+ i))

; Выбор следующего примитива и получение его списка

(setq cirlist (entget (ssname nab_cir i)))

(setq radcir (cdr (assoc 40 cirlist))) .

(setq cencir (cdr (assoc 10 cirlist)))

; Добавление радиуса и точки центра к спискам list rad и list cen

(setq list rad (append list rad (list radcir)))

(setq list_cen (append list_cen (list cencir)))

); конец repeat

; Печать результирующих списков

(princ "\nРадиусы: ")

(princ list_rad)

(princ "\nЦентры: ")

(princ list cen)

); конец progn

) ; конец if

) ; конец defun 

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

Точки просто так ставить не надо Да и копирование кода выполнять внимательнее...

Код:

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

(defun rcl (/)

          ; Начальные значения списков радиусов (list rad) и центров (list cen) (setq list_rad '() list_cen '())

          ; Создание набора из кругов на слое HOLES

  (setq nab_cir (ssget "_X" (list (cons 8 "HOLES") (cons 0 "CIRCLE"))))

          ; Проверка, сформировался ли набор nab cir

          ; (если нет, то предыдущая операция вернет nil)

  (if (null nab_cir)

    (progn

      (princ "\пНет кругов на слое HOLES. ") ; сообщение об отсутствии

      (princ) ; тихий выход

      )   ; конец progn

    (progn

      (setq i       -1
            nab_len (sslength nab_cir)
            ) ;_ end of setq

          ; Цикл по количеству элементов набора nab_cir

      (repeat nab
        len

        (setq i (1+ i))

          ; Выбор следующего примитива и получение его списка

        (setq cirlist (entget (ssname nab_cir i)))

        (setq radcir (cdr (assoc 40 cirlist)))

        (setq cencir (cdr (assoc 10 cirlist)))

          ; Добавление радиуса и точки центра к спискам list rad и list cen

        (setq list_rad
               (append list_rad (list radcir))
              ) ;_ end of setq

        (setq list_cen (append list_cen (list cencir)))

        ) ; конец repeat

          ; Печать результирующих списков

      (princ "\nРадиусы: ")

      (princ list_rad)

      (princ "\nЦентры: ")

      (princ list cen)

      )   ; конец progn

    )     ; конец if

  )       ; конец defun

[Do$]

Сообщение от Jerald Инструменты отладки не помогли

Ну да, забыл сказать, к ним еще голова нужна

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

Do$, ну да, каюсь, я бы писал код по-другому:

Код:

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

 (defun rcl (/ ss lst)

  (if (setq ss (ssget "_X" '((0 . "CIRCLE") (8 . "HOLES"))))
    (mapcar
      (function
        (lambda (check)
          (princ (strcat "\n" (car check) ":\n"))
          (mapcar
            (function
              (lambda (ent)
                (princ (strcat "\n"
                               (if (listp (cdr (assoc (cdr check) (entget ent))))
                                 (strcat "("
                                         (vl-string-trim " "
                                             (apply (function strcat)            (mapcar
                                                           (function
                                                             (lambda (x)
                                                               (strcat " " (rtos x 2 4))
                                                               ) ;_ end of lambda
                                                             ) ;_ end of function
                                                           (cdr (assoc (cdr check) (entget ent)))
                                                           )) ;_ end of mapcar
                                                         ) ;_ end of vl-string-trim
                                         ")"
                                         ) ;_ end of strcat
                                 (rtos (cdr (assoc (cdr check) (entget ent))) 2 4)
                                 ) ;_ end of if
                               ) ;_ end of strcat
                       ) ;_ end of princ
                ) ;_ end of lambda
              ) ;_ end of function
            ((lambda (/ tab item)
               (repeat (setq tab  nil
                             item (sslength ss)
                             ) ;_ end setq
                 (setq tab (cons (ssname ss (setq item (1- item))) tab))
                 ) ;_ end of repeat
               ) ;_ end of lambda
             )
            ) ;_ end of mapcar
          ) ;_ end of lambda
        ) ;_ end of function
      '(("Centers" . 10) ("Radius" . 40))
      ) ;_ end of mapcar
    ) ;_ end of if
  ) ;_ end of defun

---
Добавлено: подходим к рубежу в 2000 сообщений... Тему разделять будем?

[gomer]

на самом деле программа должна была бы выглядеть так:

Код:

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

 (defun c:rcl (/ nab_cir i cirlist list_rad list_cen)

  (if (setq
	dxf	(lambda (x y) (cdr (assoc x y)))
	nab_cir	(ssget "_X" (list (cons 8 "HOLES") (cons 0 "CIRCLE")))
      )

    (progn
      (repeat (sslength nab_cir)

	(setq i	(if i
		  (1+ i)
		  0
		)
	)

	(setq

	  ;; Добавление радиуса и точки центра к спискам list_rad и list_cen
	  list_rad (append
		     list_rad
		     (list (dxf
			     40
			     (setq cirlist (entget (ssname nab_cir i)))
			   )

		     )
		   )
	  list_cen (append list_cen (list (dxf 10 cirlist)))
	)
      )

      ;; Печать результирующих списков

      (princ "\nРадиусы: ")

      (princ list_rad)

      (princ "\nЦентры: ")

      (princ list_cen)

    )
    (princ "\пНет кругов на слое HOLES. ")
  )
  (princ)
)

теперь о причине ошибки, это конечно же намусоренная точка! Там их еще (ошибок) есть немало, но меня больше печалит:

; ошибка: излишние cdrs в точесной паре на входе

в руськой версии

[Jerald]

Сообщение от Do$ Ну да, забыл сказать, к ним еще голова нужна

"Китайская комната" не подойтёт

на самом деле программа должна была бы выглядеть так:

Почти нигде не смог найти вхождений dxf в сам код программы. Хоть, помнится, как ми то способом извлекал ранее dxf-данные примитивов.

[Nike]

Товарищи программисты!
Помогите если можно одну маленькую дурацкую идею запрограммировать
Хочу на кнопку F2 повесить умный лисп, который в случае если выполняется какая-то команда, например _move или _line при нажатии на F2 вставлял бы мне прозрачную указиловку, например _m2p (середина между точками) или _from (от), а при других случаях выполнял бы непосредственную функцию F2 - вывод текстового окна (_textscr).
Такое извращение возможно?

[tivun]

Здравствуйте! Помогите, пожалуйста, написать программу на автолиспе.

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

tivun, во-первых, картинки отлично присоединяются к посту. Во-вторых, с такой постановкой вопроса тебе прямая дорога в "Поиск исполнителей".