vl-cmdf "_.text" - некорректная работа

vl-cmdf "_.text" - некорректная работа · 10.12.2010, 15:49

Человек попросил изменить команду по подсчету блоков, чтобы она имя блока и количество выкидывала не в командную строку, а на чертеж. Думал все просто изменю princ на vl-cmdf "_.text" со сдвигом по оси Y вниз для каждого блока ... но нет сдвиг не работает, а почему понять не могу

. Строчки друг на дружку прыгают.

Код:

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

(defun blockin (/ adoc selset res name)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (setq selset (ssget '((0 . "INSERT"))))
    (progn
      (foreach blk
               (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                       ) ;_ end of mapcar
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                           ) ;_ end of and
                      (vla-get-effectivename blk)
                      )
                     (t (vla-get-name blk))
                     ) ;_ end of cond
              ) ;_ end of setq
        (if (member name (mapcar 'car res))
          (setq res (subst (cons name (1+ (cdr (assoc name res))))
                           (assoc name res)
                           res
                           ) ;_ end of subst
                ) ;_ end of setq
          (setq res (append res (list (cons name 1))))
          ) ;_ end of if
        ) ;_ end of foreach
          (setq
        ht1 (float (getint "Укажите высоту текста -> "))
        pt1 (getpoint "Укажите местоположение списка -> ")
        Y-delta (+ ht1 (/  ht1 2))
        X1 (nth 0 pt1)
        Y1 (nth 1 pt1)
        Z1 (nth 2 pt1)
        num1 0
    )
    (vl-cmdf "_.text" pt1 ht1 "0" "Имя            Количество")
          (while
        (setq item (nth num1 res))
        (setq
            Y1 (- Y1 Y-delta)
            name-block-list (strcat (car item) " ------> " (vl-princ-to-string (cdr item)) "   ---" (rtos Y1))
        )
        (vl-cmdf "_.text" (list X1 Y1) ht1 "0" name-block-list)
        (setq num1 (+ num1 1))
    )
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Лиспер · 10.12.2010, 15:53

1. Не обрабатывается вариант ненулевой высоты, заданной в текущем стиле.
2. Что там с привязками, гришь?

NEDIS · 10.12.2010, 16:03

Цитата:

Сообщение от Лиспер

1. Не обрабатывается вариант ненулевой высоты, заданной в текущем стиле.
2. Что там с привязками, гришь?

1. Подробнее где чего не обрабатывается

.
2. Не понял при чем тут привязки?.

Лиспер · 10.12.2010, 16:08

1) сделай в текстовом стиле фиксированную высоту, код вообще работать перестанет
2) http://forum.dwg.ru/showthread.php?p...%29#post368691

NEDIS · 10.12.2010, 16:17

Цитата:

Сообщение от Лиспер

1) сделай в текстовом стиле фиксированную высоту, код вообще работать перестанет
2) http://forum.dwg.ru/showthread.php?p...%29#post368691

1. Есть код обработки ненулевого слоя для примера
2. Как программно выключить, а потом включить привязку. (вручную отключил привязку и все заработало)

Лиспер · 10.12.2010, 16:20

1. Я говорю не про слой, а про высоту, заданную в описании текстового стиля.
2. http://forum.dwg.ru/showpost.php?p=640928&postcount=26

NEDIS · 10.12.2010, 16:23

Цитата:

Сообщение от Лиспер

1. Я говорю не про слой, а про высоту, заданную в описании текстового стиля.
2. http://forum.dwg.ru/showpost.php?p=640928&postcount=26

Прошу прощение, оговорился это и имел ввиду. Попробовал в настройках стиля ввести высоту не ноль. Посыпались ошибки. Как избежать?

Лиспер · 10.12.2010, 16:31

Лучше всего вообще создавать текст программным методом, не прибегая к командам. А так - классика: проверять значение, возвращаемое

Код:

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

(cdr (assoc 40 (entget (tblobjname "style" (getvar "textstyle")))))

Do$ · 10.12.2010, 16:40

Дело было вечером, делать было нечего...

Код:

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

(defun blockin (/ adoc selset res name hgt pt)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (and (setq selset	(vl-catch-all-apply
			  '(lambda ()
			     (prompt "Выберите блоки:")
			     (ssget '((0 . "INSERT")))
			   ) ;_ end of lambda
			) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	   (not (vl-catch-all-error-p selset))
      ) ;_ end of and
    (progn
      (foreach blk
	       (mapcar
		 'vlax-ename->vla-object
		 (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
	       ) ;_ end of mapcar
	(setq
	  name (cond
		 ((and (vlax-property-available-p blk 'isdynamicblock)
		       (= (vla-get-isdynamicblock blk) :vlax-true)
		  ) ;_ end of and
		  (vla-get-effectivename blk)
		 )
		 (t (vla-get-name blk))
	       ) ;_ end of cond
	) ;_ end of setq
	(if (member name (mapcar 'car res))
	  (setq	res (subst (cons name (1+ (cdr (assoc name res))))
			   (assoc name res)
			   res
		    ) ;_ end of subst
	  ) ;_ end of setq
	  (setq res (append res (list (cons name 1))))
	) ;_ end of if
      ) ;_ end of foreach
      (if (and (setq res (mapcar '(lambda (a) (cons (car a) (itoa (cdr a)))) res)
		     pt	 (vl-catch-all-apply
			   '(lambda ()
			      (initget 1)
			      (getpoint "\nТочка вставки текста:")
			    ) ;_ end of lambda
			 ) ;_ end of vl-catch-all-apply
	       ) ;_ end of setq
	       (listp pt)
	       (setq hgt
		      (vl-catch-all-apply
			'(lambda () (initget 1) (getreal "\nВысота текста:"))
		      ) ;_ end of vl-catch-all-apply
	       ) ;_ end of setq
	       (numberp hgt)
	  ) ;_ end of and
	(progn
	  (vla-startundomark adoc)
	  (entmakex (list '(0 . "TEXT")
			  '(1 . "Имя - Количество")
			  (cons 10 pt)
			  (cons 40 hgt)
		    ) ;_ end of list
	  ) ;_ end of entmakex
	  (while res
	    (entmakex
	      (list
		'(0 . "TEXT")
		(cons 1
		      (strcat (car (car res)) " - " (cdar res) "шт.")
		) ;_ end of cons
		(cons 10
		      (setq pt (list (car pt)
				     (- (cadr pt) (* 1.6 hgt))
				     (last pt)
			       ) ;_ end of list
		      ) ;_ end of setq
		) ;_ end of cons
		(cons 40 hgt)
	      ) ;_ end of list
	    ) ;_ end of entmakex
	    (setq res (cdr res))
	  ) ;_ end of while
	  (vla-endundomark adoc)
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

NEDIS · 10.12.2010, 16:57

Do$, Лиспер - спасибо большое ... дома буду разбираться

Do$ · 10.12.2010, 17:05

А учитывая замечание Лиспера (#8) можно сделать так:

Код:

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

(defun blockin (/ adoc selset res name hgt pt)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (and (setq selset	(vl-catch-all-apply
			  '(lambda ()
			     (prompt "Выберите блоки:")
			     (ssget '((0 . "INSERT")))
			   ) ;_ end of lambda
			) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	   (not (vl-catch-all-error-p selset))
      ) ;_ end of and
    (progn
      (foreach blk
	       (mapcar
		 'vlax-ename->vla-object
		 (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
	       ) ;_ end of mapcar
	(setq
	  name (cond
		 ((and (vlax-property-available-p blk 'isdynamicblock)
		       (= (vla-get-isdynamicblock blk) :vlax-true)
		  ) ;_ end of and
		  (vla-get-effectivename blk)
		 )
		 (t (vla-get-name blk))
	       ) ;_ end of cond
	) ;_ end of setq
	(if (member name (mapcar 'car res))
	  (setq	res (subst (cons name (1+ (cdr (assoc name res))))
			   (assoc name res)
			   res
		    ) ;_ end of subst
	  ) ;_ end of setq
	  (setq res (append res (list (cons name 1))))
	) ;_ end of if
      ) ;_ end of foreach
      (if (and (setq res (mapcar '(lambda (a) (cons (car a) (itoa (cdr a)))) res)
		     pt	 (vl-catch-all-apply
			   '(lambda ()
			      (initget 1)
			      (getpoint "\nТочка вставки текста:")
			    ) ;_ end of lambda
			 ) ;_ end of vl-catch-all-apply
	       ) ;_ end of setq
	       (listp pt)
	       (or
		 (not (equal
			0.0
			(setq
			  hgt (cdr (assoc
				     40
				     (entget (tblobjname
					       "style"
					       (getvar "textstyle")
					     ) ;_ end of tblobjname
				     ) ;_ end of entget
				   ) ;_ end of assoc
			      ) ;_ end of cdr
			) ;_ end of setq
			1e-8
		      ) ;_ end of equal
		 ) ;_ end of not
		 (setq hgt (vl-catch-all-apply
			     '(lambda ()
				(initget 1)
				(getreal "\nВысота текста:")
			      ) ;_ end of lambda
			   ) ;_ end of vl-catch-all-apply
		 ) ;_ end of setq
	       ) ;_ end of or
	       (numberp hgt)
	  ) ;_ end of and
	(progn
	  (vla-startundomark adoc)
	  (entmakex (list '(0 . "TEXT")
			  '(1 . "Имя - Количество")
			  (cons 10 pt)
			  (cons 7 (getvar "textstyle"))
			  (cons 40 hgt)
		    ) ;_ end of list
	  ) ;_ end of entmakex
	  (while res
	    (entmakex
	      (list
		'(0 . "TEXT")
		(cons 1
		      (strcat (car (car res)) " - " (cdar res) "шт.")
		) ;_ end of cons
		(cons 10
		      (setq pt (list (car pt)
				     (- (cadr pt) (* 1.6 hgt))
				     (last pt)
			       ) ;_ end of list
		      ) ;_ end of setq
		) ;_ end of cons
		(cons 7 (getvar "textstyle"))
		(cons 40 hgt)
	      ) ;_ end of list
	    ) ;_ end of entmakex
	    (setq res (cdr res))
	  ) ;_ end of while
	  (vla-endundomark adoc)
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

NEDIS · 14.12.2010, 15:45

Ну Мужики спасибо огромное ... расти и расти до Вас

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
некорректная и неустойчивая работа BOUNDARY в режиме "Pick Points"	АлексЮстасу	Баги и пожелания в Autodesk	10	25.03.2010 03:39
некорректная работа команды format-layer autocad 2007	clod1	AutoCAD	2	13.03.2010 16:17
Некорректная работа Quick Select	Serge_Y	AutoCAD	6	01.07.2009 14:19
SCAD. Команда "Разделение элементов". Некорректная работа	Den_Den	SCAD	4	04.12.2008 16:51