[alexdub]

Добрый день! задача следующая: файле (автокад) есть около 5 тыс. точек. у каждой свое значение координаты Z. нужна команда, которая будет при нажатии на точку вставлять рядом текст с этой координатой. сами понимаете, что смотреть координату в свойствах (или через inquiry), а потом печатать текстом слишком уж долго
посоветуйте, пожалуйста, литературу по написанию макросов (в детстве хорошо дружил с информатикой , думаю разберусь) а может у кого-то была похожая задача и подскажете советом, спасибо!

[hwd]

Сообщение от alexdub Добрый день! задача следующая: файле (автокад) есть около 5 тыс. точек. у каждой свое значение координаты Z. нужна команда, которая будет при нажатии на точку вставлять рядом текст с этой координатой. сами понимаете, что смотреть координату в свойствах (или через inquiry), а потом печатать текстом слишком уж долго посоветуйте, пожалуйста, литературу по написанию макросов (в детстве хорошо дружил с информатикой , думаю разберусь) а может у кого-то была похожая задача и подскажете советом, спасибо!

Offtop: А сидеть, и как дятел 5 тыс. раз судорожно кликать мышью - это быстро?

[Дима_]

пример файла с небольшим кол-вом точек приложил-бы - глядишь и код появится

[AlexV]

Код:

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

option Explicit
Public Const tpv = "" ' 
Public Const heighttxt = 100
Sub main()
Dim pnt As Object
Dim acSelSet As AcadSelectionSet
Dim textObj As AcadText
Dim textString As String
Dim insertionPoint
Dim height As Double
height = heighttxt
Set acSelSet = SelectOnlyOnScreen(tpv)
If acSelSet.Count = 0 Then Exit Sub
For Each pnt In acSelSet
 insertionPoint = pnt.Coordinates
 textString = insertionPoint(2)
 Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
Next
End Sub
Private Function SelectOnlyOnScreen(str) As AcadSelectionSet
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim intType(0) As Integer
Dim varData(0) As Variant
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
 If objSelSet.Name = "Blck" Then
  objSelSet.Delete
  Exit For
 End If
Next
Set objSelSet = ThisDrawing.SelectionSets.Add("Blck")
intType(0) = 0
varData(0) = "Point"
If str = "выбрать объекты" Then
  objSelSet.SelectOnScreen intType, varData
Else
  objSelSet.Select acSelectionSetAll, , , intType, varData
End If
Set SelectOnlyOnScreen = objSelSet
End Function

[alexdub]

Сообщение от hwd Offtop: А сидеть, и как дятел 5 тыс. раз судорожно кликать мышью - это быстро?

это в 3 раза быстрее

Сообщение от Дима_ пример файла с небольшим кол-вом точек приложил-бы - глядишь и код появится

сейчас выложу)

Сообщение от AlexV Код:

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

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

[AlexV]

Сообщение от alexdub это в 3 раза быстрее сейчас выложу) будешь в москве, я тебе пива куплю но для начала мне нужно чтото почитать, где будет написано как создать макрос и куда этот код вставить)) я правильно понял, он ставит координаты для выделенного массива точек?

Понял правильно.. Для всех точек в чертеже. Если надо по выбору рамкой, то замени Public Const tpv = "" на Public Const tpv = "выбрать объекты".
"Public Const heighttxt = 100" - це высота текста. Alt + F8 > диспетчер VBA > новый > Редактор VBA > вставить модуль. В модуль вставить код, сохранить как проект VBA. Подгрузить в акад (сервис - загрузка приложений или макросы > диспетчер VBA > загрузить, ну и запустить...

[Victor]

Могет быть в блоки

Код:

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

(defun c:test(/)
(setvar "attreq" 1)
(setvar "attdia" 0)
(setq sset (ssget "_:L" '(( 0 . "POINT"))))
(setq i 0)
(while(setq dot (ssname sset i))
(setq dot_krd (cdr(assoc 10 (entget dot))))
(setq dot_z (rtos(last dot_krd) 2 2))   
(command "_.insert" "dt" dot_krd 50.0 50.0 0.0 dot_z)
(setq i (+ 1 i))
)
)

[alexdub]

Сообщение от AlexV Понял правильно.. Для всех точек в чертеже. Если надо по выбору рамкой, то замени Public Const tpv = "" на Public Const tpv = "выбрать объекты". "Public Const heighttxt = 100" - це высота текста. Alt + F8 > диспетчер VBA > новый > Редактор VBA > вставить модуль. В модуль вставить код, сохранить как проект VBA. Подгрузить в акад (сервис - загрузка приложений или макросы > диспетчер VBA > загрузить, ну и запустить...

все получилось! огромное спасибо!
вопрос следующий: как сделать, чтобы он выводил только целые значения?

[Дима_]

Сообщение от alexdub все получилось! огромное спасибо! вопрос следующий: как сделать, чтобы он выводил только целые значения?

Дружище ты б написал все сразу, да 2 примера выложил (до и после), этож уже не первый раз - потом начнется, а можно чтоб еще и блоки, да на слой ХХХ и т.д.

[alexdub]

мне только целые числа и все.
координату Y выводит целомй, а X и Z c 11-ю знаками после запятой.

Дружище ты б написал все сразу, да 2 примера выложил (до и после), этож уже не первый раз - потом начнется, а можно чтоб еще и блоки, да на слой ХХХ и т.д.

согласен, не прав... впредь буду аккуратней! сейчас посмотрел, действительно не все... нужно чтоб он еще в случае положительной координаты писал "+"
в общем сейчас докину пример "до" и "после".

[Дима_]

Если тебе лень нарисовать - то мне лень понимать - что тебе нужно только z или x,y,z? где их рисовать (на высоте точки или "в нуле"), чтобы написать программу надо прежде всего понять что нужно, то что нужно для написании программы ты не знаешь (иначеб смог сам написать) - поэтому и говорят - ВЫЛОЖИ ПРИМЕР.

[alexdub]

вот, выложил. считаем, что слой "отклонения" для вставки координат Z и стиль текста "Standart" уже есть в файле. текст должен стоять "в нуле". расположение текста как в примере, чуть выше точки, середина - чуть левее точки. если значение координаты положительное, то писать "+", если 0, то писать "+0".
с X и Y я просто экспериментировал.
еще пытался всунуть: Round(expression [,numdecimalplaces]). Но видимо не туда))

вроде бы все

[Дима_]

Сохрани файл с расширенем .lsp "затащи" его в окно автокада и набери команду TEST

Код:

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

(vl-load-com)
(defun c:test()
  ((lambda (ss)
     (if ss (progn
             (vla-startundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
             (mapcar '(lambda (ent)
                        ((lambda (pt)
                           (entmakex (list
                                      (cons 0 "text")
                                      (cons 10 ((lambda (pt) (list (- (car pt) 200 ) (+ 50 (cadr pt)))) pt))
                                      (cons 8 "Отклонения")
                                      (cons 40 300)
                                      (cons 1 ((lambda (z) (strcat (if (> z -1) "+" "")(itoa z) )) (fix (last pt)))))))
                         (cdr (assoc 10 (entget ent)))))
                     (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
             (vla-endundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument)))))
   (ssget (list (cons 0 "point"))))
  (princ))

p.s. - жирным высота шрифта, курсивом - название слоя.

[alexdub]

отлично работает! но округляет в меньшую сторону)) но это не страшно. это я уж как-нибудь сам качаю Хювёнена, почитаю на досуге.
Дима, AlexV, Victor СПАСИБО!

[Pastor]

Не надо Хювёнена!
Найди Полещук Н., Лоскутов П.. AutoLISP и VisualLISP в среде AutoCAD. Этого более чем достаточно.

[Олег (jr.)]

Сообщение от Дима_ Сохрани файл с расширенем .lsp "затащи" его в окно автокада и набери команду TEST Код: [Выделить все] (vl-load-com) (defun c:test() ((lambda (ss) (if ss (progn (vla-startundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument)) (mapcar '(lambda (ent) ((lambda (pt) (entmakex (list (cons 0 "text") (cons 10 ((lambda (pt) (list (- (car pt) 200 ) (+ 50 (cadr pt)))) pt)) (cons 8 "Отклонения") (cons 40 300) (cons 1 ((lambda (z) (strcat (if (> z -1) "+" "")(itoa z) )) (fix (last pt))))))) (cdr (assoc 10 (entget ent))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (vla-endundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))))) (ssget (list (cons 0 "point")))) (princ)) p.s. - жирным высота шрифта, курсивом - название слоя.

Излишнее здесь:

(defun C:test ()

достаточно начать со строки

((lambda (ss)

для автовыполнения как анонимной функции

ИМО

[Дима_]

Сообщение от Олег (jr.) Излишнее здесь: (defun C:test () достаточно начать со строки ((lambda (ss) для автовыполнения как анонимной функции

Чего?? А вызывать ты ее тоже анонимно будешь?

[alexdub]

Сообщение от Pastor Найди Полещук Н., Лоскутов П.. AutoLISP и VisualLISP в среде AutoCAD. Этого более чем достаточно.

возьму на заметку

[Pastor]

Код из поста №13 в переводе с лямбда на русский. Теперь вместе с Полещуком и Лоскутовым реально разобраться.

Код:

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

(defun c:test( / ss)
  (setq ss (ssget (list (cons 0 "point"))))
  (if ss
    (progn
    (vla-startundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
    (mapcar
      '(lambda (ent / pt z)
         (setq pt (cdr (assoc 10 (entget ent))) z (fix (last pt)))
         (entmakex
           (list
             (cons 0 "text")
             (cons 10 (list (- (car pt) 200 ) (+ 50 (cadr pt))))
             (cons 8 "Отклонения")
             (cons 40 300)
             (cons 1 (strcat (if (> z -1) "+" "")(itoa z)))
           )
         ); /entmakex.
      ); /lambda.
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    ); /mapcar.
    (vla-endundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
    ); /progn.
  ); /if.
  (princ)
); /defun.

[Дима_]

То Пастор - если Вы привыкли писать на vb, например, то это не значит, что на лиспе надо писать так-же - lambda четко выражает область определения аргумента - НЕ ДОЛЖНО БЫТЬ В ЛИСПЕ ПЕРЕМЕННЫХ - там аргументы с четко заданной областью видимости, сделано это для программ чуть побольше чем Ваша (в С++ это-же (с оговорками) называеться объектами), не учите "неправильному" если сами "плаваете". Выход функции должен определяться строго ТОЛЬКО входными данными. Чем быстрее Вы это поймете тем яснее для Вас станет лисп.
p.s. gодумаете на досуге что происходит со списочной структурой когда Вы вызываете setq, да еще и в цикле - это из разряда список как массив использовать.