| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Лисп =выноска+поле

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

Ответ
Поиск в этой теме
Непрочитано 18.04.2006, 21:30 #1
Лисп =выноска+поле
Pave1
 
электроснабжение и автоматика
 
г. Пермь
Регистрация: 21.06.2005
Сообщений: 329

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

А может у кого-нибудь уже есть что-нибудь подобное?
Буду признателен.
__________________
хочу все знать
Просмотров: 27532
 
Непрочитано 18.04.2006, 22:17
#2
pyatifan


 
Регистрация: 29.10.2005
Нижегородская обл.
Сообщений: 219
<phrase 1=


Есть выноска на лиспе. Её автор сюда каждый день водится. Компа под рукой нет:
www.autokad.ru
Раздел готовые программы, там в заголовке слово выноска есть. Ток она у меня барахлила. Там вроде косяки с реакторами...я подобную из KitoxTools использую вместо СПДС. Уверен этот хороший человек не останется равнодушным и в конце темы мы будем иметь ещё один удобный инструмент. А вообще можно настроить стандартную выноску для работы с блоком,в который запихнуть атрибут с полем, ток потом руками придётся править
pyatifan вне форума  
 
Непрочитано 18.04.2006, 22:58 Re: Лисп =выноска+поле
#3
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от 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
Да, примененные блоки скину позже вместе со второй прогой.
Лентяй вне форума  
 
Непрочитано 18.04.2006, 23:21
#4
pyatifan


 
Регистрация: 29.10.2005
Нижегородская обл.
Сообщений: 219
<phrase 1=


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

электроснабжение и автоматика
 
Регистрация: 21.06.2005
г. Пермь
Сообщений: 329


Посмотрел лисп.
Вроде бы то что надо, но у меня не прорисовались линии выноски.
Это почему у меня так? Или они не должны прорисовываться?
А вот запрос в начале и конце надписи мне понравился :)
Как-раз, в начале надо писать название трассы, а в конце ее длину.
Только вот длину и название хочется в виде поля, чтобы менялись в случае изменения линии.
__________________
хочу все знать
Pave1 вне форума  
 
Непрочитано 19.04.2006, 13:49
#6
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Обещанная программа редактирования выносок и блоки к ней.
Код:
[Выделить все]
 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
#7
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от Pave1
Посмотрел лисп.
Вроде бы то что надо, но у меня не прорисовались линии выноски.
Это почему у меня так? Или они не должны прорисовываться?.
Не должны, потому как у вас не было блока "скобки", к которому линия выноски пристегивается.

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

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Цитата:
Сообщение от 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'~
fixo вне форума  
 
Непрочитано 19.04.2006, 14:41
#9
kabzzz


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


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


 
Регистрация: 29.10.2005
Нижегородская обл.
Сообщений: 219
<phrase 1=


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

вот в ком строке и нужно набирать COTUPD.
Заранее прошу не пинать, если что-то сморозил...но хочется работоспособную программу.
pyatifan вне форума  
 
Непрочитано 19.04.2006, 17:45
#11
Кулик Алексей aka kpblc
Moderator

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


Гы, помянули? Расхлебывайте
Тут реакторы не требуются, т.к. выноска только однострочная с именем слоя нужна, как я понял по начальному варианту задачи Тады вот такое можно:
Код:
[Выделить все]
;|=============================================================================
*    Рисование выноски.
=============================================================================|;
(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
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.04.2006, 18:03
#12
Кулик Алексей aka kpblc
Moderator

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


А вот для Лентяя, я думаю, уже понадобятся и реакторы. В частности, на *text* команды - если редактируемый текст является аннотацией (определяется по 330 группе, по-моему), и аннотация началом лежит на каком-то примитиве, то тогда менять расширенные данные. Хотя я бы сейчас, наверное, делал не РД, а словари (которые vlax-ldata - там нет таких ограничений на структуру, как в РД). Хотя... РД тоже могут оказаться незаменимыми.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.04.2006, 18:09
#13
pyatifan


 
Регистрация: 29.10.2005
Нижегородская обл.
Сообщений: 219
<phrase 1=


Цитата:
Уверен этот хороший человек не останется равнодушным и в конце темы мы будем иметь ещё один удобный инструмент
Спасибо! А в поле как раз можно что запихнуть что надо! Прямо как в сказке...именно этого и хотелось
pyatifan вне форума  
 
Непрочитано 19.04.2006, 18:17
#14
Кулик Алексей aka kpblc
Moderator

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


Должен сказать о некоторых тонкостях работы функции (если она пойдет дальше )
- отрисовка ведется на текущем слое, с текущим текстовым и размерным стилем
- для выноски напрямую назначается "указатель" - заполненная стрелка. Если надо другое, то надо изменить строку aclinewitharrow на ту, которую надо (см.хелп).
- Начальная точка выноски определяется не совсем правильно - она не лежит на объекте, а находится рядом, точно там, где щелкнули при указании объекта. По идее можно устанавливать принудительную привязку osmode в 512, но я не стал этого делать - грубо говоря, поленился.
Вроде как все...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.04.2006, 08:32 Привет
#15
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


КРЫС а то же самое но со считыванием атрибута блока с именем TXT 0
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Непрочитано 20.04.2006, 09:30
#16
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от kpblc
А вот для Лентяя, я думаю, уже понадобятся и реакторы. В частности, на *text* команды - если редактируемый текст является аннотацией (определяется по 330 группе, по-моему), и аннотация началом лежит на каком-то примитиве, то тогда менять расширенные данные. Хотя я бы сейчас, наверное, делал не РД, а словари (которые vlax-ldata - там нет таких ограничений на структуру, как в РД). Хотя... РД тоже могут оказаться незаменимыми.
Какие такие реакторы? Не надо нам никаих реаторов, у нас и так все прекрасно взрывается [sm3321]
А ежели серьезно, то аннотация привязывается к стрелке-выноске. И менять, в смысле редактировать ее можно, как обычный текст. Потм уже это исзменение можно перетаскивать в РД с последующим update-ом всех прочих ссылок на эти РД. Это можно сделать как моей прогой COTUPD, так и, не к ночи будь помянут, реактором.
Лентяй вне форума  
 
Непрочитано 20.04.2006, 16:05
#17
Кулик Алексей aka kpblc
Moderator

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


> 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
> Лентяй : Так а зачем использовать стороннюю функцию, если использование командного реактора на редактирование многострочного текста (с соответствующей проработкой) позволит сразу провернуть изменение РД для примитивов? С другой стороны, это просто вопрос вкуса и привычки, я думаю
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.04.2006, 22:30
#18
pyatifan


 
Регистрация: 29.10.2005
Нижегородская обл.
Сообщений: 219
<phrase 1=


Как-то не понятно: в коде куча примеров вызова...или тока один "kpblc_lead" должен работать? Вроде привязки должны срабатывать чтоли ("osmode" 503). Руководство пользователя хотелось увидеть
В Kitox'е как-то удобней всётки.
pyatifan вне форума  
 
Непрочитано 21.04.2006, 08:19
#19
Кулик Алексей aka kpblc
Moderator

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


Ну дык функция с с: одна - вот ее и вызывать, остальное - мои библиотечные, не хотел их переделывать.
Краткий мануал: Клик на объекте. Клик на новой точке (там будет строиться полка выноски). Если объект блок содержит атрибут "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
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 27.10.2006, 03:45
#20
murzilka


 
Регистрация: 23.08.2006
Краснодар
Сообщений: 21


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

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

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