CAD БИБЛИОТЕКА
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Ответ
Поиск в этой теме
Непрочитано 20.07.2008, 20:12
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)
Red Nova
 
ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Торонто
Регистрация: 23.10.2007
Сообщений: 1,977

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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
_____________________________________________________________________________________________________________

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

Последний раз редактировалось Red Nova, 12.07.2017 в 05:43.
Просмотров: 1669402
 
Непрочитано 23.09.2020, 22:34
#3921
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 8,842


gnuvse, неправильная постановка вопроса - вам для обучения надо искать подробно документированный хороший код, поскольку самостоятельно перелопачивать кучу информацию вы, похоже, особо не горите желанием...
Сергей812 вне форума  
 
Непрочитано 24.09.2020, 08:39
#3922
DMSskop


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


Доброе утро. Есть лисп https://forum.dwg.ru/showpost.php?p=...&postcount=207 нумерует аргументы по зависимостям настроек динамических блоков. Есть аналоги? Или помогите модифицировать для возможности ввода имени атрибута, а то он вшит в лист и приходится копии лиспа делать с разными значениями настроек. Менять название атрибутов в блоках не вариант
DMSskop вне форума  
 
Непрочитано 24.09.2020, 09:23
1 | #3923
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 8,842


Цитата:
Сообщение от DMSskop Посмотреть сообщение
а то он вшит в лист и приходится копии лиспа делать с разными значениями настроек
Введите переменную вместо вшитого значения и задавайте ее значение через GetString. Тем более в коде даже вижу закомментированный кусок нужного кода)
Сергей812 вне форума  
 
Непрочитано 24.09.2020, 09:55
#3924
DMSskop


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


Во заработало спасибо

Код:
[Выделить все]
 ;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #207, #163
;;; Натройки программы проихводятся парой строчек ниже СМ
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq attTo "POS") ;_Имя аттрибута куда вбивать

(defun c:NDB (/       adoc    ss      name    bname   lst     lstLen
              poz     attTo   *error* dynProp1        dynProp2
              dp1     dp2     i dimz
             )
;;; Маркировка динамических блоков
;;; Тема Сквозная нумерация динамических блоков
;;; URL http://forum.dwg.ru/showthread.php?t=13666&page=9
;;; Post #163
  
;;;================================================
;;;======== НАСТРОЙКИ ПРОГРАММЫ ===================
;;;================================================
  (princ "\nNDB - Маркировка динамических блоков. сборка от 2011-12-08")
  (vl-load-com)
;;;  (setq bname "*") ;_Имя блока 
;;;  (setq dynProp1 "Высота(H) кассеты") ;_Имя динамического свойства1
;;;  (setq dynProp2 "Ширина(B) кассеты") ;_Имя динамического свойства1
;;;  (setq bname ( GETSTRING T "\nИмя блока:" ))===Сделай пожалуйста, если не трудно, для набора ЛК несколько разных блоков===
  (setq bname
       ((lambda( / obj name flg str)
          (while (not flg)
            (initget "Имя Удалить")
            (if name
              (setq str (VL-PRINC-TO-STRING name))
              ;;;(setq str (strcat (car name)(apply 'strcat (mapcar '(lambda(x)(strcat "," x))(cdr name)))))
              (setq str "")
              )
            (setq obj (entsel(strcat "\n" str " Выберите блок [Имя/Удалить]<готово>: ")))
            (cond ((and obj (eq obj "Имя"))(setq name (cons (getstring T "\nИмя блока: " ) name)))
                  ((and obj (eq obj "Удалить"))(if (null name)(princ " ** Все удалено **")(setq name (cdr name))))
                  ((and obj (eq (cdr(assoc 0 (entget(setq obj(car obj))))) "INSERT"))
                   (if (not(member(vla-get-EffectiveName(setq obj(vlax-ename->vla-object obj))) name))
                     (setq name (cons (vla-get-EffectiveName obj) name))
                     )
                   )
                  ((and (null obj)(= (getvar "ERRNO") 52))(setq flg t))
                  (t (princ " ** Неверно ** "))
                  )
            )
         (apply 'strcat(mapcar '(lambda(x)(strcat x ",")) name))
          )
         )
      )
  (setq dynProp1 ( GETSTRING T "\nИмя динамического свойства 1:"))
  (setq dynProp2 ( GETSTRING T "\nИмя динамического свойства 2:"))
  (setq attTo ( GETSTRING T "\nИмя Атрибута:"));_Имя аттрибута куда вбивать
  (or (numberp *STARTPOZ*)(setq *STARTPOZ* 1)) ;;; Стартовая нумерация
  
;;; ===================== LOCAL FUNCTION ==========================================
(defun *error* (msg) (princ msg)(setvar "DIMZIN" dimz)(vla-endundomark adoc))
(defun RemoveDuplicateStrings (stringlist / newlist)
  (foreach var stringlist 
    (if (not (vl-position var newlist))
      (setq newlist (cons var newlist))
    )
  )
  (reverse newlist)
)
  (defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT) (setq dat (itoa dat)))
        ((= (type dat) 'REAL) (setq dat (rtos dat 2 12)))
        ((null dat) (setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))
  ) ;_ end of cond
) ;_ end of defun
(defun GetDynamicBlockPropertyList (obj)
 (mapcar
    (function
      (lambda ( prop )
        (list (vla-get-propertyname prop) (vlax-get prop 'Value) prop)
      )
    )
    (vlax-invoke obj 'GetDynamicBlockProperties)
  )
)
(defun GetDynamicBlockPropertyNameValue ( obj PropertyName / Plist)
  (and
  (setq PropertyName (strcase PropertyName))
  (setq Plist (GetDynamicBlockPropertyList obj))
  (setq Plist (car(vl-remove-if-not '(lambda (x)
                                   (= (strcase (car x)) PropertyName))
                Plist
                ))
        )
  )
   (cadr Plist)
  )
(defun mip-block-setattr-bylist (obj att_list / txt lst)
  (if (= (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of if
  (setq att_list (mapcar '(lambda (x)
                            (cons (strcase (mip-conv-to-str (car x)))
                                  (mip-conv-to-str (cdr x))
                            ) ;_ end of cons
                          ) ;_ end of lambda
                         att_list
                 ) ;_ end of mapcar
  ) ;_ end of setq
  (if (and obj
           (not (vlax-erased-p obj))
           (= (vla-get-objectname obj) "AcDbBlockReference")
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)
           (vlax-write-enabled-p obj)
      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq
                  lst (assoc (strcase (vla-get-tagstring at)) att_list)
                ) ;_ end of setq
              (vla-put-textstring at (cdr lst))
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun
(defun round (value to)
;;; Doug Broad
;;; additional credits Joe Burke, Peter Toby
  (setq to (abs to))
  (* to
     (fix (/ ((if (minusp value)
                -
                +
              ) ;_ end of if
               value
               (* to 0.5)
             )
             to
          ) ;_ end of /
     ) ;_ end of fix
  ) ;_ end of *
) ;_ end of defun  
(defun get-all-atts (obj)
  (if (and obj
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)

      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (mapcar (function (lambda (x)
                              (cons (vla-get-tagstring x)
                                    (vla-get-textstring x)
                              ) ;_ end of cons
                            ) ;_ end of lambda
                  ) ;_ end of function
                  (append (vlax-invoke obj 'Getattributes)
                          (vlax-invoke obj 'Getconstantattributes)
                  ) ;_ end of append
          ) ;_ end of mapcar
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun  
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  ;;;http://www.theswamp.org/index.php?topic=16564.msg207439;topicseen#msg207439
  ;;; http://www.theswamp.org/index.php?topic=6474.0
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)
  ;;; ===================== LOCAL FUNCTION ==========================================

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
;;;============================================================= 
;;;====================== MAIN PART ============================ 
;;;============================================================= 
  (vla-startundomark adoc)
  (setq dimz (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setq *PREF* (mip-conv-to-str *PREF*))
  (setq *SUFF* (mip-conv-to-str *SUFF*))
  (princ "\nВведите префикс или Пробел - нет <")
  (princ *PREF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *PREF* poz))
  (if (= poz " ")(setq *PREF* ""))
  (princ "\nВведите суффикс или Пробел - нет <")
  (princ *SUFF*)(princ ">: ")(setq poz (getstring t))
  (if (/= poz "")(setq *SUFF* poz))
  (if (= *SUFF* " ")(setq *SUFF* ""))
  (princ "\nКратность (5 - кратно 5; 0.5 - кратно 0.5) или 0 - нет <")
  (if (numberp *ROUND*)(princ *ROUND*)(princ "НЕТ"))
  (princ ">: ")(initget 4)
  (if (null (setq poz (getdist)))
    (setq poz (if (numberp *ROUND*) *ROUND*  0))
  ) ;_ end of if
  (if (zerop poz)(setq *ROUND* nil)(setq *ROUND* poz)) ;_ end of if
  (princ "\nНачальный номер <")(princ *STARTPOZ*)(princ ">: ")
  (if (null(setq i (getint)))(setq i *STARTPOZ*)(setq *STARTPOZ* i))
  (if (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
           (princ "\nЭтап 1. Построение списка блоков.")
           (setq lstLen (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      ) ;_ end of and
    (progn
      (princ "\nЭтап 2. Анализ блоков.")
      (setq i      0
            lstLen (mapcar 'vlax-ename->vla-object lstlen)
      ) ;_ end of setq
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
          ) ;_ end of and
           (progn
             (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                       )
             ) ;_ end of if
             (setq lst
                    (cons (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9)) lst)
             ) ;_ end of setq
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (princ "... Обработано ")(princ i)(princ " блоков")
      (princ "\nЭтап 3. Построение списка из уникальных значений.")
      (setq lst (SORTSTRINGWITHNUMBERASNUMBER (RemoveDuplicateStrings lst) nil))
      (princ "\nЭтап 4. Обновление атрибутов блоков.")
      (setq i 0)
      (foreach blk lstLen
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq dp1 (GetDynamicBlockPropertyNameValue blk dynProp1))
               (setq dp2 (GetDynamicBlockPropertyNameValue blk dynProp2))
               (if (numberp *ROUND*)
                 (setq dp1 (round dp1 *ROUND*)
                       dp2 (round dp2 *ROUND*)
                 ) ;_ end of setq
                 t
               ) ;_ end of if
               (setq poz (vl-position
                           (strcat (rtos dp1 2 9) ":" (rtos dp2 2 9))
                           lst
                         ) ;_ end of vl-position
               ) ;_ end of setq
          ) ;_ end of and
           (progn
             (mip-block-setattr-bylist
               blk
               (list (cons (strcase attTo)
                           (strcat *PREF* (itoa (+ *STARTPOZ* poz)) *SUFF*)
                     ) ;_ end of cons
               ) ;_ end of list
             ) ;_ end of mip-block-setattr-bylist
           ) ;_ end of progn
        ) ;_ end of if
 ;_ end of if 
      ) ;_ end of foreach
      (setq *STARTPOZ* (+ *STARTPOZ* (length lst)))
      (princ "... Обновлено ")(princ i)(princ " атрибутов в блоках \n")
      (vla-regen adoc acactiveviewport)
    ) ;_ end of progn 
  ) ;_ end of if
  (setvar "DIMZIN" dimz)
  (vla-endundomark adoc)(princ)
) ;_ end of defun
DMSskop вне форума  
 
Непрочитано 24.09.2020, 18:54
#3925
gnuvse


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
gnuvse, неправильная постановка вопроса - вам для обучения надо искать подробно документированный хороший код, поскольку самостоятельно перелопачивать кучу информацию вы, похоже, особо не горите желанием...
Вы правы, но я посчитал, что слишком жирно такой код просить.
Если у вас есть примеры любого документированного кода или вы знаете ссылки на него - поделитесь пожалуйста.

Перелопачивать информацию я готов, просто хочу перелопачивать сразу верное решение, таким образом эффект от обучения будет выше.
А написать плохо всегда можно.
gnuvse вне форума  
 
Непрочитано 24.09.2020, 19:25
1 | #3926
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 8,842


Цитата:
Сообщение от gnuvse Посмотреть сообщение
Если у вас есть примеры любого документированного кода или вы знаете ссылки на него - поделитесь пожалуйста.
на лиспе не пишу, а когда выкладывал примеры на .Net - комментариев у меня там было прилично) Есть официальный сайт разработчиков Аутодеска, есть сайт Алексея, есть справка от разработчика, есть сайт от Lee Mac и т.д.

Цитата:
Сообщение от gnuvse Посмотреть сообщение
Перелопачивать информацию я готов, просто хочу перелопачивать сразу верное решение, таким образом эффект от обучения будет выше.
А написать плохо всегда можно.
эффект от обучения как раз - когда на грабли наступаешь. Только потом не бросаешься на них снова и снова, пытаясь подобрать работающий кусок кода вслепую - а начинаешь читать справку и форумы.
Сергей812 вне форума  
 
Непрочитано 02.10.2020, 16:30
#3927
megabeton


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


Как сформировать набор всех примитивов чертежа, включая примитивы, входящие в блоки?
megabeton вне форума  
 
Непрочитано 02.10.2020, 16:38
#3928
skkkk


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


А точно именно набор нужен (selection set)? Или список entity_name'ов? Или список vla-объктов?
skkkk на форуме  
 
Непрочитано 02.10.2020, 17:02
#3929
megabeton


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


Мне через (ssget ???) как нибудь надо.
Просто (ssget "_A") включает все примитивы, но без внутренностей блока, только сами блоки.

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

----- добавлено через ~4 мин. -----
именно набор нужен (selection set)
megabeton вне форума  
 
Непрочитано 02.10.2020, 17:28
#3930
Кулик Алексей aka kpblc
Moderator

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


Проходишь по коллекции всех блоков и забираешь все примитивы. При необходимости можно исключать внешние ссылки - или наоборот, забирать и оттуда все.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.10.2020, 14:33
#3931
megabeton


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


А вообще есть такая функция (команда/способ), выдающая список всех примитивов чертежа, и не важно куда и в какие блоки эти примитивы запрятаны? По идее автокад где то же хранит эту информацию (количество отрезков, текстов и пр. вне зависимости от принадлежности их блокам).
megabeton вне форума  
 
Непрочитано 12.10.2020, 14:38
1 | #3932
Кулик Алексей aka kpblc
Moderator

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


Штатной функции я не знаю. А решение я тебе уже подсказал. Реализация за тобой
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.10.2020, 17:40
#3933
megabeton


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


Где ошибка, подскажите
Хочу набор примитивов из внутренностей блоков создать
"; ошибка: ActiveX Server возвратил ошибку: неизвестное имя: EffectiveName"

Код:
[Выделить все]
   (setq ssb (ssget))
	(setq index -1)
	(repeat 
		(sslength ssb)
		(setq	index	(1+ index) 
				ento		(ssname ssb index))
		(setq ent (vlax-ename->vla-object ento))
		;;; Получить vla-указатель на описание блока
		(setq block_def	(vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-effectivename ent))
		)
		;;; Получить список всех примитивов, входящих в блок
		(setq block_cont	(
								(lambda	(/ res)
										(vlax-for sub block_def (setq res (cons sub res)))
										(reverse res)
								)
							)
		)
	)
Ну и будьте людьми, научите извлекать примитивы из блоков без ActiveX, слишком темный это для меня пока лес.

Последний раз редактировалось megabeton, 12.10.2020 в 17:46.
megabeton вне форума  
 
Непрочитано 12.10.2020, 17:47
#3934
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 8,842


действительно, зачем проверять наличие данного свойства)
Код:
[Выделить все]
 vlax-property-available-p blk 'effectivename
Сергей812 вне форума  
 
Непрочитано 12.10.2020, 18:57
#3935
megabeton


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


Ну хорошо, вместо
Код:
[Выделить все]
 (setq	index	(1+ index) 
				ento		(ssname ssb index))
		(setq ent (vlax-ename->vla-object ento))
сделал
Код:
[Выделить все]
 (setq	index	(1+ index) 
				ento		(ssname ssb index))
		(setq ent (vlax-ename->vla-object (cadar ento)))
Теперь говорит
; ошибка: неверный тип аргумента: <Имя объекта: 7ff4119e6da0>

Т.е. ssname возвращает <Имя объекта: 7ff4119e6da0>
Для vlax-ename->vla-object тоже даю <Имя объекта: 7ff4119e6da0> при помощи (cadar ento)

Теперь где ошибаюсь?
megabeton вне форума  
 
Непрочитано 13.10.2020, 01:10
1 | #3936
Кулик Алексей aka kpblc
Moderator

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


Без проверок (виртуалку с ACAD'ом запускать долго):
Код:
[Выделить все]
 (defun _kpblc-get-ent-name (ent /)
                           ;|
*    Получение свойства name указанного примитива
*    Параметры вызова:
  ent  указатель на обрабатываемый примитив
    допускаются значения
    ename
    vla-object
|;
  (cond ((= (type ent) 'str) ent)
	      ((= (type ent) 'ename) (_kpblc-get-ent-name (vlax-ename->vla-object ent)))
	      ((vlax-property-available ent 'effectivename)
				(vla-get-effectivename ent)
				)
				((vlax-property-available ent 'name)
				(vla-get-name ent)
				)
        ((_kpblc-property-get ent 'effectivename))
        ((_kpblc-property-get ent 'name))
        ) ;_ end of cond
  ) ;_ end of defun
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.10.2020, 09:18
1 | #3937
koMon


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


Цитата:
Сообщение от megabeton Посмотреть сообщение
будьте людьми, научите извлекать примитивы из блоков без ActiveX
Код:
[Выделить все]
 (setq block_inspected (vlax-ename->vla-object (car (entsel "\nВыберите блок:"))))
(setq starting_entity (tblobjname "block" (vla-get-effectivename block_inspected))
      block_entities_list '()
)
(while (setq next_entity (entnext starting_entity))
	(setq block_entities_list (cons next_entity block_entities_list)
	      starting_entity next_entity
    )
)
(foreach block_entity block_entities_list (print (entget block_entity)))
koMon вне форума  
 
Непрочитано 09.11.2020, 15:20
#3938
megabeton


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


Как создать примитив внутри блока?
* без (command "_bedit" nameblk)
megabeton вне форума  
 
Непрочитано 09.11.2020, 15:23
#3939
koMon


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


add* методы добавляют примитивы в блоки и пространства
koMon вне форума  
 
Непрочитано 09.11.2020, 15:24
#3940
megabeton


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


эмм...)) Без ActiveX возможно ?

Хотя наверно ладно, проще эту главу все же изучить
megabeton вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Система Техэксперт дает уверенность в правильности и эффективности принимаемых инженерных решений!
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 270 19.07.2020 23:34
Сейсмозащита и сейсмоизоляция существующих, построенных зд. IANationalInformAgentstvo Прочее. Архитектура и строительство 216 20.01.2015 16:51
Мониторы LCD CRT Разное 94 17.06.2008 10:51
ЮМОР 2006 =) Perezz!! Разное 1122 04.01.2007 00:46