Лисп =выноска+поле

Лисп =выноска+поле · 18.04.2006, 21:30

Для тех кто умеет писать лиспы это наверное не сложная задачка, а мне, да и другим проектировщикам занимающимся электрикой, пригодился бы вот такой лисп:
1. указываешь линию (отрезок/полилинию/3D полилинию);
2. место вставки.
А лисп за тебя прописывает в получившейся сноске название слоя, к которому относится линия, и хорошо бы еще название слоя было в виде поля (field), чтобы если вдруг захочется изменить слой линии, надпись менялась и соответствовала новому слою.

А может у кого-нибудь уже есть что-нибудь подобное?
Буду признателен.

pyatifan · 18.04.2006, 22:17

Есть выноска на лиспе. Её автор сюда каждый день водится. Компа под рукой нет:
www.autokad.ru
Раздел готовые программы, там в заголовке слово выноска есть. Ток она у меня барахлила. Там вроде косяки с реакторами...я подобную из KitoxTools использую вместо СПДС. Уверен этот хороший человек не останется равнодушным

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

Лентяй · Регистрация: 05.01.2005

Цитата:

Сообщение от Pave1

А может у кого-нибудь уже есть что-нибудь подобное?
Буду признателен.

Я не тот автор, но!
Вы хочите ЛИСПов? [sm2102] Их есть у меня!

Ниже приведенная прога предназначена для маркиривки трубопроводов "по-американски", но может работать и для других дисциплин. Информация о назначении линии записывается в расширенные данные примитива и оттуда же воспроизводится. Позже скину прогу для редактиривания единожды созданных выносок. Надеюсь, что перетолмачивать приглашения на русский не требуется.

Код:

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

(defun pct:getxdt (obj / sz serv mat vls xtp xdt)
  (vla-GetXData obj "INFO" 'xtp 'xdv)
  (if xdv (progn 
      (setq vls (mapcar '(lambda (x) (vlax-variant-value x))
			(cdr (vlax-safearray->list xdv))));setq
      (strcat (car vls) "-" (cadr vls) "(" (caddr vls) ")"));progn
    (progn (if (null sz0) (setq sz0 "")) (if (null mat0) (setq mat0 ""))
      (initget "Yes No")
      (setq kw (getkword "\n Service by Layer [Yes/No]: ? <Yes>"))
      (if (null kw) (setq kw "Yes"))       
      (setq serv (if (= kw "Yes") (vla-get-layer obj)
		   (getstring (strcat "\nEnter pipe service for " (vla-get-layer obj) ": ")))
	    sz (getstring (strcat "\nEnter pipe size for " serv ": <" sz0 ">")))
      (if (= sz "") (setq sz sz0)) (setq sz0 sz)
      (setq mat (getstring (strcat "\nEnter pipe material for " serv ": <" mat0 ">")))
      (if (= mat "") (setq mat mat0)) (setq mat0 mat)
      (setq xtp (vlax-make-variant (vlax-safearray-fill
		     (vlax-make-safearray vlax-vbInteger '(0 . 3)) '(1001 1000 1000 1000)))
	    vls (mapcar '(lambda (x) (vlax-make-variant x vlax-vbString))
			 (list "INFO" sz serv mat))
	    xdv (vlax-safearray-fill (vlax-make-safearray vlax-vbVariant '(0 . 3)) vls));setq
      (vla-SetXData obj xtp xdv)
      (strcat sz "-" serv "(" mat ")"));progn
  );if
);defun
;
(defun pct:leader (pt1 pt2 / lpt)
  (if (< (car pt1) (car pt2)) (setq lpt (- (car pt1) (* 0.09375 sc)))
    (setq lpt (+ (car pt1) (* 0.09375 sc))));if
  (setq ld (vla-addLeader csp (vlax-make-variant
	       (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 5))
		 (append pt1 (subst lpt (car pt2) pt2))))
	     mtxt (if eh acLineWithArrow acLineNoArrow)))
  (vla-put-ScaleFactor ld (/ 1 sc))
  (command "MOVE" (vlax-vla-object->ename mtxt) "" pt2
	   (subst (+ 0.001 (car pt2)) (car pt2) pt2))
);defun
;
(defun ofs (t1 t2)
  (if (<= t1 t2) (+ t1 (/ l 2)) (- t1 (/ l 2)))
);defun
;
(defun C:PCT (/ csp sm om ss clst cpt tpt tbp l pl cp x0 x1 y0 y1 sc ht txt mtxt a1 a2)
  (setq	adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	bks (vla-get-blocks adoc)
	vls (mapcar 'getvar '("SNAPMODE" "ORTHOMODE"))
	sz0 (if (null sz0) "") mat0 (if (null mat0) "")
	txt "");setq
  (foreach var '("ORTHOMODE" "SNAPMODE") (setvar var 0))
  (prompt "\nSelect Pipe(s) to Call Out: ")
  (ssget)
  (setq ass (vla-get-ActiveSelectionSet adoc)
  	cnt (vla-get-count ass)
	obj (vla-item ass 0)
	cpt (getpoint "\nSelect callout location: ?")
	tpt (getpoint "\nSelect Text Location: ?")
	hor (if (null (car (mapcar '(lambda (x) (setq x (if (> 1e-012 (abs x)) nil T)))
	      (vlax-curve-getFirstDeriv obj (vlax-curve-getParamAtPoint obj
		  (vlax-curve-getClosestPointTo obj cpt)))))) 0 1)
	csp (vla-ObjectIDtoObject adoc (vla-get-ownerID obj)));setq
  (if (= (vla-get-name csp) "*Paper_Space")(setq ht 0.09375)
    (progn (if (= (vla-get-ActiveSpace adoc) 0)
	(setq vp (vla-get-ActivePViewport adoc)
	      ht (/ 0.09375 (vla-get-CustomScale vp)));setq
	(progn (vlax-for vp (vla-get-paperSpace adoc)
	    (if (= (vla-get-ObjectName vp) "AcDbViewport")(progn
	      (setq cp (cdr (assoc 12 (entget (vlax-vla-object->ename vp))))
		    x0 (- (car cp) (/ (vla-get-Width vp) (vla-get-CustomScale vp) 2))
		    x1 (+ (car cp) (/ (vla-get-Width vp) (vla-get-CustomScale vp) 2))
		    y0 (- (cadr cp) (/ (vla-get-Height vp) (vla-get-CustomScale vp) 2))
		    y1 (+ (cadr cp) (/ (vla-get-Height vp) (vla-get-CustomScale vp) 2)));setq
	      (if (and (<= x0 (car cpt) x1) (<= y0 (cadr cpt) y1))
		(setq sc (vla-get-CustomScale vp)
		      ht (/ 0.09375 sc))))));vlax-for
	  (if (null ht) (setq ht (getreal "Enter text heigh: "))));progn
	));progn
    );if
  (cond ((= cnt 0) (alert "Nothing Selected! Please Try Again"))
	((= cnt 1) (initget "Yes No")
	 (setq kw (getkword "\n Text Above Line [Yes/No]: ? <Yes>"));setq
	 (if (null kw) (setq kw "Yes"))
	 (if (= kw "Yes") (progn
	   (setq tpt (cond ((= hor 1) (subst (+ (cadr tpt) (/ ht 4)) (cadr cpt) cpt))
			   ((= hor 0) (subst (- (car tpt) (/ ht 4)) (car cpt) cpt)))
		 txt (vla-addText csp (pct:getxdt obj) (vlax-3d-point tpt) ht));setq
	   (vla-put-rotation txt (if (= 1 hor) 0 1.5708)));Yes
	   (progn (setq mtxt (vla-addMtext csp (vlax-3d-point tpt) 0 (pct:getxdt obj)) eh T)
	     (vla-put-Height mtxt ht)
	     (if (< (car cpt) (car tpt))
	       (vla-put-AttachmentPoint mtxt 4) (vla-put-AttachmentPoint mtxt 6));if
	     (pct:leader cpt tpt))));=1
	((> cnt 1)
	 (setq a1 (if (< (car cpt) (car tpt)) '(0 4.71239 3.14159) '(0 1.5708 3.14159)))
	 (if (= hor 1) (setq a1 (nth 1 a1))
	   (setq a1 (if (<= (cadr cpt) (cadr tpt)) (nth 0 a1) (nth 2 a1))));if
	 (vlax-for ln ass	 
	   (setq sp (cond ((= (vla-get-ObjectName ln) "AcDbLine") (vlax-get ln 'StartPoint))
			  ((= (vla-get-ObjectName ln) "AcDbPolyline")
			   (vlax-curve-getPointAtParam ln (fix (vlax-curve-getParamAtPoint ln
						(vlax-curve-getClosestPointTo ln cpt))))));cond
		 sx (car sp) sy (cadr sp) tln (pct:getxdt ln);tline
		 clst (cond ((= hor 1) (cons (cons sy tln) clst))
			    ((= hor 0) (cons (cons sx tln) clst))));setq
	 );vlax-for
	 (setq clst (vl-sort clst '(lambda (e1 e2) (> (car e1) (car e2))))
	       cmax (caar clst) cmin (caar (reverse clst)))
	 (while clst (setq txt (cond ((= hor 1) (strcat txt (cdr (car clst)) "\\P"))
				     ((= hor 0) (strcat (cdr (car clst)) "\\P" txt)))
			   clst (cdr clst)));while
	 (setq txt (vl-string-right-trim "\\P" txt))
	 (setq mtxt (vla-addMtext csp (vlax-3d-point tpt) 0 txt))
	 (vla-put-Height mtxt ht)
	 (if (< (car cpt) (car tpt))
	   (progn (vla-put-AttachmentPoint mtxt 4) (setq a2 1.5708))
	   (progn (vla-put-AttachmentPoint mtxt 6) (setq a2 4.71239)));if
	 (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list bks "SPN011")))
	   (vla-delete (vla-insertBlock csp (vlax-3d-point cpt)
			 "C:\\IES\\Design Center\\SPN011.dwg" 1 1 1 0)));if
	 (setq pl (vla-item (vla-item bks "SPN011") 0)
	       l (+ (- cmax cmin) (/ 0.125 sc))
	       scx (/ l (- (vlax-curve-getDistAtParam pl 2) (vlax-curve-getDistAtParam pl 1))));setq
	 (setq cpt (subst (/ (+ cmax cmin) 2) (if (= hor 1) (cadr cpt) (car cpt)) cpt))
	 (vla-insertblock csp (vlax-3d-point cpt) "SPN011" scx (/ 1 sc) 1 a1)
	 (setq bpt (cond ((= hor 1) (subst (ofs (cadr cpt) (cadr tpt)) (cadr cpt) cpt))
			 ((= hor 0) (subst (ofs (car cpt) (car tpt)) (car cpt) cpt)))
	       eh nil) (pct:leader bpt tpt)
	 (vla-insertblock csp (vlax-3d-point (cdddr (vlax-get ld 'Coordinates)))
	   "SPN011" (/ (+ cnt 1) sc) (/ 1 sc) 1 a2)
	);>1
    );cond
  (mapcar '(lambda (x y) (setvar x y)) '("SNAPMODE" "ORTHOMODE") vls)  
);end

Да, примененные блоки скину позже вместе со второй прогой.

pyatifan · 18.04.2006, 23:21

В свете выглядывающих граблей, кои я заметил недавно в виде проблемы унификации под en и ru языки...просьба: по возможности учесть локализацию. Уже в ожидании...у меня тож планы на применение в своих нуждах-остальное я по возможности прогну

Pave1 · 19.04.2006, 09:13

Посмотрел лисп.
Вроде бы то что надо, но у меня не прорисовались линии выноски.
Это почему у меня так? Или они не должны прорисовываться?
А вот запрос в начале и конце надписи мне понравился :)
Как-раз, в начале надо писать название трассы, а в конце ее длину.
Только вот длину и название хочется в виде поля, чтобы менялись в случае изменения линии.

Лентяй · 19.04.2006, 13:49

Обещанная программа редактирования выносок и блоки к ней.

Код:

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

 defun *error* (msg)
  (if (= msg "Function cancelled") (princ msg)(princ));if
  (setvar "OSMODE" sn) (setvar "CMDECHO" cm) (vla-update br) (vla-update txt0)  
);*error*
;
(defun selobj (str / obj)
  (if (not (vl-catch-all-error-p (vl-catch-all-apply 
      '(lambda () (vla-getentity util 'obj nil (strcat "Select Callout " str ":"))))));not
  obj
  (progn (alert "Nothibg Selected. Try Again!") (selobj str)))
);selobj
;
(defun getxdt (obj / vls xdt)
  (vla-GetXData obj "INFO" 'xtp 'xdv)
  (if xdv (progn (setq vls (mapcar '(lambda (x) (vlax-variant-value x))
                             (cdr (vlax-safearray->list xdv))));setq
            (strcat (car vls) "-" (cadr vls) "(" (caddr vls) ")")) nil);if
);defun
;
(defun C:COTUPD ( / sm om br oss tx txt hor kw xp tln clst sz serv obj xtp xdv tbrp)
  (setq	adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	sm (getvar "SNAPMODE") om (getvar "ORTHOMODE") tx ""
	util (vla-get-utility adoc)
        sss (vla-get-SelectionSets adoc)
        oss (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list sss "OSS")))
              (vla-add sss "OSS") (vla-item sss "OSS")));setq
  (vla-highlight (setq br (selobj "Bracket")) t)
  (vla-highlight (setq txt0 (selobj "Text")) t)
  (vla-getBoundingBox br 'pn 'px)
  (vla-select oss acSelectionSetCrossing (vlax-make-variant pn) (vlax-make-variant px))
  (setq hor (if (vl-member-if '(lambda (x) (= (vla-get-rotation br) x)) '(0 pi)) 0 1)
        txt (vla-get-TextString txt0));setq
  (initget "Data Text") (setq kw (getkword "\n Update [Data/Text]: ? <Data>"))
  (if (null kw) (setq kw "Data"))
  (vlax-for ln oss
    (if (or (= (vla-get-ObjectName ln) "AcDbLine") (= (vla-get-ObjectName ln) "AcDbPolyline"));or
      (setq xp (vlax-invoke br "IntersectWith" ln acExtendNone)
            clst (cons (cons (cond ((= hor 1) (cadr xp)) ((= hor 0) (car xp)))
                             (if (= kw "Data") (vla-get-ObjectID ln) (getxdt ln))) clst))));vlax-for
  (setq clst (vl-sort clst (cond ((= hor 0)'(lambda (e1 e2) (< (car e1) (car e2))))
                                 ((= hor 1)'(lambda (e1 e2) (> (car e1) (car e2)))))))
  (while clst (if (= kw "Data")
      (progn (setq obj (vla-ObjectIDtoObject adoc (cdar clst)))
        (vla-GetXData obj "INFO" 'xtp 'xd)
        (setq tln (vl-string-right-trim ")" (substr txt 1 (vl-string-search "\\" txt)))
              sz (substr tln 1 (vl-string-search "-" tln))
              serv (vl-string-left-trim (strcat sz "-") (substr tln 1 (vl-string-search "(" tln)))
              xdv (vlax-safearray-fill (vlax-make-safearray vlax-vbVariant '(0 . 3))
                    (mapcar '(lambda (x) (vlax-make-variant x vlax-vbString))
                      (list "INFO" sz serv (vl-string-left-trim (strcat sz "-" serv "(") tln))));xdv
              xtp (if (null xtp) (vlax-make-variant (vlax-safearray-fill
		     (vlax-make-safearray vlax-vbInteger '(0 . 3)) '(1001 1000 1000 1000))) xtp));setq
        (vla-SetXData obj xtp xdv)
        (setq tbrp (vl-string-search "\\" txt)
              txt (if tbrp (substr txt (+ 3 tbrp)))
              clst (cdr clst)));progn
      (progn (setq tx (if (null tx) (strcat (cdar clst) "\\P") (strcat tx (cdar clst) "\\P"));if
                   clst (cdr clst)))));while
  (if (= kw "Text") (vla-put-textstring txt0 tx))
  (vla-update br) (vla-update txt0) (vla-clear oss) (vlax-release-object oss)  
  (setvar "SNAPMODE" sm) (setvar "ORTHOMODE" om)
);end

[ATTACH]1145440184.dwg[/ATTACH]

Лентяй · 19.04.2006, 14:00

Цитата:

Сообщение от Pave1

Посмотрел лисп.
Вроде бы то что надо, но у меня не прорисовались линии выноски.
Это почему у меня так? Или они не должны прорисовываться?.

Не должны, потому как у вас не было блока "скобки", к которому линия выноски пристегивается.

Два слова о работе прграмм. На девственном чертеже запускаем PCT. Эта прграмма формирует информацию о трубе (размер-назначение-материал), замисывает ее в расширенные данные примитива и отрисовывает первую группу выноска-текст. Следующие группы фоормируются сами на оснвании расширенных данных примитива.
Если требуется отредактировать существующий чертеж, то запускается программа COTUPD. Она работает в обе стороны, т.е. приводит расширенные данные в соответсвтие с измененным текстом выноски или изменяет текст выносок (ВСЕХ) в соответсвии с измененными расширенными данными.
Если у кого вопросы - кричите нечеловеческим голосом.

fixo · Регистрация: 24.03.2005

Цитата:

Сообщение от Pave1

Для тех кто умеет писать лиспы это наверное не сложная задачка, а мне, да и другим проектировщикам занимающимся электрикой, пригодился бы вот такой лисп:
1. указываешь линию (отрезок/полилинию/3D полилинию);
2. место вставки.
А лисп за тебя прописывает в получившейся сноске название слоя, к которому относится линия, и хорошо бы еще название слоя было в виде поля (field), чтобы если вдруг захочется изменить слой линии, надпись менялась и соответствовала новому слою.

А может у кого-нибудь уже есть что-нибудь подобное?
Буду признателен.

Что-то подобное есть
Данные после изменения слоя будут графически
обновляться после регенерации рисунка (regenall)

Код:

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

(defun C:LF (/ acsp adoc ent mtx p1 p2 pline txt)
  (vl-load-com)
  (or adoc
      (setq adoc
	     (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
      )
  )
  (if (and
	(= (getvar "tilemode") 0)
	(= (getvar "cvport") 1)
      )
    (setq acsp (vla-get-paperspace adoc))
    (setq acsp (vla-get-modelspace adoc))
  )
  (setq
    pline (vlax-ename->vla-object
	    (car (setq ent (entsel "\n >> Выбрать полилинию >> \n")))
	  )
  )
  (setq	txt
	 (strcat
	   "%<\\AcObjProp Object(%<\\_ObjId "
	   (itoa (vla-get-objectid pline))
	   ">%).Layer >%"
	 )
  )
  (setq	p1 (cadr ent)
	p2 (getpoint p1 "\nВторая точка >> \n")
  )
  (setq	mtx (vlax-invoke
	      acsp 'AddMText p2	0.0 txt)
  )
  (vlax-put mtx
	    'AttachmentPoint
	    (cond ((> (car p1) (car p2))
		   acAttachmentPointMiddleRight
		  )
		  ((< (car p1) (car p2))
		   acAttachmentPointMiddleLeft
		  )
		  (T acAttachmentPointMiddleLeft)
	    )
  )

  (vlax-invoke
    acsp
    'Addleader
    (apply 'append (list p1 p2))
    mtx
    acLineWithArrow
  )
  (vl-catch-all-apply
    (function (lambda ()
		(progn
		  (vlax-release-object mtx)
		  (vlax-release-object pline)
		)
	      )
    )
  )
  (vla-regen adoc acactiveviewport)
  (princ)
)
(prompt "\n")
(prompt "\t\t<<< Ввести LF для старта программы :  >>>  \n")
(princ)
; TesT : (C:LF)

~'J'~

kabzzz · 19.04.2006, 14:41

а в 2006 работает?
Лентяй, не мог бы для нумбов описать в комплексе процедуру установки. Например: копируем текст с топика в файл, сохраняем ка бла бла бла? Буду очень признателен.

pyatifan · 19.04.2006, 16:53

Нифига не хочет раьотать...пишет:
"ошибка: no function definition: MSG"
У меня тож Autocad 2006, ток русский. Мож изза этого (я выше вроде просил учесть локализацию). Вообще в лиспе не рублю. Но усмотрел, что есть конкатанация, вроде сообщение должно вылетать в виде окна...первый раз такое встречаю, ато заставляют пялиться в комстроку.
kabzzz, а тут всё как обычно:
В коде есть строка
C:COTUPD

вот в ком строке и нужно набирать COTUPD.
Заранее прошу не пинать, если что-то сморозил...но хочется работоспособную программу.

Кулик Алексей aka kpblc · 19.04.2006, 17:45

Гы, помянули? Расхлебывайте

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

Тады вот такое можно:

Код:

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

;|=============================================================================
*    Рисование выноски.
=============================================================================|;
(defun c:kpblc_lead (/
		     kpblc-error-restore-sysvar
		     kpblc-error-save-sysvar
		     *error*
		     _kpblc-draw-leader
		     _kpblc-get-active-space-obj
		     _kpblc-draw-leader-change-points
		     _kpblc-draw-leader-change-points-by-ent
		     *kpblc-activedoc*
		     lead_start_point
		     lead_end_point
		     cur_scale
		     leader_obj
		     obj
		     ;| lead_obj	    leader_type	 up_string
			  low_string   dlg_ok	    dlg_id	 cur_scale
			  circle_rad   *error*	    ent_circle	 start_point
			  end_point    add_point    ann_obj	 selset
			  minp	       maxp|;
		     )

  ;; Локальные функции

  ;|=============================================================================
*    Конвертация списка точек вида ((0.0 0.0 0.0) (10.0 10.0 0.0) ...) в массив
* для передачи в activeX рисование объектов.
*    Параметры вызова:
*	point-list	список точек. Не может быть nil.
*    Примеры вызова:
(_kpblc-conv-pointlist-to-variant (apply 'append (list '(0.0 0.0 0.0) '(10.0 10.0 0.0)))
=============================================================================|;
  (defun _kpblc-conv-pointlist-to-variant (point-list / safe_list result)
    (setq safe_list (vlax-make-safearray
		      vlax-vbdouble
		      (cons 0 (1- (length point-list)))
		      ) ;_ end of vlax-make-safearray
	  ) ;_ end of setq
    (setq result (vlax-safearray-fill safe_list point-list))
    (vlax-make-variant result)
    ) ;_ end of defun


  ;|=============================================================================
*    Функция отрисовки выноски с многострочным текстом. Возвращает vla-указатель
* на созданный объект.
*    Параметры вызова:
*	up-string	верхняя строка выноски. Не может быть nil.
*	low-string	нижняя строка выноски. Может быть nil, "". В таком
*			случае выполняется выноска с 1 строкой.
*	start-point	начальная точка выноски. Не nil.
*	end-point	конечная точка выноски. Не nil.
*    Примеры вызова:
(_kpblc-draw-leader "text1" "text2" st end)
=============================================================================|;
  (defun _kpblc-draw-leader (up-string	  low-string   start-point
			     end-point	  /	       lead_obj
			     ann_obj
			     )
    ;; Прежде всего преобразовываем low-string в строковый вид:
    (if	(not low-string)
      (setq low-string "")
      ) ;_ end of if
    ;; Теперь собственно выполнение выноски.
    (setq ann_obj  (vla-addmtext
		     (_kpblc-get-active-space-obj)
		     (vlax-3d-point end-point)
		     0			; устанавливается ширина именно 0,
					; для нормального получения полки
		     (if (/= low-string "")
		       (strcat up-string "\\P" low-string)
		       up-string
		       ) ;_ end of if
		     ) ;_ end of vla-AddMText
	  lead_obj (vla-addleader
		     (_kpblc-get-active-space-obj)
		     (_kpblc-conv-pointlist-to-variant
		       (apply 'append (list start-point end-point))
		       ) ;_ end of _kpblc-conv-pointlist-to-variant
		     ann_obj
		     aclinewitharrow
		     ) ;_ end of vla-AddLeader
	  ) ;_ end of setq
    ;; Меняем настройки будущей аннотации:
    (vla-put-height ann_obj (* 2.5 (getvar "dimscale")))
    (vla-put-attachmentpoint
      ann_obj
      ;; Назначая точку выравнивания, будем использовать числовые значения:
      ;; acAttachmentPointBottomLeft	->	7
      ;; acAttachmentPointBottomRight	->	9
      ;; acAttachmentPointMiddleLeft	->	4
      ;; acAttachmentPointMiddleRight	->	6
      (+ 4
	 (if (> (car end-point) (car start-point))
					; выноска вправо, точка - влево
	   0
	   2
	   ) ;_ end of if
	 (if (/= low-string "")		; нижняя строка есть, выр. - по
					; центру
	   0
	   3
	   ) ;_ end of if
	 ) ;_ end of +
      ) ;_ end of vla-put-AttachmentPoint
    (vla-put-insertionpoint ann_obj (vlax-3d-point end-point))
    ;; Теперь модицифируем собственно выноску
    (vla-put-verticaltextposition lead_obj acabove)
    ;; В принципе, строка ниже не требуется - так, для страховки.
    (vla-put-coordinate lead_obj 1 (vlax-3d-point end-point))
    lead_obj
    ) ;_ end of defun

  ;|=======================================================================================
*    Функция возвращает vla-активное пространство (лист / модель). 
*    Параметры вызова:
*	Нет
*    Примеры вызова:
(_kpblc-get-active-space-obj)
=======================================================================================|;
  (defun _kpblc-get-active-space-obj ()
    (if	(and (zerop (vla-get-activespace *kpblc-activedoc*))
	     (= :vlax-false (vla-get-mspace *kpblc-activedoc*))
	     ) ;_ end of and
      (vla-get-paperspace *kpblc-activedoc*)
      (vla-get-modelspace *kpblc-activedoc*)
      ) ;_ end of if
    ) ;_ end of defun

  ;|=============================================================================
*    Восстанавливаются системные переменные. Значения системных переменных
* должны храниться в глобальном списке *kpblc-sysvar-list*. Если списка нет
* (nil), происходит просто выход.
*    Параметры вызова:
*	Нет
*    Примеры вызова:
(kpblc-error-restore-sysvar)
=============================================================================|;
  (defun kpblc-error-restore-sysvar ()
    (if	*kpblc-sysvar-list*
      (foreach item *kpblc-sysvar-list*
	(if (or	(vl-catch-all-error-p
		  (vl-catch-all-apply 'setvar (list (car item) (cadr item)))
		  ) ;_ end of vl-catch-all-error-p
		(= (cadr item) "")
		(wcmatch (strcase (car item) r) "dim*")
		) ;_ end of and
	  (setvar (car item) ".")
	  (setvar (car item) (cadr item))
	  ) ;_ end of if
	) ;_ end of foreach
      ) ;_ end of if
    (setq *kpblc-sysvar-list* nil)
    (gc)
    ) ;_ end of defun

  ;|=======================================================================================
*    Сохраняется текущее значение системных переменных. Список глобальный (*kpblc-sysvar-list*)
* При условии, что заданы значения, они устанавливаются.
*    Поскольку список *kpblc-sysvar-list* не обнуляется, в нем хранится история изменения
* значений переменных.
*    Слизано с ruCAD с небольшой переделкой на случай замены размерных системных
* переменных - там невозможно восстановить значение "", надо устанавливать "."
*    Параметры вызова:
*	*kpblc-sysvar-list*	список системных переменных, состояние которых надо сохранить.
*			Список состоит из подсписков (Переменная Значение)
*			В списке могут повторяться переменные. В таком случае будет
*			установлено последнее значение.
*			Если в качестве второго параметра используется nil, то значение
*			системной переменной просто сохраняется.
*    Примеры вызова:
(kpblc-error-sysvar-list (list '("cmdecho" 0) '("blipmode") '("osmode" 503)))
=======================================================================================|;
  (defun kpblc-error-save-sysvar (sysvar-list)
    (foreach item sysvar-list
      (setq *kpblc-sysvar-list*
	     (cons
	       (list (car item) (getvar (car item)))
	       *kpblc-sysvar-list*
	       ) ;_ end of cons
	    ) ;_ end of setq	
      (if (cadr item)			; передано устанавливаемое значение
	(if (and (vl-catch-all-error-p
		   (vl-catch-all-apply 'setvar (list (car item) (cadr item)))
		   ) ;_ end of VL-CATCH-ALL-ERROR-P
		 (= (cadr item) "")
		 (wcmatch (strcase (car item) t) "dim*")
		 ) ;_ end of and
	  (setvar (car item) ".")
	  (setvar (car item) (cadr item))
	  ) ;_ end of if
	) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of defun

  (defun *error* (msg)
    (if	ent_circle
      (entdel (ent_circle))
      ) ;_ end of if
    (vla-endundomark *kpblc-activedoc*)
    (princ msg)
    (princ)
    ) ;_ end of defun

  ;; Конец локальных функций

  (vl-load-com)
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark *kpblc-activedoc*)
  (if
    (and
      (setq cur_scale (getvar "dimscale"))
      (setq object (entsel "\nУкажите обрабатываемый объект <Выход> : "))
      (setq lead_start_point
	     (cadr object)
	    object (car object)
	    )				; (getpoint "\nНачальная точка
					; выноски
					; <Выход> :
					; "))
      (setq lead_end_point
	     (getpoint lead_start_point
		       "\nКонечная точка выноски <Выход> : "
		       ) ;_ end of getpoint
	    ) ;_ end of setq
      ) ;_ end of and
     (progn
       (setq leader_obj
	      (_kpblc-draw-leader
		(strcat
		  "%<\\AcObjProp Object(%<\\_ObjId "
		  (itoa (vla-get-objectid (vlax-ename->vla-object object)))
		  ">%).Layer >%"
		  ) ;_ end of strcat
		lowstring
		lead_start_point
		lead_end_point
		) ;_ end of _kpblc-draw-leader
	     ) ;_ end of setq
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark *kpblc-activedoc*)
  ) ;_ end of defun

Кулик Алексей aka kpblc · 19.04.2006, 18:03

А вот для Лентяя, я думаю, уже понадобятся и реакторы. В частности, на *text* команды - если редактируемый текст является аннотацией (определяется по 330 группе, по-моему), и аннотация началом лежит на каком-то примитиве, то тогда менять расширенные данные. Хотя я бы сейчас, наверное, делал не РД, а словари (которые vlax-ldata - там нет таких ограничений на структуру, как в РД). Хотя... РД тоже могут оказаться незаменимыми.

pyatifan · 19.04.2006, 18:09

Цитата:

Уверен этот хороший человек не останется равнодушным и в конце темы мы будем иметь ещё один удобный инструмент

Спасибо! А в поле как раз можно что запихнуть что надо! Прямо как в сказке...именно этого и хотелось

Кулик Алексей aka kpblc · 19.04.2006, 18:17

Должен сказать о некоторых тонкостях работы функции (если она пойдет дальше

)
- отрисовка ведется на текущем слое, с текущим текстовым и размерным стилем
- для выноски напрямую назначается "указатель" - заполненная стрелка. Если надо другое, то надо изменить строку aclinewitharrow на ту, которую надо (см.хелп).
- Начальная точка выноски определяется не совсем правильно - она не лежит на объекте, а находится рядом, точно там, где щелкнули при указании объекта. По идее можно устанавливать принудительную привязку osmode в 512, но я не стал этого делать - грубо говоря, поленился.
Вроде как все...

DEM · 20.04.2006, 08:32 **Привет**

КРЫС а то же самое но со считыванием атрибута блока с именем TXT 0

Лентяй · 20.04.2006, 09:30

Цитата:

Сообщение от kpblc

А вот для Лентяя, я думаю, уже понадобятся и реакторы. В частности, на *text* команды - если редактируемый текст является аннотацией (определяется по 330 группе, по-моему), и аннотация началом лежит на каком-то примитиве, то тогда менять расширенные данные. Хотя я бы сейчас, наверное, делал не РД, а словари (которые vlax-ldata - там нет таких ограничений на структуру, как в РД). Хотя... РД тоже могут оказаться незаменимыми.

Какие такие реакторы? Не надо нам никаих реаторов, у нас и так все прекрасно взрывается [sm3321]
А ежели серьезно, то аннотация привязывается к стрелке-выноске. И менять, в смысле редактировать ее можно, как обычный текст. Потм уже это исзменение можно перетаскивать в РД с последующим update-ом всех прочих ссылок на эти РД. Это можно сделать как моей прогой COTUPD, так и, не к ночи будь помянут, реактором.

Кулик Алексей aka kpblc · 20.04.2006, 16:05

> DEM : не очень понял. Что, в блоке есть атрибут с тэгом TXT? Если да, то попробуй

Код:

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

;|=============================================================================
*    Рисование выноски.
=============================================================================|;
(defun c:kpblc_lead (/				  kpblc-error-restore-sysvar
		     kpblc-error-save-sysvar	  *error*
		     _kpblc-draw-leader		  _kpblc-get-active-space-obj
		     _kpblc-draw-leader-change-points
		     _kpblc-draw-leader-change-points-by-ent
		     *kpblc-activedoc*		  lead_start_point
		     lead_end_point		  cur_scale
		     leader_obj			  obj
		     attr
		     ;| lead_obj       leader_type    up_string
           low_string   dlg_ok       dlg_id    cur_scale
           circle_rad   *error*       ent_circle    start_point
           end_point    add_point    ann_obj    selset
           minp          maxp|;
		     )

  ;; Локальные функции

  ;|=============================================================================
*    Конвертация списка точек вида ((0.0 0.0 0.0) (10.0 10.0 0.0) ...) в массив
* для передачи в activeX рисование объектов.
*    Параметры вызова:
*   point-list   список точек. Не может быть nil.
*    Примеры вызова:
(_kpblc-conv-pointlist-to-variant (apply 'append (list '(0.0 0.0 0.0) '(10.0 10.0 0.0)))
=============================================================================|;
  (defun _kpblc-conv-pointlist-to-variant (point-list / safe_list result)
    (setq safe_list (vlax-make-safearray
		      vlax-vbdouble
		      (cons 0 (1- (length point-list)))
		      ) ;_ end of vlax-make-safearray
	  ) ;_ end of setq
    (setq result (vlax-safearray-fill safe_list point-list))
    (vlax-make-variant result)
    ) ;_ end of defun


  ;|=============================================================================
*    Функция отрисовки выноски с многострочным текстом. Возвращает vla-указатель
* на созданный объект.
*    Параметры вызова:
*   up-string   верхняя строка выноски. Не может быть nil.
*   low-string   нижняя строка выноски. Может быть nil, "". В таком
*         случае выполняется выноска с 1 строкой.
*   start-point   начальная точка выноски. Не nil.
*   end-point   конечная точка выноски. Не nil.
*    Примеры вызова:
(_kpblc-draw-leader "text1" "text2" st end)
=============================================================================|;
  (defun _kpblc-draw-leader (up-string	  low-string   start-point
			     end-point	  /	       lead_obj
			     ann_obj
			     )
    ;; Прежде всего преобразовываем low-string в строковый вид:
    (if	(not low-string)
      (setq low-string "")
      ) ;_ end of if
    ;; Теперь собственно выполнение выноски.
    (setq ann_obj  (vla-addmtext
		     (_kpblc-get-active-space-obj)
		     (vlax-3d-point end-point)
		     0			; устанавливается ширина именно 0,
					; для нормального получения полки
		     (if (/= low-string "")
		       (strcat up-string "\\P" low-string)
		       up-string
		       ) ;_ end of if
		     ) ;_ end of vla-AddMText
	  lead_obj (vla-addleader
		     (_kpblc-get-active-space-obj)
		     (_kpblc-conv-pointlist-to-variant
		       (apply 'append (list start-point end-point))
		       ) ;_ end of _kpblc-conv-pointlist-to-variant
		     ann_obj
		     aclinewitharrow
		     ) ;_ end of vla-AddLeader
	  ) ;_ end of setq
    ;; Меняем настройки будущей аннотации:
    (vla-put-height ann_obj (* 2.5 (getvar "dimscale")))
    (vla-put-attachmentpoint
      ann_obj
      ;; Назначая точку выравнивания, будем использовать числовые значения:
      ;; acAttachmentPointBottomLeft   ->   7
      ;; acAttachmentPointBottomRight   ->   9
      ;; acAttachmentPointMiddleLeft   ->   4
      ;; acAttachmentPointMiddleRight   ->   6
      (+ 4
	 (if (> (car end-point) (car start-point))
					; выноска вправо, точка - влево
	   0
	   2
	   ) ;_ end of if
	 (if (/= low-string "")		; нижняя строка есть, выр. - по
					; центру
	   0
	   3
	   ) ;_ end of if
	 ) ;_ end of +
      ) ;_ end of vla-put-AttachmentPoint
    (vla-put-insertionpoint ann_obj (vlax-3d-point end-point))
    ;; Теперь модицифируем собственно выноску
    (vla-put-verticaltextposition lead_obj acabove)
    ;; В принципе, строка ниже не требуется - так, для страховки.
    (vla-put-coordinate lead_obj 1 (vlax-3d-point end-point))
    lead_obj
    ) ;_ end of defun

  ;|=======================================================================================
*    Функция возвращает vla-активное пространство (лист / модель).
*    Параметры вызова:
*   Нет
*    Примеры вызова:
(_kpblc-get-active-space-obj)
=======================================================================================|;
  (defun _kpblc-get-active-space-obj ()
    (if	(and (zerop (vla-get-activespace *kpblc-activedoc*))
	     (= :vlax-false (vla-get-mspace *kpblc-activedoc*))
	     ) ;_ end of and
      (vla-get-paperspace *kpblc-activedoc*)
      (vla-get-modelspace *kpblc-activedoc*)
      ) ;_ end of if
    ) ;_ end of defun

  ;|=============================================================================
*    Восстанавливаются системные переменные. Значения системных переменных
* должны храниться в глобальном списке *kpblc-sysvar-list*. Если списка нет
* (nil), происходит просто выход.
*    Параметры вызова:
*   Нет
*    Примеры вызова:
(kpblc-error-restore-sysvar)
=============================================================================|;
  (defun kpblc-error-restore-sysvar ()
    (if	*kpblc-sysvar-list*
      (foreach item *kpblc-sysvar-list*
	(if (or	(vl-catch-all-error-p
		  (vl-catch-all-apply 'setvar (list (car item) (cadr item)))
		  ) ;_ end of vl-catch-all-error-p
		(= (cadr item) "")
		(wcmatch (strcase (car item) r) "dim*")
		) ;_ end of and
	  (setvar (car item) ".")
	  (setvar (car item) (cadr item))
	  ) ;_ end of if
	) ;_ end of foreach
      ) ;_ end of if
    (setq *kpblc-sysvar-list* nil)
    (gc)
    ) ;_ end of defun

  ;|=======================================================================================
*    Сохраняется текущее значение системных переменных. Список глобальный (*kpblc-sysvar-list*)
* При условии, что заданы значения, они устанавливаются.
*    Поскольку список *kpblc-sysvar-list* не обнуляется, в нем хранится история изменения
* значений переменных.
*    Слизано с ruCAD с небольшой переделкой на случай замены размерных системных
* переменных - там невозможно восстановить значение "", надо устанавливать "."
*    Параметры вызова:
*   *kpblc-sysvar-list*   список системных переменных, состояние которых надо сохранить.
*         Список состоит из подсписков (Переменная Значение)
*         В списке могут повторяться переменные. В таком случае будет
*         установлено последнее значение.
*         Если в качестве второго параметра используется nil, то значение
*         системной переменной просто сохраняется.
*    Примеры вызова:
(kpblc-error-sysvar-list (list '("cmdecho" 0) '("blipmode") '("osmode" 503)))
=======================================================================================|;
  (defun kpblc-error-save-sysvar (sysvar-list)
    (foreach item sysvar-list
      (setq *kpblc-sysvar-list*
	     (cons
	       (list (car item) (getvar (car item)))
	       *kpblc-sysvar-list*
	       ) ;_ end of cons
	    ) ;_ end of setq   
      (if (cadr item)			; передано устанавливаемое значение
	(if (and (vl-catch-all-error-p
		   (vl-catch-all-apply 'setvar (list (car item) (cadr item)))
		   ) ;_ end of VL-CATCH-ALL-ERROR-P
		 (= (cadr item) "")
		 (wcmatch (strcase (car item) t) "dim*")
		 ) ;_ end of and
	  (setvar (car item) ".")
	  (setvar (car item) (cadr item))
	  ) ;_ end of if
	) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of defun

  (defun *error* (msg)
    (if	ent_circle
      (entdel (ent_circle))
      ) ;_ end of if
    (vla-endundomark *kpblc-activedoc*)
    (princ msg)
    (princ)
    ) ;_ end of defun

  ;; Конец локальных функций

  (vl-load-com)
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark *kpblc-activedoc*)
  (if
    (and
      (setq cur_scale (getvar "dimscale"))
      (setq object (entsel "\nУкажите обрабатываемый объект <Выход> : "))
      (setq lead_start_point
			     (cadr object)
	    object	     (vlax-ename->vla-object (car object))
	    )				; (getpoint "\nНачальная точка
					; выноски
					; <Выход> :
					; "))
      (setq lead_end_point
	     (getpoint lead_start_point
		       "\nКонечная точка выноски <Выход> : "
		       ) ;_ end of getpoint
	    ) ;_ end of setq
      ) ;_ end of and
     (progn
       (cond
	 ((and (= (strcase (vla-get-objectname object) t) "acdbblockreference")
	       (= (vla-get-hasattributes object) :vlax-true)
	       (setq
		 attr (vl-remove-if
			'(lambda (x) (/= (strcase (vla-get-tagstring x) t) "txt"))
			(vlax-safearray->list
			  (vlax-variant-value (vla-getattributes object))
			  ) ;_ end of vlax-safearray->list
			) ;_ end of vl-remove-if
		 ) ;_ end of setq
	       ) ;_ end of and
	  (setq	leader_obj
		 (_kpblc-draw-leader
		   (strcat
		     "%<\\AcObjProp Object(%<\\_ObjId "
		     (itoa (vla-get-objectid (car attr)))
		     ">%).TextString>%"
		     ) ;_ end of strcat
		   lowstring
		   lead_start_point
		   lead_end_point
		   ) ;_ end of _kpblc-draw-leader
		) ;_ end of setq
	  )
	 (t
	  (setq	leader_obj
		 (_kpblc-draw-leader
		   (strcat
		     "%<\\AcObjProp Object(%<\\_ObjId "
		     (itoa (vla-get-objectid object))
		     ">%).Layer >%"
		     ) ;_ end of strcat
		   lowstring
		   lead_start_point
		   lead_end_point
		   ) ;_ end of _kpblc-draw-leader
		) ;_ end of setq
	  )
	 ) ;_ end of cond
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark *kpblc-activedoc*)
  ) ;_ end of defun

> Лентяй : Так а зачем использовать стороннюю функцию, если использование командного реактора на редактирование многострочного текста (с соответствующей проработкой) позволит сразу провернуть изменение РД для примитивов? С другой стороны, это просто вопрос вкуса и привычки, я думаю

pyatifan · 20.04.2006, 22:30

Как-то не понятно: в коде куча примеров вызова...или тока один "kpblc_lead" должен работать? Вроде привязки должны срабатывать чтоли ("osmode" 503). Руководство пользователя хотелось увидеть

В Kitox'е как-то удобней всётки.

Кулик Алексей aka kpblc · 21.04.2006, 08:19

Ну дык функция с с: одна - вот ее и вызывать, остальное - мои библиотечные, не хотел их переделывать.
Краткий мануал: Клик на объекте. Клик на новой точке (там будет строиться полка выноски). Если объект блок содержит атрибут "txt", то в тексте будет значение атрибута, в любом другом случае - слой, на котором лежит выбранный примитив.
Кстати, подправленный код (с изменением osmode):

Код:

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

;|=============================================================================
*    Рисование выноски.
=============================================================================|;
(defun c:kpblc_lead (/				  kpblc-error-restore-sysvar
		     kpblc-error-save-sysvar	  *error*
		     _kpblc-draw-leader		  _kpblc-get-active-space-obj
		     _kpblc-draw-leader-change-points
		     _kpblc-draw-leader-change-points-by-ent
		     *kpblc-activedoc*		  lead_start_point
		     lead_end_point		  cur_scale
		     leader_obj			  obj
		     attr
		     )

  ;; Локальные функции

  ;|=============================================================================
*    Конвертация списка точек вида ((0.0 0.0 0.0) (10.0 10.0 0.0) ...) в массив
* для передачи в activeX рисование объектов.
*    Параметры вызова:
*   point-list   список точек. Не может быть nil.
*    Примеры вызова:
(_kpblc-conv-pointlist-to-variant (apply 'append (list '(0.0 0.0 0.0) '(10.0 10.0 0.0)))
=============================================================================|;
  (defun _kpblc-conv-pointlist-to-variant (point-list / safe_list result)
    (setq safe_list (vlax-make-safearray
		      vlax-vbdouble
		      (cons 0 (1- (length point-list)))
		      ) ;_ end of vlax-make-safearray
	  ) ;_ end of setq
    (setq result (vlax-safearray-fill safe_list point-list))
    (vlax-make-variant result)
    ) ;_ end of defun


  ;|=============================================================================
*    Функция отрисовки выноски с многострочным текстом. Возвращает vla-указатель
* на созданный объект.
*    Параметры вызова:
*   up-string   верхняя строка выноски. Не может быть nil.
*   low-string   нижняя строка выноски. Может быть nil, "". В таком
*         случае выполняется выноска с 1 строкой.
*   start-point   начальная точка выноски. Не nil.
*   end-point   конечная точка выноски. Не nil.
*    Примеры вызова:
(_kpblc-draw-leader "text1" "text2" st end)
=============================================================================|;
  (defun _kpblc-draw-leader (up-string	  low-string   start-point
			     end-point	  /	       lead_obj
			     ann_obj
			     )
    ;; Прежде всего преобразовываем low-string в строковый вид:
    (if	(not low-string)
      (setq low-string "")
      ) ;_ end of if
    ;; Теперь собственно выполнение выноски.
    (setq ann_obj  (vla-addmtext
		     (_kpblc-get-active-space-obj)
		     (vlax-3d-point end-point)
		     0			; устанавливается ширина именно 0,
					; для нормального получения полки
		     (if (/= low-string "")
		       (strcat up-string "\\P" low-string)
		       up-string
		       ) ;_ end of if
		     ) ;_ end of vla-AddMText
	  lead_obj (vla-addleader
		     (_kpblc-get-active-space-obj)
		     (_kpblc-conv-pointlist-to-variant
		       (apply 'append (list start-point end-point))
		       ) ;_ end of _kpblc-conv-pointlist-to-variant
		     ann_obj
		     aclinewitharrow
		     ) ;_ end of vla-AddLeader
	  ) ;_ end of setq
    ;; Меняем настройки будущей аннотации:
    (vla-put-height ann_obj (* 2.5 (getvar "dimscale")))
    (vla-put-attachmentpoint
      ann_obj
      ;; Назначая точку выравнивания, будем использовать числовые значения:
      ;; acAttachmentPointBottomLeft   ->   7
      ;; acAttachmentPointBottomRight   ->   9
      ;; acAttachmentPointMiddleLeft   ->   4
      ;; acAttachmentPointMiddleRight   ->   6
      (+ 4
	 (if (> (car end-point) (car start-point))
					; выноска вправо, точка - влево
	   0
	   2
	   ) ;_ end of if
	 (if (/= low-string "")		; нижняя строка есть, выр. - по
					; центру
	   0
	   3
	   ) ;_ end of if
	 ) ;_ end of +
      ) ;_ end of vla-put-AttachmentPoint
    (vla-put-insertionpoint ann_obj (vlax-3d-point end-point))
    ;; Теперь модицифируем собственно выноску
    (vla-put-verticaltextposition lead_obj acabove)
    ;; В принципе, строка ниже не требуется - так, для страховки.
    (vla-put-coordinate lead_obj 1 (vlax-3d-point end-point))
    lead_obj
    ) ;_ end of defun

  ;|=======================================================================================
*    Функция возвращает vla-активное пространство (лист / модель).
*    Параметры вызова:
*   Нет
*    Примеры вызова:
(_kpblc-get-active-space-obj)
=======================================================================================|;
  (defun _kpblc-get-active-space-obj ()
    (if	(and (zerop (vla-get-activespace *kpblc-activedoc*))
	     (= :vlax-false (vla-get-mspace *kpblc-activedoc*))
	     ) ;_ end of and
      (vla-get-paperspace *kpblc-activedoc*)
      (vla-get-modelspace *kpblc-activedoc*)
      ) ;_ end of if
    ) ;_ end of defun

  ;|=============================================================================
*    Восстанавливаются системные переменные. Значения системных переменных
* должны храниться в глобальном списке *kpblc-sysvar-list*. Если списка нет
* (nil), происходит просто выход.
*    Параметры вызова:
*   Нет
*    Примеры вызова:
(kpblc-error-restore-sysvar)
=============================================================================|;
  (defun kpblc-error-restore-sysvar ()
    (if	*kpblc-sysvar-list*
      (foreach item *kpblc-sysvar-list*
	(if (or	(vl-catch-all-error-p
		  (vl-catch-all-apply 'setvar (list (car item) (cadr item)))
		  ) ;_ end of vl-catch-all-error-p
		(= (cadr item) "")
		(wcmatch (strcase (car item) r) "dim*")
		) ;_ end of and
	  (setvar (car item) ".")
	  (setvar (car item) (cadr item))
	  ) ;_ end of if
	) ;_ end of foreach
      ) ;_ end of if
    (setq *kpblc-sysvar-list* nil)
    (gc)
    ) ;_ end of defun

  ;|=======================================================================================
*    Сохраняется текущее значение системных переменных. Список глобальный (*kpblc-sysvar-list*)
* При условии, что заданы значения, они устанавливаются.
*    Поскольку список *kpblc-sysvar-list* не обнуляется, в нем хранится история изменения
* значений переменных.
*    Слизано с ruCAD с небольшой переделкой на случай замены размерных системных
* переменных - там невозможно восстановить значение "", надо устанавливать "."
*    Параметры вызова:
*   *kpblc-sysvar-list*   список системных переменных, состояние которых надо сохранить.
*         Список состоит из подсписков (Переменная Значение)
*         В списке могут повторяться переменные. В таком случае будет
*         установлено последнее значение.
*         Если в качестве второго параметра используется nil, то значение
*         системной переменной просто сохраняется.
*    Примеры вызова:
(kpblc-error-sysvar-list (list '("cmdecho" 0) '("blipmode") '("osmode" 503)))
=======================================================================================|;
  (defun kpblc-error-save-sysvar (sysvar-list)
    (foreach item sysvar-list
      (setq *kpblc-sysvar-list*
	     (cons
	       (list (car item) (getvar (car item)))
	       *kpblc-sysvar-list*
	       ) ;_ end of cons
	    ) ;_ end of setq   
      (if (cadr item)			; передано устанавливаемое значение
	(if (and (vl-catch-all-error-p
		   (vl-catch-all-apply 'setvar (list (car item) (cadr item)))
		   ) ;_ end of VL-CATCH-ALL-ERROR-P
		 (= (cadr item) "")
		 (wcmatch (strcase (car item) t) "dim*")
		 ) ;_ end of and
	  (setvar (car item) ".")
	  (setvar (car item) (cadr item))
	  ) ;_ end of if
	) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of defun

  (defun *error* (msg)
    (kpblc-error-restore-sysvar)
    (vla-endundomark *kpblc-activedoc*)
    (princ msg)
    (princ)
    ) ;_ end of defun

  ;; Конец локальных функций

  (vl-load-com)
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark *kpblc-activedoc*)
  (if
    (and
      (kpblc-error-save-sysvar '(("osmode") 512))
      (setq object (entsel "\nУкажите обрабатываемый объект <Выход> : "))
      (setq lead_start_point (cadr object)
	    object	     (vlax-ename->vla-object (car object))
	    ) ;_ end of setq
      (setq lead_end_point
	     (getpoint lead_start_point
		       "\nКонечная точка выноски <Выход> : "
		       ) ;_ end of getpoint
	    ) ;_ end of setq
      ) ;_ end of and
     (progn
       (cond
	 ((and (= (strcase (vla-get-objectname object) t) "acdbblockreference")
	       (= (vla-get-hasattributes object) :vlax-true)
	       (setq
		 attr (vl-remove-if
			'(lambda (x) (/= (strcase (vla-get-tagstring x) t) "txt"))
			(vlax-safearray->list
			  (vlax-variant-value (vla-getattributes object))
			  ) ;_ end of vlax-safearray->list
			) ;_ end of vl-remove-if
		 ) ;_ end of setq
	       ) ;_ end of and
	  (setq	leader_obj
		 (_kpblc-draw-leader
		   (strcat
		     "%<\\AcObjProp Object(%<\\_ObjId "
		     (itoa (vla-get-objectid (car attr)))
		     ">%).TextString>%"
		     ) ;_ end of strcat
		   lowstring
		   lead_start_point
		   lead_end_point
		   ) ;_ end of _kpblc-draw-leader
		) ;_ end of setq
	  )
	 (t
	  (setq	leader_obj
		 (_kpblc-draw-leader
		   (strcat
		     "%<\\AcObjProp Object(%<\\_ObjId "
		     (itoa (vla-get-objectid object))
		     ">%).Layer >%"
		     ) ;_ end of strcat
		   lowstring
		   lead_start_point
		   lead_end_point
		   ) ;_ end of _kpblc-draw-leader
		) ;_ end of setq
	  )
	 ) ;_ end of cond
       ) ;_ end of progn
     ) ;_ end of if
  (kpblc-error-restore-sysvar)
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_ end of defun

murzilka · 27.10.2006, 03:45

Доброго времени суток!
Уважаемый господин крЫс . Прога не плоха. Но вот я пытался ее упростить и ниче не получилось. Вооще у меня как то туго с восприятием команд AutoLispa.
Мне нада вместо Leader использовать простую полилинию. И не выводить имя слоя а рисовать кружок диаметра и запрашивать цифру диаметра.
Был бы весьма благодарен....

Кулик Алексей aka kpblc · 27.10.2006, 09:22

Вопрос: почему нельзя использовать стандартный _leader либо _qleader? И там вбивать %%c<Значение диаметра>?
Как вариант:

Код:

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

(defun c:diamlead (/ start end value)
  (if (and (setq start (getpoint "\nНачальная точка <Выход> : "))
           (setq end (getpoint start "\nКонечная точка <Выход> : "))
           (setq value (getreal "\nЗначение диаметра <Выход> : "))
           ) ;_ end of and
    (command "_.leader" start end "" (strcat "%%c" (rtos value)) "")
    ) ;_ end of if
  ) ;_ end of defun

murzilka · 31.10.2006, 06:51

Спасиба что откликнулись!
А можна не использовать Leader . Ну не нравится мне как он работает.
(канешна может я его готовить не умею)
А как использовать готовый блок с атрибутами. И чтобы выносная линия привязывалась в зависимости от угла к правой или к левой стороне.

Кулик Алексей aka kpblc · 31.10.2006, 09:45

Ээээ... В общем, я пробовал такое сделать, качественно не получается - слишком много надо вычислять, да еще и реакторы прописывать. Мне любопытно, а чем LEADER не нравится? Поконкретнее, если можно - возможно, вопрос в 1-2 настройках.

murzilka · 01.11.2006, 03:51

Доброва времени суток!!!
Я конешна не спорю что большинство проблем можна решить заданием переменных...
Тока вот я не знаю как...
Первая это конец выноски. Чтоб у него всегда стиль стрелки *none*...
Независимо от текущева стиля размеров. Это относится кстати и к размеру и плотности текста, у нас принято текст писать высотой 3 а размер ставится 2,5...
Вторая это сама полочка. Она получилась довольно большой. Точнее сильно выдвинута относительно начала текста.
И если сделать еще и второй текст под полкой чтоб она выравнивалась по большему...
А еще чтоб привязачная точка текста совпадала с прязочной полки. Это чтоб можно было просто брать за эту точку и передвигать текст вместе с полкой...
А на счет лидера такое мнение сложилось изза проблем возникающих при некорректно сделанных чертежей. Тут эта проблема обсуждалась, но решения я так и не нашел. Это когда чертеж изначально делается в трех координатных осях. Не специально, у подрядкиков так получается случайно )))
Привести *Z* в ноль не проблема. Но вот размеры и лидеры так не делаются. Пытался пользоваться *местными* лиспами. НЕУДАЧНО...
ВОТ!!!
Но если вы мне поможете с выноской. Я буду Вам премного благодарен.

Кулик Алексей aka kpblc · 01.11.2006, 09:24

Ммм... (это у меня аж зубы заболели

) - молю прочесть мою подпись, если обращение было ко мне.
Если необходимо именно такую выноску создавать (то бишь без стрелки на конце), то тут придется использовать vla-функции. А расстояние от "точки перелома" до текста определяется размером стрелки (сист.переменная DIMASZ) и DIMGAP. У меня один вопросец есть (прежде чем лисп катать): рисование выполняется с масштабом? то есть если масштаб 1:100, то размер текста должен быть не 2.5, а 250? или нет? Если в масштабе, то где и как задается этот масштаб, чтоб не было вопросов типа "У меня масштаб рисования 2:1, а текст ставится как для 1:100, что за фигня?! Автору лиспа открутить все что отрывается!"

---
Добавлено:

Цитата:

И если сделать еще и второй текст под полкой чтоб она выравнивалась по большему...

Это есть фактически, болтается на http://www.arcada.com.ua/forum/viewtopic.php?t=506 - только там переделать немного придется для Вашей задачи. Не особо проблема, думаю.

Цитата:

А еще чтоб привязачная точка текста совпадала с прязочной полки. Это чтоб можно было просто брать за эту точку и передвигать текст вместе с полкой...

Можно и реактор на stretch использовать, только муторно это.

Цитата:

А на счет лидера такое мнение сложилось изза проблем возникающих при некорректно сделанных чертежей. Тут эта проблема обсуждалась, но решения я так и не нашел. Это когда чертеж изначально делается в трех координатных осях. Не специально, у подрядкиков так получается случайно )))
Привести *Z* в ноль не проблема. Но вот размеры и лидеры так не делаются. Пытался пользоваться *местными* лиспами. НЕУДАЧНО...
ВОТ!!!

Ххе... Есть flatten из Express Tools, есть на http://www.arcada.com.ua/forum/viewtopic.php?t=755 его аналог (там только SOLID'ы пока не обрабатывались. Плющит все в мировую систему без особых вопросов. Поправочка: теперь и солиды обрабатывает

). На выбор

murzilka · 02.11.2006, 05:23

Бодрова утра!!!
На счет обращения - понял... )))
Про масштаб наверно всетаки загнул . Бывают , хоть и редко масштабы отличные от 1:100 ...
Но вот про стрелку в лидере эт точно не нужна.
А вот по первой ссылке. Я не знаю как это сложить... Стыдно мне но не знаю. Я щас в таком урюпинске абитаю что ни одной нормальной книги по Лиспу не найти. А есть желание освоить данной предмет. В нете нашел пару книг , но там практически описание команд и все а как их складывать не пойму...
Хотелось чтобы ты нарисовал прогу а я потом в ней как то разобрался ну и пару вопросов позадал бы.... )))
Про текст в Лидер . А можно же задать привязку текста СЛЕВА-СНИЗУ.
А вот про трехмерность размеров и flatten . Не получилось у меня.
Я ее запустил. Она попросила выбрать объект . Я ей показал на раскаряченный размер , после чево она спросила *удалять ли скрытые линии* я сказал ДА. И она просто разбила мне размер.
Если сказать нет то ничево не происходит.
Такое ащущение что это не та прога... )))
Прикрепил файл с такими размерами???
[ATTACH]1162434190.dwg[/ATTACH]

Кулик Алексей aka kpblc · 02.11.2006, 10:14

Насчет "плющилки". Там в файле несколько "отвратительных" моментов: заданная толщина (thickness)для окружностей; в блоках атрибуты отнесены по высоте и т.п. Вот переделка (см.аттач). Код для "плющилки":

Код:

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

;|=============================================================================
*    Функция-аналог flatten из Express Tools. Обрабатывает 3DFACE, не трогает
* AEC-объекты, тела.
=============================================================================|;
(defun c:kpblc-dwg-flatten (/                       *kpblc-activedoc*
                            _kpblc-error-catch      *error*
                            selset                  mod_item
                            _kpblc-conv-selset-to-ename
                            _kpblc-ent-conv-z-to-0
                            )

  (defun *error* (message)
    (if (member message
                '("console break"           "Function cancelled"
                  "Функция отменена"        "quit / exit abort"
                  "выйти прервать"
                  ) ;_list
                ) ;_member
      (princ "\nКоманда прервана пользователем")
      (princ
        (strcat "\ERRNO # "
                (itoa (getvar "ERRNO"))
                ": "
                message
                "\n"
                ) ;_strcat
        ) ;_princ
      ) ;_if
    (_kpblc-layer-status-restore)
    (vla-endundomark *kpblc-activedoc*)
    (princ)
    ) ;_defun 

  (defun _kpblc-error-catch
         (protected-function on-error-function / catch_error_result)
    (setq catch_error_result (vl-catch-all-apply protected-function))
    (if (and (vl-catch-all-error-p catch_error_result)
             on-error-function
             ) ;_ end of and
      (apply on-error-function
             (list (vl-catch-all-error-message catch_error_result))
             ) ;_ end of APPLY
      catch_error_result
      ) ;_ end of if
    ) ;_ end of defun

  (defun _kpblc-layer-status-restore (/ item)
    (if *kpblc-list-layer-status*
      (progn
        (foreach item *kpblc-list-layer-status*
          (_kpblc-error-catch
            '(lambda ()
               (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
               ) ;_ end of LAMBDA
            nil
            ) ;_ end of _kpblc-error-catch
          (_kpblc-error-catch
            '(lambda ()
               (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
               ) ;_ end of LAMBDA
            nil
            ) ;_ end of _kpblc-error-catch
          ) ;_ end of foreach
        ) ;_ end of progn
      ) ;_ end of if
    (setq *kpblc-list-layer-status* nil)
    ) ;_ end of defun

  (defun _kpblc-layer-status-save (layers-on / item)
    (vlax-for item (vla-get-layers *kpblc-activedoc*)
      (setq *kpblc-list-layer-status*
             (append *kpblc-list-layer-status*
                     (list
                       (list item
                             (cons "freeze" (vla-get-freeze item))
                             (cons "lock" (vla-get-lock item))
                             ) ;_ end of list
                       ) ;_ end of list
                     ) ;_ end of append
            ) ;_ end of setq
      (if layers-on
        (progn
          (_kpblc-error-catch
            '(lambda ()
               (vla-put-freeze item :vlax-false)
               ) ;_ end of LAMBDA
            nil
            ) ;_ end of _KPBLC-ERROR-CATCH
          (vla-put-lock item :vlax-false)
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of defun

  (defun _kpblc-conv-selset-to-ename (selset)
    (if selset
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
      ) ;_ end of if
    ) ;_ end of defun

  (defun _kpblc-conv-ent-to-ename (ent_value)
    (cond
      ((= (type ent_value) 'vla-object) (vlax-vla-object->ename ent_value))
      ((= (type ent_value) 'ename) ent_value)
      ((= (type ent_value) 'list) (cdr (assoc -1 ent_value)))
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-ent-to-vla (ent_value)
    (cond
      ((= (type ent_value) 'vla-object) ent_value)
      ((= (type ent_value) 'ename) (vlax-ename->vla-object ent_value))
      ((= (type ent_value) 'list)
       (cond
         ((= (type (car ent_value)) 'ename)
          (vlax-ename->vla-object (car ent_value))
          )
         (t
          (if
            (not
              (vl-catch-all-error-p
                (vl-catch-all-apply
                  (vlax-ename->vla-object (_kpblc-conv-ent-to-ename ent_value))
                  ) ;_ end of vl-catch-all-apply
                ) ;_ end of vl-catch-all-error-p
              ) ;_ end of not
             nil
             ) ;_ end of if
          )
         ) ;_ end of cond
       )
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-ent-conv-z-to-0 (ent / new pt lst loc:transpoint selset)
    (defun loc:transpoint (point ent)
      (if (/= (cdr (assoc 210 (entget ent))) '(0. 0. 1.))
        (trans point ent 0)
        point
        ) ;_ end of if
      ) ;_ end of defun

    (cond
      ((member (cdr (assoc 0 (entget ent))) '("INSERT" "HATCH"))
       (_kpblc-ent-modify-autoregen
         ent
         10
         (list (cadr (assoc 10 (entget ent)))
               (caddr (assoc 10 (entget ent)))
               0.
               ) ;_ end of list
         nil
         ) ;_ end of _kpblc-ent-modify-autoregen
       )
      ((= (cdr (assoc 0 (entget ent))) "LINE")
       (foreach item '(10 11)
         (setq pt (loc:transpoint (cdr (assoc item (entget ent))) ent))
         (_kpblc-ent-modify-autoregen
           ent
           item
           (list (car pt) (cadr pt) 0.)
           nil
           ) ;_ end of _kpblc-ent-modify-autoregen
         ) ;_ end of foreach
       )
      ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ARC"))
       (setq pt (trans (cdr (assoc 10 (entget ent))) ent 0))
       (_kpblc-ent-modify-autoregen
         ent
         10
         (list (car pt) (cadr pt) 0.)
         nil
         ) ;_ end of _kpblc-ent-modify-autoregen
       )
      ((= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
       (setq lst (mapcar '_kpblc-conv-3d-to-2d
                         (_kpblc-conv-ent-pline-vertex-to-wcs ent)
                         ) ;_ end of mapcar
             ) ;_ end of setq
       (if (not (equal (cdr (assoc 210 (entget ent))) '(0. 0. 1.)))
         (progn
           (vla-put-coordinates
             (_kpblc-conv-ent-to-vla ent)
             (_kpblc-conv-pointlist-to-variant (apply 'append lst))
             ) ;_ end of vla-put-coordinates
           (_kpblc-ent-modify-autoregen ent 210 '(0. 0. 1.) nil)
           ) ;_ end of progn
         ) ;_ end of if
       (_kpblc-ent-modify-autoregen ent 38 0 nil)
       (_kpblc-ent-modify-autoregen ent 39 0 nil)
       )
      ((= (cdr (assoc 0 (entget ent))) "LEADER")
       (kpblc-is-debug-print "\nВозможна неправильная обработка LEADER!")
       (vla-put-coordinates
         (_kpblc-conv-ent-to-vla ent)
         (_kpblc-conv-pointlist-to-variant
           (apply
             'append
             (mapcar
               '_kpblc-conv-2d-to-3d
               (mapcar '_kpblc-conv-3d-to-2d
                       (_kpblc-conv-list-to-3dpoints
                         (vlax-safearray->list
                           (vlax-variant-value
                             (vla-get-coordinates (_kpblc-conv-ent-to-vla ent))
                             ) ;_ end of vlax-variant-value
                           ) ;_ end of vlax-safearray->list
                         ) ;_ end of _KPBLC-CONV-LIST-TO-3DPOINTS
                       ) ;_ end of mapcar
               ) ;_ end of mapcar
             ) ;_ end of apply
           ) ;_ end of _kpblc-conv-pointlist-to-variant
         ) ;_ end of vla-put-coordinates
       )
      ((= (cdr (assoc 0 (entget ent))) "TEXT")
       (setq pt (loc:transpoint (cdr (_kpblc-get-text-point ent)) ent))
       (_kpblc-ent-modify-autoregen ent 10 (list (car pt) (cadr pt) 0.) nil)
       )
      ((= (cdr (assoc 0 (entget ent))) "MTEXT")
       (setq pt (loc:transpoint (cdr (_kpblc-get-text-point ent)) ent))
       (_kpblc-ent-modify-autoregen ent 10 (list (car pt) (cadr pt) 0.) nil)
       )
      ((= (cdr (assoc 0 (entget ent))) "DIMENSION")
       (command "_.dimdisassociate" ent "")
       (foreach item '(10 11 12 13 14 15 16)
         (if (cdr (assoc item (entget ent)))
           (progn
             (setq pt (loc:transpoint (cdr (assoc item (entget ent))) ent))
             (_kpblc-ent-modify-autoregen
               ent
               item
               (list (car pt) (cadr pt) 0.)
               nil
               ) ;_ end of _kpblc-ent-modify-autoregen
             ) ;_ end of progn
           ) ;_ end of if
         ) ;_ end of foreach
       )
      ((= (cdr (assoc 0 (entget ent))) "3DFACE")
       ;; Для 3DFACE преобразование попробуем не проводить
       (vla-addlightweightpolyline
         (vla-objectidtoobject
           *kpblc-activedoc*
           (vla-get-ownerid (vlax-ename->vla-object ent))
           ) ;_ end of vla-ObjectIDToObject
         (_kpblc-conv-pointlist-to-variant
           (apply 'append
                  (mapcar
                    '_kpblc-conv-3d-to-2d
                    (mapcar 'cdr
                            (vl-remove-if-not
                              '(lambda (x) (member (car x) '(10 11 12 13)))
                              (entget ent)
                              ) ;_ end of vl-remove-if-not
                            ) ;_ end of mapcar
                    ) ;_ end of mapcar
                  ) ;_ end of apply
           ) ;_ end of _kpblc-conv-pointlist-to-variant
         ) ;_ end of vla-addlightweightpolyline
       (_kpblc-ent-properties-copy
         (_kpblc-conv-ent-to-vla ent)
         (_kpblc-conv-ent-to-vla (entlast))
         ) ;_ end of _kpblc-ent-properties-copy
       (entdel ent)
       (setq ent (entlast))
       (_kpblc-ent-modify-autoregen ent 70 1 t)
       )
      ((= (cdr (assoc 0 (entget ent))) "SOLID")
       (mapcar
         '(lambda (x)
            (if (cdr (assoc (car x) (entget ent)))
              (_kpblc-ent-modify-autoregen ent (car x) (cdr x) t)
              ) ;_ end of if
            ) ;_ end of LAMBDA
         (mapcar
           '(lambda (a) (cons a (trans (cdr (assoc a (entget ent))) ent 0)))
           '(10 11 12 13)
           ) ;_ end of mapcar
         ) ;_ end of mapcar
       )
      ) ;_ end of cond
    (_kpblc-ent-modify-autoregen ent 210 (list 0. 0. 1.) nil)
    ent
    ) ;_ end of defun


  (defun _kpblc-ent-modify-autoregen (ent        bit        value
                                      ext_regen  /          ent_list
                                      old_dxf    new_dxf    layer_dxf70
                                      )
    (setq ent (_kpblc-conv-ent-to-ename ent))
    (if (not
          (and
            (or
              (= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
              (= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
              (= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
              ) ;_ end of or 
            (= bit 100)
            ) ;_ end of and 
          ) ;_ end of not 
      (progn
        (setq ent_list (entget ent)
              new_dxf  (cons bit
                             (if (and (= bit 62) (= (type value) 'str))
                               (if (= (strcase value) "BYLAYER")
                                 256
                                 0
                                 ) ;_ end of if 
                               value
                               ) ;_ end of if 
                             ) ;_ end of cons 
              ) ;_ end of setq 
        (if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
          (progn
            (entmod (if old_dxf
                      (subst new_dxf old_dxf ent_list)
                      (append ent_list (list new_dxf))
                      ) ;_ end of if 
                    ) ;_ end of entmod
            (if ent_regen
              (entupd ent)
              (redraw ent)
              ) ;_ end of if
            ) ;_ end of progn 
          ) ;_ end of if 
        ) ;_ end of progn 
      ) ;_ end of if 
    ent
    ) ;_ end of defun

  ;; Обрабатываем только активное пространство, потому что для остальных
  ;; используемая функция (trans) выдает ошибку
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark *kpblc-activedoc*)
  (if (setq selset (ssget))
    (progn
      (_kpblc-layer-status-save t)
      (foreach item (_kpblc-conv-selset-to-ename selset)
        (setq mod_item (_kpblc-ent-conv-z-to-0 item))
        (if (vlax-property-available-p
              (_kpblc-conv-ent-to-vla mod_item)
              "thickness"
              ) ;_ end of vlax-property-available-p
          (vla-put-thickness (_kpblc-conv-ent-to-vla mod_item) 0.)
          ) ;_ end of if
        ) ;_ end of foreach
      (_kpblc-layer-status-restore)
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_ end of defun

Насчет литературы по лиспу и программированию под AutoCAD было обсуждение на http://www.arcada.com.ua/forum/viewtopic.php?t=431 (и дополнительно на http://www.arcada.com.ua/forum/viewtopic.php?t=522 ).
Теперь по "лидеру" (ну и словечко!). Из поста 19 проанализируй код - он достаточно сложен. Хотя твоя задача решается заменой строк

Код:

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

lead_obj (vla-addleader
           (_kpblc-get-active-space-obj)
           (_kpblc-conv-pointlist-to-variant
             (apply 'append (list start-point end-point))
             ) ;_ end of _kpblc-conv-pointlist-to-variant
           ann_obj
           aclinewitharrow
           ) ;_ end of vla-AddLeader

на нечто типа

Код:

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

lead_obj
(vla-addleader
  (_kpblc-get-active-space-obj)
  (_kpblc-conv-pointlist-to-variant
    (apply 'append (list start-point end-point))
    ) ;_ end of _kpblc-conv-pointlist-to-variant
  ann_obj
  aclinenoarrow
  ) ;_ end of vla-AddLeader

Что называется, найти одно отличие

[ATTACH]1162451684.zip[/ATTACH]
---
Добавлено:
Если у тебя не требуется поле, обязательно замени определение аннотации для выноски (это который ann_obj).

murzilka · 03.11.2006, 06:48

Доброва времени суток!!!
По плющилку....
Она у меня не запустилась... Набирал команду kpblc-dwg-flatten
Вааще как это правильно делать? Може я что не то делаю...
Я беру код, закидываю ево в файл acad.lsp который лежит в суппорте.
И он у меня автоматически загружается при запуске автокада.
А про лидера дела такие. Засунул с поста 19 код, заменил ,как ты сказал стрелку на БЕЗ стрелки и...
Так же не запустилась.
"bad argument type: consp 512" - пишет
я так понимаю что это объктная привязка. Она что только ближайшую точку ? А нельзя пользоваться моими включенными?

Кулик Алексей aka kpblc · 03.11.2006, 08:56

О мой старый голова! Вот они, минусы модульных систем... В приложении - подправленный код. Если сильно надо, можно попробовать сделать инсталлер на это меню (только явно не сегодня). Комментарии там унутри. С выноской попробую сегодня разобраться, но не гарантирую. Там в принципе сложного мало, надо просто последовательно все прописать

Если гуры подключатся, то будет совсем гуд

[ATTACH]1162533394.rar[/ATTACH]

murzilka · 03.11.2006, 09:38

Да не плохо!!!
Тока вот если у тебя сохранился мой пример, попробуй сам сделать.
Получилось он все сплющил за исключение одного блока number_ruum.
С ним он просто поглумился. )))
Это номер помещения. Цифра в кружочке. Так вот он кружочек опустил в ноль а цифру забыл )))
Инсталятор мне не нужен. Я все равно пользуюсь клавай для команд.

Кулик Алексей aka kpblc · 03.11.2006, 09:47

Ага. Я знаю. Я специально не стал в комментах писать. Суть в следующем: в этом блоке у тебя атрибут отнесен по высоте изначально. Как вариант можно войти в редактирование этого блока, применить плющилку, потом выйти с сохранением и выполнить _attsync или _battman. Но! Прежде чем это делать, поищи - Vova поднимал тему по поводу поведения этих команд - там есть интересная инфа.

murzilka · 03.11.2006, 09:51

А еще!!! Это уже на другом файле...
Прога протоптала размеры. А потом переходит на полилинии.
И выдает ашипку!!!
"errno # 0: Ошибка автоматизации. invalid list"
ВОТ!!!

Кулик Алексей aka kpblc · 03.11.2006, 09:57

Присылай или выкладывай. Догадываюсь, где собака порылась. Но надо на конкретике смотреть.

murzilka · 03.11.2006, 10:14

ИЗВИНИТИ!!!
Блок я проверил. Изначально он был нормальный. И даже в этом чертежике он хоть поднят на 2999.96 но это относится и к цырклу и цыфири...
Вот файл...
[ATTACH]1162538040.rar[/ATTACH]

Кулик Алексей aka kpblc · 03.11.2006, 12:55

Значит насчет этого файла. У меня код отработал не совсем на ура - не обработал выноски (вылетел, я потом подправил). Сплайны тоже мимо (было ожидаемо). И блоки тож. Вопрос - если со сплайнами заморачиваться, там принимать управляющие точки или определяющие (в английской версии соответсвенно Control points / Fit points)? Блоки обрабатываем?
P.S. Если обрабатываем сплайны, а у них точки разнесены по высоте (то есть первая на 0, вторая на 100, третья на -1000), то в результате вид сплайна может капитально измениться.

murzilka · 04.11.2006, 01:17

Доброва Утра!!!
В общем так. На сплайны ЗАБЬЕМ!!!
Не знаю кто ево использовал. Но это скорее единичный случай.
Вааще , изначально проблема была с размерами и их родственниками )))
Такой чертеж я привожу в ручную в нормальный вид за пару минут. Проблемы составляют блоки, если один из них стоит на нуле то другие не хотят прыгать в ноль. Но и это решается с помощью фильтра.
И размеры, которые вааще никак не решаются.
Изначально хотелось прогу для исправления размеров. Но если получится и все остальное исправлять то это канешна буит замечательно...
з.ы. ну а что с выноской делать?)))

Кулик Алексей aka kpblc · 07.11.2006, 10:54

Погодим немного с выноской, ок? Для начала сплющим файл в камбалообразный вид

Цитата:

Но это скорее единичный случай.

Не сказал бы. Сплайнов в файле явно не один

Другой вопрос, что у них все точки в одной высоте болтаются

Для такого варианта попробуй приложенный код (уж очень сильно хочется снести все автоматом). А там и выноской займемси

[ATTACH]1162886047.rar[/ATTACH]

murzilka · 08.11.2006, 07:11

Доброва утра , Уважаемый !
С новым кодом погонял файлик. Сначала ничево он не смог сделать со сплайном и блоки разрывал. Но потом при выделении всево рисунка выпал ФАТАЛ ИРРОР!!!
*Command may not be nested more than 4 deep*
ВОТ!!!
Начел по одному . Все нормально. И сплайны по одному сплющил. Но стоило выделить , наверно больше десяти с блоком вместе и ... фатал...
В общем по одному он сплющивает блоки нормально... но

Кулик Алексей aka kpblc · 08.11.2006, 08:08

(Ожесточенно чешу затылок). Я тестировал на файле, который здесь был выложен - все шарашилось на ура. Сейчас еще разок попробую...
---
Добавлено: Только что специально прогнал несколько раз в разных вариантах, вроде как все нормально работает (на предоставленном файле). Пациента б глянуть...

murzilka · 08.11.2006, 09:47

Пациент тот же , еще раз выкладываю )))
Пациент перестает дышать на блоках , када их больше 2-3...
или на каких то специфичных.
Проверил исчо раз применением ко всему нарисованному )))
[ATTACH]1162968464.rar[/ATTACH]

Кулик Алексей aka kpblc · 08.11.2006, 10:03

Хочешь бей меня, хочешь - режь, а все равно последний код работает! Я попробовал на 2005, 2006, 2007 (и просто ACAD, и ADT) - работает, собака!
---
Добавлено: во вложении - сплющенный и почищенный файл
[ATTACH]1162971501.dwg[/ATTACH]

murzilka · 09.11.2006, 03:54

Бодрова утра!!!
Бить и резать нибуду!!! )))
Потому как у миня версия 2004!!! и это изза лицензии (((
кстати проверял на 2006. на том же файле...
один раз сработала нормально
а второй раз...
выдала ашипку:
*ERRNO # 2: no function definition: VLAX-GET-ACAD-OBJECT
; ошибка: В функции *error* возникла ошибка:нет описания функции:
VLA-ENDUNDOMARK* )))
чьто йето такое??? )))

Кулик Алексей aka kpblc · 09.11.2006, 08:02

Ни себе фига вареники... В общем, так. Это ошибка загрузки activex расширения (в версиях 2005 и выше оно на автомате, а вот в "раньших" версиях не совсем). В коде прямо перед строкой

Код:

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

(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))

вбей

Код:

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

(vl-load-com)

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

murzilka · 09.11.2006, 11:00

Ну с шестым мы вроде победили.
Обработал на ура.
Но вот с моим 2004 что то никак. Все так же фатал еррор. Как и раньше...
А про лицензию пишу потому что мне можна работать тока на 2004, на работе.

Кулик Алексей aka kpblc · 09.11.2006, 11:57

Вроде как что-то 2004-образное нашел, сейчас попробую поставить.

Кулик Алексей aka kpblc · 09.11.2006, 12:23

В общем, проблема пришла откуда не ждали

Все дело в этих чертовых блоках. Точнее, в их атрибутах. Как только снимается команда attsync, все становится чики-пуки. Возможно, это глюки моей установки; сервис-пака я на ACAD2004 не ставил (слетает возможность запуска). Как вариант: снять это дело с программы и выполнять руками. Как, покатит?

murzilka · 10.11.2006, 06:30

Неее, мне так не понравилось. Он совсем отказался обрабатывать блоки, точнее блок вроде как перетащил а атрибуты оставил.

Цитата:

Возможно, это глюки моей установки; сервис-пака я на ACAD2004 не ставил (слетает возможность запуска).

А это я вааще ни понял... Какой такой сервис-пак. Если винда то у меня ща вааще 2000. Если Автокад то я и не слышал что такие бывают...

Кулик Алексей aka kpblc · 10.11.2006, 08:18

Суть тут в том, что атрибуты имеют собственные свойства вставок, которые могут отличаться от настроек вставки блока, а также от свойств описания блока. Поэтому при такой задаче приходится их менять. Попытки сделать "все программно" у меня провалились (почему - не очень понял, вроде как все нормально делал, а эффекта все одно нуль). Пришлось обращаться к штатной команде AutoCAD'a - _.attsync, а она, зараза этакая, в 2005 и выше работает нормально, а вот в 2004 хамит не по детски.
Сервис-пак можно (для чистого AutoCAD 2004) можно скачать (да и прочитать про него) можно здесь.

murzilka · 13.11.2006, 02:06

Доброва утра!!!
Ну и ладна. Я уже магу тебе передать огромное спасибо за эту прогу, от коллег, и от себя ))). Самое главное что она обрабатывает размеры.
Ну а что делать бум с выноской
у миня все такжи " bad argument type: consp 512 " пишет...

Кулик Алексей aka kpblc · 13.11.2006, 08:17

Попробую сегодня разобраться.

murzilka · 15.11.2006, 06:07

Уважаемый KRblC
Я все еще жду :P

posetitel · 28.06.2021, 13:13

здравствуйте!
Подниму тему.
Вопрос такой же как у топикстатера: лисп с выполнением выноски и мультитекста с указанием слоев в которых находятся полилинии.
Первый лисп почти подходит, но в нем не получается сама выноска и к названию слоев еще добавляются какие-то данные.
Можно ли отредактировать лисп из второго сообщения чтобы рисовалась выноска и в мультитексте были только перечисления слоев?

Vladimir_Sergeevich · 29.06.2021, 09:28

что то похожее совсем недавно решалось рядом . Только вместо блока переписать на полилинии и вместо атрибута имя слоя

posetitel · 29.06.2021, 09:43

Vladimir_Sergeevich, спасибо за наводку.
Для асов лиспа, наверняка, это не составит труда вообще, интуитивно догадываюсь, что надо заменить пару команд, может быть с синтаксисом поколдовать.
Но вот для просты чертежников, которым я являюсь, эта задача становится непосильной

koMon · 29.06.2021, 10:58

без заморочек и не редакция, все попавшие в pickbox

Код:

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

 

;******************************************************************************************************************************************

(defun cp_select (pick_center / half_pick_box)
	(setq half_pick_box (* (getvar 'pickbox) (/ (getvar 'viewsize) (cadr (getvar 'screensize)))))
	(ssget "_cp" (list (list (- (car pick_center) half_pick_box) (- (cadr pick_center) half_pick_box))
				  	   (list (- (car pick_center) half_pick_box) (+ (cadr pick_center) half_pick_box))
				  	   (list (+ (car pick_center) half_pick_box) (+ (cadr pick_center) half_pick_box))
				  	   (list (+ (car pick_center) half_pick_box) (- (cadr pick_center) half_pick_box))
				 )
	)
)

;******************************************************************************************************************************************

(defun c:Layer_Field_MLeader ( / point_picked ss_picked ss_index mleader_basepoint picked_entity command_is_cancelled)
	(while (and
				(not command_is_cancelled)
				(or (null (setq point_picked (vl-catch-all-apply 'getpoint (list "\nУкажите точку на примитиве для копирования слоя(ёв): ")))) t)
				(cond
					(
						(null (setq ss_picked (cp_select point_picked)))
							t
					)
					(
						(vl-catch-all-error-p point_picked)
							(princ "\nОтмена")
							(setq command_is_cancelled t)
							(setq picked_entity nil)
					)
					(
						t
							(setq ss_index 0
								  mleader_text ""
							)
							(repeat (sslength ss_picked)
								(setq current_entity (ssname ss_picked ss_index)
									  mleader_text (strcat mleader_text
																  "%<\\AcObjProp Object(%<\\_ObjId "
																   (itoa (vla-get-objectid (vlax-ename->vla-object current_entity)))
																  ">%).Layer>%"
;																   (vla-get-layer (vlax-ename->vla-object current_entity))
																   " [" (substr (vla-get-objectname (vlax-ename->vla-object current_entity)) 5) "]"
																  "\\P"
														  )
									  ss_index (1+ ss_index)
								)
							)
							(vl-cmdf "_.mleader" "_none" (setq mleader_basepoint point_picked)
												 "_none" (getpoint mleader_basepoint "\nПоложение полки выноски: ")
;												 mleader_text
												 ""
							)
							(vla-put-textstring (vlax-ename->vla-object (entlast)) mleader_text)
    						(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
							t
					)
				)
			)
	)
	(princ)
)

;******************************************************************************************************************************************

posetitel · 29.06.2021, 11:19

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

Vladimir_Sergeevich · 29.06.2021, 12:18

хе. Ну циклический выбор в помощь, либо переписывайте (в сторону усложнения) код под выбор ssget'ом вместо entsel и соответствующую обработку полученного набора

18.04.2006, 21:30		#1
Лисп =выноска+поле Pave1 электроснабжение и автоматика г. Пермь Регистрация: 21.06.2005 Сообщений: 329 Для тех кто умеет писать лиспы это наверное не сложная задачка, а мне, да и другим проектировщикам занимающимся электрикой, пригодился бы вот такой лисп: 1. указываешь линию (отрезок/полилинию/3D полилинию); 2. место вставки. А лисп за тебя прописывает в получившейся сноске название слоя, к которому относится линия, и хорошо бы еще название слоя было в виде поля (field), чтобы если вдруг захочется изменить слой линии, надпись менялась и соответствовала новому слою. А может у кого-нибудь уже есть что-нибудь подобное? Буду признателен. __________________ хочу все знать
Просмотров: 27610

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск