[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

_____________________________________________________________________________________________________________

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

[1958]

На https://forums.autodesk.com/t5/visua...r/td-p/9626606 нашел код для определения s/n флэшки:

Код:

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

  (defun UsbDriveSerialNumber (/ fso dr)
  (setq fso (vlax-create-object "Scripting.FileSystemObject"))
  (vlax-for d (vlax-get fso 'Drives)
   (if (= (Vlax-get d 'DriveType) 1)
    (setq dr (cons (list (vla-get-path d) (vla-get-SerialNumber d)) dr))
   )
  )
  (vlax-release-object fso)
  (reverse dr)
 )
 (if (vl-some '(lambda (i) (eq -1754099887 (cadr i)))
              (UsbDriveSerialNumber)
     )
(действие1)
(действие2)
)

В этом коде сравнивается серийный номер флэшки с известным (-1754099887).
Допустим есть список (setq lst (list -1754099887 175646485 927914207)), в котором перечислены серийные номера нескольких флэшек.
Как определить, что флэшка (её серийный номер) попадает в этот список?
Попытался сделать так:

Код:

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

  (if (vl-some '(lambda (i)
                (eq (member (cadr i)
                            (UsbDriveSerialNumber)
                            lst
                    )
                )
               )
     )

Результат: Error: слишком мало аргументов
Что-то я с member напутал.

[name02]

Просто:
(member НОМЕР_ФЛЕШКИ СПИСОК_НОМЕРОВ_ФЛЕШЕК)

Возвращает nil если не найдет и остаток списка начиная с НОМЕР_ФЛЕШКИ

[1958]

Сообщение от name02 Просто: (member НОМЕР_ФЛЕШКИ СПИСОК_НОМЕРОВ_ФЛЕШЕК)

Номер флешки неизвестен и ваше ПРОСТО не вариант.

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

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

[name02]

Сообщение от 1958 Как определить, что флэшка (её серийный номер) попадает в этот список?

Функция member - самый простой способ определить вхождения одной величины в список.

Сообщение от 1958 Номер флешки неизвестен и ваше ПРОСТО не вариант.

Никому не известную величину в списке невозможно найти. Вообще никак

Тем не менее, тема форума "Научите лиспу..."

1 Функция UsbDriveSerialNumber возвращает nil если в компьютер не воткнуто флешек, а если воткнуты - то список вида:
(("D:" 1924838121)("H:" 191335465456)("F:" 456798431))
Количество элементов списка зависит от количества воткнутых в компьютер флешек

2 Берешь нужные флешки, втыкаешь в компьютер и запускаешь (UsbDriveSerialNumber)
3 Смотришь на номера и записываешь их в блокнот
4 Пишешь что-то вроде такого:

Код:

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

 ;;Функция для определения валидности флешки
;;возвращает nil - если валидная флешка не найдена
;;T - если найдена
(defun original-flashp (/ UsbDriveSerialNumber flnums valid-flash)

  ;;Список номеров разрешенных флешек
  (setq flnums '(321321356 564684543 456579833 1924838121))

  (defun UsbDriveSerialNumber (/ fso dr)
    (setq fso (vlax-create-object "Scripting.FileSystemObject"))
    (vlax-for d	(vlax-get fso 'Drives)
      (if (= (Vlax-get d 'DriveType) 1)
	(setq dr (cons (list (vla-get-path d) (vla-get-SerialNumber d)) dr))
      ) ;_ end of if
    ) ;_ end of vlax-for
    (vlax-release-object fso)
    (reverse dr)
  ) ;_ end of defun

  ;;вот тут проверяем 
  (foreach fl (UsbDriveSerialNumber)
    (if	(member (cadr fl) flnums)
      (setq valid-flash T)
    ) ;_ end of if
  ) ;_ end of foreach

  valid-flash

) ;_ end of setq

[1958]

Спасибо!
Пункты 1-3 мне были понятны и вопросов не возникало:

Сообщение от name02 1 Функция UsbDriveSerialNumber возвращает nil если в компьютер не воткнуто флешек, а если воткнуты - то список вида: (("D:" 1924838121)("H:" 191335465456)("F:" 456798431)) Количество элементов списка зависит от количества воткнутых в компьютер флешек 2 Берешь нужные флешки, втыкаешь в компьютер и запускаешь (UsbDriveSerialNumber) 3 Смотришь на номера и записываешь их в блокнот

Загвоздка была в:

Сообщение от name02 4 Пишешь что-то вроде такого: Код:

а именно:

Код:

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

 ;;вот тут проверяем 
  (foreach fl (UsbDriveSerialNumber)
    (if	(member (cadr fl) flnums)
      (setq valid-flash T)
    ) ;_ end of if
  ) ;_ end of foreach

Спасибо ещё раз, теперь всё яхши!

[===AAA===]

Защиту по номеру вставленной в данный момент флешки (чтобы работало только "для своих") ваяешь?

[1958]

Сообщение от ===AAA=== Защиту по номеру вставленной в данный момент флешки (чтобы работало только "для своих") ваяешь?

Типа этого. Знаю, что ненадежно. Но просто от дураков.

[Ingpro]

Код "не узнает" MLeader, подскажите, что не так...

Код:

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

 ;; добавить текст в конце нескольких выбранных MLEADER
(defun c:AddTxtML ( / ss textToAdd i ent entData newText)
  (setq textToAdd (getstring "\nВведите текст для добавления: "))
  (setq ss (ssget '((0 . "MLEADER"))))

  (if (null ss) 
    (progn
      (princ "\nНе выбрано ни одной MLeader.")
      (exit)
    )
  )

  (repeat (setq i (sslength ss))
    (setq ent (ssname ss (setq i (1- i))))
    
    (setq entData (entget ent))

    (if (equal (cdr (assoc 0 entData)) "MLEADER")
      (progn
               (setq oldText (cdr (assoc 1 entData)))  

        (setq newText (strcat oldText " " textToAdd)) 

             (setq entData (subst (cons 1 newText) (assoc 1 entData) entData))
        (entmod entData)  
      )
    )
  )
  (princ)
)

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

А провернуть entget не судьба? )

Код:

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

 (cdr(assoc 0 (entget (car (entsel)))))
"MULTILEADER"

[name02]

Еще у тебя в 4 строке выбираются только мультивыноски и проверка 18 избыточна

[Ingpro]

Сообщение от Кулик Алексей aka kpblc А провернуть entget не судьба? )

Изменяю строку 18, но не получается

Сообщение от name02 Еще у тебя в 4 строке выбираются только мультивыноски и проверка 18 избыточна

В 4 строке выбираютя, а в 18 проверяются, убрать проверку?

[name02]

Если ты используешь в ssget фильтры, то в наборе будут только объекты удовлетворяющие фильтру - других не будет. Это даже видно при выделении объектов
И присоединяюсь к

Сообщение от Кулик Алексей aka kpblc А провернуть entget не судьба? )

Текст мультивыноски не в 1-й группе находится

И лучше все-таки не (exit) использовать

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

Да вашу ж за ногу! Разницу между MLEADER и MULTILEADER вообще видно или нет? 18 строка не нужна, у тебя проблема в фильтре ssget! Там кто править будет - Пушкин?

[Red Nova]

Доброго!

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

Скрипт прекрасно работает, если ссылаться только на одно из этих полей — либо атрибут, либо длину.
Однако, если попытаться объединить оба поля в один текст, мультивыноска создается, но остаётся пустой.

Ниже приведены три команды. Они идентичны, за исключением одной закомментированной строки в test1 и test2.
test1 и test2 работают корректно.
test3 рисует мультивыноску, но текст в ней отсутствует.

Я прилагаю файл .dwg, в котором показан результат выполнения каждой из команд.
Надеюсь, кто-нибудь сможет объяснить вечному чайнику, почему test3 не работает

Код:

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

 (defun c:test1 ( / blk vlablk attlst tagtext)

  (vl-load-com)
  
  (prompt "\nSelect Tagged Block: ")
  (setvar "nomutt" 1)
  (if
      (setq blk (ssget "_:S" '((0 . "INSERT")(66 . 1))))
      (setq vlablk (LM:ss->vla blk))
      )
  (setvar "nomutt" 0)
  (setq vlablk (car vlablk))
  (setq attlst (get-all-atts vlablk))

  (setq tagtext
	 (strcat
   	   ;(strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 (caddr (assoc "TYPE" attlst))))">%).TextString>%")
	   ", L="
	   (strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 vlablk)) ">%).Parameter(123).UpdatedDistance \\f \"%lu4%pr3\">%")
	   )
	)
  (command "._mleader" pause pause tagtext)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:test2 ( / blk vlablk attlst tagtext)

  (vl-load-com)
  
  (prompt "\nSelect Tagged Block: ")
  (setvar "nomutt" 1)
  (if
      (setq blk (ssget "_:S" '((0 . "INSERT")(66 . 1))))
      (setq vlablk (LM:ss->vla blk))
      )
  (setvar "nomutt" 0)
  (setq vlablk (car vlablk))
  (setq attlst (get-all-atts vlablk))

  (setq tagtext
	 (strcat
   	   (strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 (caddr (assoc "TYPE" attlst))))">%).TextString>%")
	   ", L="
	   ;(strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 vlablk)) ">%).Parameter(123).UpdatedDistance \\f \"%lu4%pr3\">%")
	   )
	)
  (command "._mleader" pause pause tagtext)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:test3 ( / blk vlablk attlst tagtext)

  (vl-load-com)
  
  (prompt "\nSelect Tagged Block: ")
  (setvar "nomutt" 1)
  (if
      (setq blk (ssget "_:S" '((0 . "INSERT")(66 . 1))))
      (setq vlablk (LM:ss->vla blk))
      )
  (setvar "nomutt" 0)
  (setq vlablk (car vlablk))
  (setq attlst (get-all-atts vlablk))

  (setq tagtext
	 (strcat
   	   (strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 (caddr (assoc "TYPE" attlst))))">%).TextString>%")
	   ", L="
	   (strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 vlablk)) ">%).Parameter(123).UpdatedDistance \\f \"%lu4%pr3\">%")
	   )
	)
  (command "._mleader" pause pause tagtext)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun LM:ss->vla ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
        )
    )
)

(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
)

(defun get-all-atts (obj)
  (if (and obj
    (eq :vlax-true (vla-get-HasAttributes obj))
    (vlax-property-available-p obj 'Hasattributes)
    
      )
    (vl-catch-all-apply
      (function
 (lambda ()
   (mapcar (function (lambda (x)
         (list (vla-get-TagString x)
	       (bg:get-TextString (vlax-vla-object->ename x))
                                    x
         )
       )
    )
    (append (vlax-invoke obj 'Getattributes)
     (vlax-invoke obj 'Getconstantattributes)
    )
   )
 )
      )
    )
  )
)

[name02]

1 Ты не приложил функции (get-all-atts) и (Get-ObjectID-x86-x64)
2 Я нашел их в интернете, но test2 не запускается. Возможно ты не последний вариант программы выложил.
Насколько можно судить (get-all-atts) возвращает список из точечных пар (ИМЯ_АТРИБУТА . ЗНАЧЕНИЕ)
В строке 43 ты пытаешься скормить ей вот это (caddr (assoc "TYPE" attlst)) - результат caddr указанной точечной пары не существует - будет ошибка. Даже больше - для такой пары есть только car и cdr
3 Функция (Get-ObjectID-x86-x64) принимает в качестве аргумента только указатель на объект - ENAME или VLA-OBJECT
Тебе нужно получить объект АТРИБУТ и уже его передавать в (Get-ObjectID-x86-x64)

[koMon]

Red Nova,
можно попробовать вставить текст с полями в уже созданную мвыноску, например так

Код:

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

 
(defun c:test3 ( / blk vlablk attlst tagtext)
  (prompt "\nSelect Tagged Block: ")
  (setvar "nomutt" 1)
  (if
      (setq blk (ssget "_:S" '((0 . "INSERT")(66 . 1))))
      (setq vlablk (LM:ss->vla blk))
  )
  (setvar "nomutt" 0)
  (setq vlablk (car vlablk))
  (setq attlst (mapcar '(lambda (att) (list (vla-get-tagstring att) att)) (vlax-invoke vlablk 'getattributes)))
  (setq tagtext
	  	(strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-Get-ObjectID (cadr (assoc "TYPE" attlst)))) ">%).TextString>%"
	   			",L=" "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-Get-ObjectID vlablk)) ">%).Parameter(123).UpdatedDistance \\f \"%lu4%pr3\">%"
		)
  )
  (command "._mleader" pause pause "")
  (vla-put-textstring (vlax-ename->vla-object (entlast)) tagtext)
  (command "_regen")
)

[Red Nova]

Спасибо за ответы!
name02

1 Ты не приложил функции (get-all-atts) и (Get-ObjectID-x86-x64) 2 Я нашел их в интернете, но test2 не запускается. Возможно ты не последний вариант программы выложил. Насколько можно судить (get-all-atts) возвращает список из точечных пар (ИМЯ_АТРИБУТА . ЗНАЧЕНИЕ) В строке 43 ты пытаешься скормить ей вот это (caddr (assoc "TYPE" attlst)) - результат caddr указанной точечной пары не существует - будет ошибка. Даже больше - для такой пары есть только car и cdr 3 Функция (Get-ObjectID-x86-x64) принимает в качестве аргумента только указатель на объект - ENAME или VLA-OBJECT Тебе нужно получить объект АТРИБУТ и уже его передавать в (Get-ObjectID-x86-x64)

Извиняюсь. Добавил недостающие функции.

koMon
Работает! Но требует regen, а для большого файла это тормозить будет. Хотелось бы без regen

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

Можешь попробовать (entupd (entlast))

[Red Nova]

Сообщение от Кулик Алексей aka kpblc Можешь попробовать (entupd (entlast))

Не работает
Также как и не работает (command ".updatefield" (entlast) "")