[Zouss]

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

[VVA]

Полезные функции (часть 2)
Построение примитивов с помощью функции ENTMAKE

[Zouss]

Большое спасибо

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

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

Небольшое уточнение. Если в строке больше 250 символов (за символ считаются и знаки форматирования), то надо будет дополнительно использовать 3-ю группу. Общая длина строки не может превышать 32 000 символов (на самом деле чуть больше, но и до такого ограничения надо суметь добраться )

[Zouss]

слегка приподнял и слегка переименовал тему
kpblc, спасибо за уточнение.
а новый вопрос как раз касается примитивов с повторяющимися группами, в частности Leader - там минимум три 10-dxf группы и править мне надо как раз среднюю
и собственно вопрос - нет ли у кого примера ЭнтМоддинга таких вещей?
p.s. на LISP-то я какое-нибудь уродство типа последовательного перебора списка данных накатаю, но в связи с наступившим Восьмомартом хочется выглядеть как-то поэлегантнее что-ли...

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

Вот насчет повторяющихся... Тут, конечно, намного удобнее получится через activex. К примеру: создаем выноску с указанием 3 точек, и назначаем координату 2 точки примерно так:

Код:

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

(setq lead (vlax-ename->vla-object (car (entsel))))
(vla-put-coordinate lead 1 (vlax-3d-point '(0. 0. 0.)))

Несколько моментов:
1. Нумерация координатных точек идет с 0.
2. Координаты указываются только в мировой системе координат.
Для работы через ent*-функции (я думаю) придется слишком длинный код делать, на что сейчас я не способен

[Zouss]

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

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

Ну если получить n-ное вхождение труда не составит:

Код:

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

(defun _kpblc-ent-get-dxf-num (ent dxf num)
			      ;|
*    Функция получения num-ного вхождения dxf в ename
*    Параметры вызова:
*	ent	ename-указатель на примитив
*	dxf	dxf-код
*	num	номер. Нумерация с 1.
|;
  (if (assoc dxf (entget ent))
    (nth (1- num) (vl-remove-if-not '(lambda (x) (= (car x) dxf)) (entget ent)))
    ) ;_ end of if
  ) ;_ end of defun

То вот обратно... Нечто типа (ИМХО, без проверок):

Код:

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

(defun _kpblc-lst-replace-num (lst new num / res count)
			      ;|
*    Замена num-ного элемента в списке lst значением new
*    Параметры вызова:
*	lst	список
*	new	новый элемент
*	num	номер. Нумерация идет с 1.
|;
  (setq count 1)
  (foreach item	lst
    (cond
      ((/= count num)
       (setq res (append res (list item)))
       )
      ((= count num)
       (setq res (append res (list new)))
       )
      ) ;_ end of cond
    (setq count (1+ count))
    ) ;_ end of foreach
  res
  ) ;_ end of defun

И тогда в результате получится по аналогии с:

Код:

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

(entmod (append (vl-remove-if '(LAMBDA(x) (= (car x) 10)) (entget lead)) (_kpblc-lst-replace-num (vl-remove-if-not '(LAMBDA(x) (= (car x) 10)) (entget lead)) (cons 10 '(0. 0. 0.)) 2)))

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

[Лентяй]

Сообщение от Кулик Алексей aka kpblc Вот насчет повторяющихся... Тут, конечно, намного удобнее получится через activex.

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

Код:

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

(defun C:ANNO ( / adoc ass bks vars cpt tpt csp mtxt msp sc lims ht ld)
  (setq	adoc (vla-get-ActiveDocument (vlax-get-acad-object))
        vars (mapcar 'getvar '("SNAPMODE" "ORTHOMODE"))
	cpt (getpoint "\nSelect callout location: ?")
	tpt (getpoint "\nSelect Text Location: ?")
	csp (vla-ObjectIDtoObject adoc (vla-get-ownerID obj))
	txt0 (if (null txt0) "")
	txt (vla-getString (vla-get-utility adoc) :vlax-true "\nEnter Text String: ")
	txt0 txt);setq
  (vla-InitializeUserInput util 128 "Yes No")
  (setq kw (vla-getKeyword util "Arrowhead [Yes/No]? <Yes>")
	eh (if (or (=  kw "Yes") (=  kw "Yes")) T nil))
  (foreach var '("ORTHOMODE" "SNAPMODE") (setvar var 0))
  (if (= (vla-get-name csp) "*Paper_Space")(setq ht 0.09375)
    (progn (if (= (vl-catch-all-apply '(lambda () (vla-get-ActiveSpace adoc))) 0)
	(setq ht (/ 0.09375 (vla-get-CustomScale (vla-get-ActivePViewport adoc)vp)));setq
	(progn (vla-put-ActiveSpace adoc 0)
          (if (= (setq msp (vla-get-mspace adoc)) :vlax-false) (vla-put-mspace adoc :vlax-true))
          (vlax-for vp (vla-get-paperSpace adoc)
	    (if (= (vla-get-ObjectName vp) "AcDbViewport")(progn
	      (if (= (vla-get-ViewportOn vp) :vlax-false) (vla-Display vp :vlax-true))
              (vla-getBoundingBox (setq vp (vla-get-ActivePViewport adoc)) 'mn 'mx)
              (setq lims (mapcar 'vlax-safearray->list (list mn mx)))
              (if (apply 'and (mapcar '(lambda (x y z) (<= x y z))
                                (car lims) (trans tpt 2 3) (cadr lims)));apply
                 (setq ht (/ 0.09375 (vla-get-CustomScale vp)))))));vlax-for
          (if (null ht) (setq ht (getreal "Enter text height: ")))
          (setq sc (/ 0.09375 ht))
          (vla-put-mspace adoc msp) (vla-put-ActiveSpace adoc 1));progn
      ));progn
  );if
  (setq mtxt (vla-addMtext csp (vlax-3d-point tpt) 0 txt))
  (mapcar '(lambda (x) (vlax-put-property mtxt x y)) '(Height AttachmentPoint)
               (list ht (if (< (car cpt) (car tpt)) 4 6)))
  (setq lpt ((if (< (car cpt) (car tpt)) - +) (car cpt) (* 0.09375 sc))
        ld (vla-addLeader csp (vlax-make-variant
	       (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 5))
		 (append cpt (subst lpt (car tpt) tpt))))
	     mtxt (if eh acLineWithArrow acLineNoArrow)))
  (vla-put-ScaleFactor ld (/ 1 sc))
  (vla-move mtxt (vla-get-InsertionPoint mtxt) (vlax-3d-point tpt))
  (mapcar 'setvar '("SNAPMODE" "ORTHOMODE") vars)
);end

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

[Zouss]

в общем решение проблемы было найдено в другом месте, а для чего все это затевалось можно здесь посмотреть http://dwg.ru/forum/viewtopic.php?p=130558#130558

[Лентяй]

Держите лиспу исправленную и дополненную

Код:

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

(defun C:ANNO ( / adoc util vars cpt tpt mtxt msp sc lims ht ld) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	util (vla-get-utility adoc)
	vars (mapcar 'getvar '("SNAPMODE" "ORTHOMODE")) 
   	cpt (getpoint "\nSelect callout location: ?") 
   	tpt (getpoint "\nSelect Text Location: ?") 
   	txt0 (if (null txt0) "" txt0) 
   	txt (vla-getString util :vlax-true (strcat "\nEnter Text String: <" txt0 ">"))
	txt (if (= txt "") txt0 txt)
   	txt0 txt);setq
  (vla-InitializeUserInput util 128 "Yes No") 
  (setq kw (vla-getKeyword util "\nArrowhead [Yes/No]? <Yes>")
	eh (if (or (=  kw "Yes") (=  kw "")) T nil))
  (foreach var '("ORTHOMODE" "SNAPMODE") (setvar var 0)) 
  (if (= (getvar "CVPORT") 1) (setq ht 0.09375 sc 1)
    (progn (if (= (vl-catch-all-apply '(lambda () (vla-get-ActiveSpace adoc))) 0)
	     (setq ht (/ 0.09375 (vla-get-CustomScale (vla-get-ActivePViewport adoc)vp)));setq
	     (progn (vla-put-ActiveSpace adoc 0)
	       (if (= (setq msp (vla-get-mspace adoc)) :vlax-false) (vla-put-mspace adoc :vlax-true))
	       (vlax-for vp (vla-get-paperSpace adoc)
		 (if (= (vla-get-ObjectName vp) "AcDbViewport") (progn
		     (if (= (vla-get-ViewportOn vp) :vlax-false) (vla-Display vp :vlax-true))
		     (vla-getBoundingBox (setq vp (vla-get-ActivePViewport adoc)) 'mn 'mx)
		     (setq lims (mapcar 'vlax-safearray->list (list mn mx)))
		     (if (apply 'and (mapcar '(lambda (x y z) (<= x y z))
					     (car lims) (trans tpt 2 3) (cadr lims)));apply
		       (setq ht (/ 0.09375 (vla-get-CustomScale vp)))))));vlax-for
	       (if (null ht) (setq ht (getreal "Enter text height: ")))
	       (setq sc (/ 0.09375 ht))
	       (vla-put-mspace adoc msp) (vla-put-ActiveSpace adoc 1));progn
      ));progn
  );if
  (setq mtxt (vla-addMtext csp (vlax-3d-point tpt) 0 txt)) 
  (mapcar '(lambda (x y) (vlax-put-property mtxt x y)) '(Height AttachmentPoint) 
               (list ht (if (< (car cpt) (car tpt)) 4 6)))
  (setq lpt ((if (< (car cpt) (car tpt)) - +) (car cpt) (* 0.09375 sc))
        ld (vla-addLeader csp (vlax-make-variant 
          (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 5)) 
       (append cpt (subst lpt (car tpt) tpt)))) 
        mtxt (if eh acLineWithArrow acLineNoArrow))) 
  (vla-put-ScaleFactor ld (/ 1 sc)) 
  (vla-move mtxt (vla-get-InsertionPoint mtxt) (vlax-3d-point tpt)) 
  (mapcar 'setvar '("SNAPMODE" "ORTHOMODE") vars) 
);end