[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

_____________________________________________________________________________________________________________

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

[Ingpro]

Код Алексея aka kpblc из поста #4813 с исправленной 46 строкой
Проставляет площадь выбранной полилинии (текст подчеркнутый)
Если не нужен подчеркнутый текст, то 46 (здесь уже 49) строка

Код:

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

 (cons 1 (strcat "%%u" (rtos (* (vla-get-area ent) 1e-6) 2 2)))

выглядит немного по-другому:

Код:

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

 (cons 1 (rtos (* (vla-get-area ent) 1e-6) 2 2))

Код:

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

 ;; Проставляет площадь полилинии в указанную точку, текст подчеркнутый
;; https://forum.dwg.ru/showthread.php?p=2084327#post2084327
;; Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу) - Страница 241
 (vl-load-com)
(defun c:area-underl-txt (/ adoc ent point) 
  (if 
    (and 
      (= 
        (type 
          (setq ent (vl-catch-all-apply 
                      (function 
                        (lambda () 
                          (car (entsel "\nSelect polyline <Cancel> : "))
                        )
                      )
                    )
          )
        )
        'ename
      )
      (setq ent (vlax-ename->vla-object ent))
      (vlax-property-available-p ent 'area)
      (= 
        (type 
          (setq point (vl-catch-all-apply 
                        (function 
                          (lambda () 
                            (getpoint "\nInsertion point <Cancel> : ")
                          )
                        )
                      )
          )
        )
        'list
      )
      point
    )
    (progn 
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (entmakex 
        (list 
          '(0 . "TEXT")
          '(100 . "AbDbEntity")
          '(100 . "AcDbText")
          '(72 . 0)
          (cons 10 point)
          (cons 11 point)
          '(40 . 250) ; высота текста 250 (замените, если надо другую)
         (cons 1 (strcat "%%u" (rtos (* (vla-get-area ent) 1e-6) 2 2)))
        )
      )
      (vla-endundomark adoc)
    )
  )
  (princ)
)

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

Код:

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

 (vl-cmdf "_.ucs" "_w")

?

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

entmake / entmakex, насколько я помню, создают примитивы в текущей ПСК. А вот получение точек - тут плаваю, могут быть варианты.

[Ingpro]

Этот код проставляет площадь как бы в кв. футах 15,959,526 S.F. Но в кв. м это = 15.96 кв.м, т.е. эти цифры "похожи".
Реально 15.96 кв.м.= 171,79 кв. футов. И какой-то странный формат с двумя запятыми 15,959,526 S.F....
Но 1 кв. фут = 10,76 кв. м.
Единицы чертежа у меня - миллиметры.
Подскажите чайнику, плз, какая строка в коде отвечает за единицы площади?
Как изменить квадратные футы на кв. метры?

Код:

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

 ;; простановка площадей выбранных закрытых зон в квадратных футах (цикл)

;;;(addtext <string> <point> <real>)
(defun addtext (textstring insertionpoint height / aa)
 (vl-load-com)
 (setq aa (vla-get-activedocument (vlax-get-acad-object)))
 (vla-addtext
 (if (= 1 (vla-get-activespace aa))
 (vla-get-modelspace aa)
 (if (= (vla-get-mspace aa) :vlax-true)
 (vla-get-modelspace aa)
 (vla-get-paperspace aa)
 )
 )
 textstring
 (vlax-3d-point insertionpoint)
 height)
 )

(defun add-comma (txt / strl cont1 lth cont txt1)
 (setq strl (strlen txt)
 cont1 1
 txt1 "")
 (while (and (/= (substr txt cont1 1) ".") (<= cont1 strl))
 (setq cont1 (1+ cont1)))
 (setq lth (1- cont1)
 cont1 1
 cont (1- lth))
 (if (> lth 3)
 (progn
 (while (< cont1 lth)
 (setq let (substr txt cont1 1)
 txt1 (strcat txt1 let))
 (if (and (zerop (rem cont 3)) (eq (type (read let)) 'INT))
 (setq txt1 (strcat txt1 ",")))
 (setq cont (1- cont)
 cont1 (1+ cont1)))
 (while (<= cont1 strl)
 (setq txt1 (strcat txt1 (substr txt cont1 1))
 cont1 (1+ cont1)))
 txt1)
 txt))

(defun get-last-coord (obj / coords last_coord)
 (setq coords (vla-get-coordinates obj)
 coords (vlax-safearray->list (vlax-variant-value coords))
 coords (reverse coords)
 last_coord (list (cadr coords)(car coords)
 )
 )
 last_coord
 )

(defun C:put-area (/ ent vla_obj pt objname vla_text aa)
 (while (setq ent (entsel "\nSelect closed object: "))
 (setq vla_obj (vlax-ename->vla-object (car ent))
 objname (vla-get-objectname vla_obj))
 (if
 (vlax-property-available-p vla_obj 'area)
 (progn
 (if
 (or
 (= "AcDbCircle" objname)
 (and (wcmatch (vla-get-objectname vla_obj) "*Polyline")
 (or (= :vlax-true (vla-get-closed vla_obj))
 (equal (vlax-safearray->list
 (vlax-variant-value
 (vla-get-coordinate vla_obj '0)))
 (get-last-coord vla_obj)
 0.001)
 )
 )
 )
 (progn
 (if (setq pt (getpoint "\nPick text placement: "))
 (progn
 (setq vla_text
 (addtext
 (strcat
 (add-comma
 (rtos
 (vla-get-area vla_obj)
 2
 0))
 " S.F.")
 pt
 (getvar "textsize")))

 ;; alignment to left
 (vla-put-alignment vla_text acAlignmentCenter)

 (vla-put-textalignmentpoint
 vla_text
 (vlax-3d-point pt))

 ;; use current textstyle
 (vla-put-stylename
 vla_text
 (vla-get-name
 (vla-get-activetextstyle
 (setq aa (vla-get-activedocument
 (vlax-get-acad-object)))))))))
 (prompt "\nNot a closed object. ")
 ))))
 (princ))
(princ)

[name02]

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

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

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

1. Форматируй код.
2. Проверяй единицы чертежа (те же _.dwgunts)

[Ingpro]

Сообщение от name02 Программа выполняет расчет в строках 080-085 и там же через каждые три символа ставит запятые - видимо так принято там, где работате создатель программы

name02, спасибо, а как можно это изменить на формат вывода в кв. м без лишних запятых?

Код:

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

 (rtos (vla-get-area vla_obj) 2 0)) " S.F.")

Эта строка мне понятна, но то, что выше - нет...

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

Сообщение от Ingpro name02, спасибо, а как можно это изменить на формат вывода в кв. м без лишних запятых?

Запускай программу в VLIDE, ставь точки остановки и смотри значения переменных.

[name02]

За простановку запятых отвечает функция add-text - если убрать ее из формирования итоговой строки, то запятые не добавятся

[Ingpro]

Сообщение от name02 За простановку запятых отвечает функция add-text - если убрать ее из формирования итоговой строки, то запятые не добавятся

(defun add-comma (txt / strl cont1 lth cont txt1) строка 020
Если в 035-ой строке
(setq txt1 (strcat txt1 ","))) заменить на ".", получается 15.959.526, а надо 15.96

[name02]

Сообщение от Ingpro А где ставить точки остановки?

Почитай тут https://acad-prog.ru/vlisp/

Сообщение от Ingpro Нужно ли add-comma заменить на add-point

Не туда смотришь - 80-ю строчку стирай, а в 84-й - удаляй одну скобку

[Ingpro]

Сообщение от name02 Не туда смотришь - 80-ю строчку стирай, а в 84-й - удаляй одну скобку

Если так сделать, то число 15959526 в мм, а не в м

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

Туды жа:
https://autolisp.ru/2009/09/10/vlide-misc-01/
https://autolisp.ru/2009/09/12/vlide-misc-02/

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Туды жа: https://autolisp.ru/2009/09/10/vlide-misc-01/ https://autolisp.ru/2009/09/12/vlide-misc-02/

Но там же не про перевод мм в м...

[name02]

Ты читал мое сообщение ?
Ты же, блин, инженер - немного проанализируй код, подумай!

Даю подсказку - строка 082

[Ingpro]

Сообщение от name02 Ты читал мое сообщение ? Ты же, блин, инженер - немного проанализируй код, подумай! Даю подсказку - строка 082

Код:

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

 С этой строчкой получилось:
(rtos (* (vla-get-area vla_obj) 1e-6) 2 2))

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

[Ingpro]

Есть код, который проставляет размеры прямоугольника в м и футах-дюймах:
1
3000 x 2000
9842'-6" x 6561'-8"
У меня не получается убрать строку с футами-дюймами, чтобы осталось только
1
3000 x 2000

Код:

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

 (defun c:RoomLabel ( /  _Imperial Roomname fc nc h v str p)
(defun _Imperial (v)
  (rtos (cvunit v "meter" "inch") 4 0))
	(while
	 (and
	   (setq Roomname (getstring t "\nEnter room name: "))
	   (setq fc (getpoint "\nPick first corner"))
	   (null (initget 32))
	   (setq nc (getcorner fc "\nPick Next corner"))
	   )
	(setq h (abs (- (car fc)(car nc)))
	      v (abs (- (cadr fc)(cadr nc))))
	(setq str (strcat  (strcase Roomname) "\\P"
			   (rtos h 2 2) " x " (rtos v 2 2) "\\P"
			   (_Imperial h) " x " (_Imperial v)))
	(setq p (mapcar (function (lambda (a b) (/ (+ a b) 2.))) fc nc))
	(entmakex (list (cons 0 "MTEXT")
			  (cons 100 "AcDbEntity")
			  (cons 100 "AcDbMText")
			  (cons 10 (trans p 1 0))
			  (cons 1 str)
			  (cons 41 (- (car p)(car p)))	
			  (cons 71 5)
			  (cons 72 5)
			  (cons 73 1)
			  (cons 7 (getvar 'TextStyle))
				    )
			  )
	    )
  (princ)
  )

Я пробую закомментировать некоторые строки, но AutoCAD выдает ошибку

; ошибка: неверно сформированный список на входе

Код:

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

 (defun c:RoomLabel ( / Roomname fc nc h v str p)
;(defun c:RoomLabel ( /  _Imperial Roomname fc nc h v str p)
;(defun _Imperial (v)
 ; (rtos (cvunit v "meter" "inch") 4 0))
	(while
	 (and
	   (setq Roomname (getstring t "\nEnter room name: "))
	   (setq fc (getpoint "\nPick first corner"))
	   (null (initget 32))
	   (setq nc (getcorner fc "\nPick Next corner"))
	   )
	(setq h (abs (- (car fc)(car nc)))
	      v (abs (- (cadr fc)(cadr nc))))
	(setq str (strcat  (strcase Roomname) "\\P"
			   (rtos h 2 2) " x " (rtos v 2 2) "\\P"
			 ; (_Imperial h) " x " (_Imperial v)))
...........................

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

Потому что код крайне желательно хоть как-то форматировать. Тогда его читать становится кратно проще:

Код:

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

 (defun c:RoomLabel (/ _Imperial Roomname fc nc h v str p) 
  (defun _Imperial (v) 
    (rtos (cvunit v "meter" "inch") 4 0)
  )
  (while 
    (and 
      (setq Roomname (getstring t "\nEnter room name: "))
      (setq fc (getpoint "\nPick first corner"))
      (null (initget 32))
      (setq nc (getcorner fc "\nPick Next corner"))
    )
    (setq h (abs (- (car fc) (car nc)))
          v (abs (- (cadr fc) (cadr nc)))
    )
    (setq str (strcat (strcase Roomname) 
                      "\\P"
                      (rtos h 2 2)
                      " x "
                      (rtos v 2 2)
                      "\\P"
                      (_Imperial h)
                      " x "
                      (_Imperial v)
              )
    )
    (setq p (mapcar (function (lambda (a b) (/ (+ a b) 2.))) fc nc))
    (entmakex 
      (list (cons 0 "MTEXT") 
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbMText")
            (cons 10 (trans p 1 0))
            (cons 1 str)
            (cons 41 (- (car p) (car p)))
            (cons 71 5)
            (cons 72 5)
            (cons 73 1)
            (cons 7 (getvar 'TextStyle))
      )
    )
  )
  (princ)
)

И тут же становится видно, что, где и как комментировать:

Код:

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

 (defun c:RoomLabel (/ _Imperial Roomname fc nc h v str p) 
  ;(defun _Imperial (v)
  ;  (rtos (cvunit v "meter" "inch") 4 0)
  ;)
  (while 
    (and 
      (setq Roomname (getstring t "\nEnter room name: "))
      (setq fc (getpoint "\nPick first corner"))
      (null (initget 32))
      (setq nc (getcorner fc "\nPick Next corner"))
    )
    (setq h (abs (- (car fc) (car nc)))
          v (abs (- (cadr fc) (cadr nc)))
    )
    (setq str (strcat (strcase Roomname) 
                      "\\P"
                      (rtos h 2 2)
                      " x "
                      (rtos v 2 2)
                      ;  "\\P"
                      ;  (_Imperial h)
                      ;  " x "
                      ;  (_Imperial v)
              )
    )
    (setq p (mapcar (function (lambda (a b) (/ (+ a b) 2.))) fc nc))
    (entmakex 
      (list (cons 0 "MTEXT") 
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbMText")
            (cons 10 (trans p 1 0))
            (cons 1 str)
            (cons 41 (- (car p) (car p)))
            (cons 71 5)
            (cons 72 5)
            (cons 73 1)
            (cons 7 (getvar 'TextStyle))
      )
    )
  )
  (princ)
)

----- добавлено через 47 сек. -----
Хотя я такой код вряд ли бы выпускал в большую жизнь.

[Ingpro]

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

Алексей, спасибо за быструю реакцию... Футы-дюймы "ушли"...
А почему не выпускать?..

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

Сообщение от Ingpro А почему не выпускать?..

Ну хотя бы потому, что отлова ошибок нет от слова совсем (попробуй в любой момент нажать Esc, порадуйся). Непонятна логика отмены, если что. По Ctrl-Z вроде бы будет откатываться создание каждого примитива, а вот надо оно так или как-то по-другому есть вопрос. (- (car p)(car p)) всегда (по идее) вернет 0 - какой смысл в вычислениях? Ну а про нейминг переменных вообще молчу )

[Ingpro]

(defun *error* (msg)
(princ (strcat "\n function error : " msg))
(princ)
) ;_ end of defun
А какую ошибку будем ловить в лиспе #4837, выход по Esc?, а как это записать?