[Constructor450]

Как в VBA возвратить начальную и конечную точку размерности?

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

Дело вот в чем (уж прости, снова влезу). У тебя нет прямой необходимости сразу открывать Excel и работать в него (это во-первых). Вполне достаточно просто создавать текстовый файл (дав ему расширение xls), разделяя данные тэгом табуляции. А потом уже можно будет попробовать и Excel на него натравить (хотя на фига, не очень понимаю).
Теперь по коду. У тебя не все данные учитываются - в частности, нет данных по вектору выдавливания (normal, она же группа 210). А так... Вот примерный вариант вывода на лиспе в текстовый файл:

Код:

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

(defun seltofile (/ selset file_name file_handle *error* res)
  (defun *error* (msg)
    (vl-catch-all-apply '(lambda () (close file_handle)))
    (princ msg)
    (princ)
    ) ;_ end of defun

  (if (and (setq selset (ssget))
	   (setq file_name (getfiled "Файл результата:" "" "xls" 1))
	   ) ;_ end of and
    (progn
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
	(setq
	  res
	   (append res
		   (list (cons (assoc 100
				      (cdr (vl-member-if
					     '(lambda (x) (= (car x) 100))
					     (entget ent)
					     ) ;_ end of vl-member-if
					   ) ;_ end of cdr
				      ) ;_ end of assoc
			       (vl-remove-if
				 '(lambda (x)
				    (or	(member (car x) '(-1 0 5 330 102 100))
					(member (cdr x) '("AcDbEntity"))
					) ;_ end of or
				    ) ;_ end of lambda
				 (entget ent)
				 ) ;_ end of vl-remove-if
			       ) ;_ end of cons
			 ) ;_ end of list
		   ) ;_ end of append
	  ) ;_ end of setq
	) ;_ end of foreach
      (setq file_handle (open file_name "w"))
      (foreach item res
	(write-line
	  (vl-string-trim
	    "()"
	    (vl-string-trim
	      "\t"
	      (apply
		'strcat
		(mapcar
		  '(lambda (x)
		     (strcat (vl-string-trim "()" (vl-princ-to-string x)) "\t")
		     ) ;_ end of LAMBDA
		  (mapcar 'cdr item)
		  ) ;_ end of mapcar
		) ;_ end of apply
	      ) ;_ end of vl-string-trim
	    ) ;_ end of vl-string-trim
	  file_handle
	  ) ;_ end of WRITE-LINE
	) ;_ end of foreach
      (close file_handle)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

[Constructor450]

Даа...Силен лисп.
Попробую разобраться. Спасибо!

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

Блин, там пара строк лишние... Вроде особо режущее глаза снес:

Код:

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

(defun seltofile (/ selset file_name file_handle *error* res)
  (defun *error* (msg)
    (vl-catch-all-apply '(lambda () (close file_handle)))
    (princ msg)
    (princ)
    ) ;_ end of defun

  (if (and (setq selset (ssget))
      (setq file_name (getfiled "Файл результата:" "" "xls" 1))
      ) ;_ end of and
    (progn
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
   (setq
     res
      (append res
         (list (cons (assoc 100
                  (cdr (vl-member-if
                    '(lambda (x) (= (car x) 100))
                    (entget ent)
                    ) ;_ end of vl-member-if
                  ) ;_ end of cdr
                  ) ;_ end of assoc
                (vl-remove-if
             '(lambda (x)
                (member (car x) '(-1 0 5 330 102 100))
                ) ;_ end of lambda
             (entget ent)
             ) ;_ end of vl-remove-if
                ) ;_ end of cons
          ) ;_ end of list
         ) ;_ end of append
     ) ;_ end of setq
   ) ;_ end of foreach
      (setq file_handle (open file_name "w"))
      (foreach item res
   (write-line
     (vl-string-trim
       "()"
       (vl-string-trim
         "\t"
         (apply
      'strcat
      (mapcar
        '(lambda (x)
           (strcat (vl-string-trim "()" (vl-princ-to-string x)) "\t")
           ) ;_ end of LAMBDA
        (mapcar 'cdr item)
        ) ;_ end of mapcar
      ) ;_ end of apply
         ) ;_ end of vl-string-trim
       ) ;_ end of vl-string-trim
     file_handle
     ) ;_ end of WRITE-LINE
   ) ;_ end of foreach
      (close file_handle)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

[Constructor450]

(progn
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))

Чего-то не пойму почему здесь (mapcar 'cadr (ssnamex selset))), можно наверно просто:
(progn
(foreach ent (vl-remove-if 'listp (ssname selset))
:?:

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

Код:

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

_$ (vl-remove-if 'listp (ssname (ssget)))
ERRNO # 0: too few arguments

Добавлено:

Код:

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

_$ (vl-remove-if 'listp (ssnamex (ssget)))
nil

---
Добавлено 2: Естественно, что (ssget) возвращает у меня набор. Чтобы не быть совсем голословным:

Код:

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

_$ (setq selset (ssget))
<Selection set: c>
_$ (SSLENGTH selset)
10
_$ (vl-remove-if 'listp (ssname selset))
ERRNO # 0: too few arguments
_$ (vl-remove-if 'listp (ssnamex selset))
nil

[Constructor450]

Я разобрался вроде бы, почему ошибки небыло, надобыло презагрузить приложение.
Этот язык сведет меня с ума.
Жду книгу Полещука.