Как выявить 3Д чертежи из тысяч штук?

21.10.2005, 17:54

Как в массе тысяч чертежей выявить те, что имеют 3Д элементы?
Как сделать это стандартными средствами поиска Windows?

{Smirnoff} · 01.11.2005, 14:54

>Лентяй

Всё хорошо, только ИМХО пользоваться Total Comander, как то не очень. Попробуй мою новую писанину.

1-й аргумент. Если T- ищет файлы в указанной папке и подпапках, если Nil то только в указанной папке.
2-й аргумент. Если Т- ищет *.DWG.
3-й аргумент. Если Т- ищет *.DXF.

Файлы в списке располагаются в порядке их следования вниз по "дереву".

Надо бы было ещё обработчик ошибок написать, для подчистки сторонних VLA-объектов, в случае "крушения"...

Код:

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

(defun asmi-GetSubFolderDrawings(
			       
                             ;;;*** ARGUMENTS ***
			       
			     SubFolders	; if not Nil gets files in subfolders
			     Dwg	; if not Nil gets *.dwg files
			     Dxf	; if not Nil gets *.dxf files
			     
			     / Count curDir winMes
			     Direct dirLst dwgLst itm
			     itmCol itmCount ShellApp
			     )
  (vl-load-com)
  (if SubFolders
    (setq winMes "Get files in selected Folder and Subfolders")
    (setq winMes "Get files in selected Folder")
    ); end if
  (if
    (and
    (setq ShellApp
	   (vla-getInterfaceObject
	     (vlax-get-acad-object)
	     "Shell.Application"))
    (setq Direct
	   (vlax-invoke-method ShellApp 'BrowseForFolder
	     0 winMes 0))
	  ); end and
    (progn
      (setq dirLst(list Direct)
	    dwgLst '()
	    ); end setq
      (vlax-release-object ShellApp)
      (setq ShellApp nil)
      (while dirLst
	(setq curDir(car dirLst)
	      itmCol(vlax-invoke-method curDir 'Items)
	      itmCount(vlax-get-property itmCol 'Count)
	      Count 0
	      ); end setq
	(repeat itmCount
	  (setq itm(vla-item itmCol Count))
	  (cond
	    ((and Dwg
	     (= "AutoCAD Drawing"(vlax-get-property itm 'Type))
	      ); end and
	    (setq dwgLst
	     (append dwgLst
		     (list(vla-get-Path itm))))
	    (vlax-release-object itm)
	    (setq itm nil)
	    ); end condition #1
	    ((and Dxf
	     (= "AutoCAD Drawing Interchange"(vlax-get-property itm 'Type))
	      ); end and
	    (setq dwgLst
	     (append dwgLst
		     (list(vla-get-Path itm))))
	    (vlax-release-object itm)
	    (setq itm nil)
	    ); end condition #2
	    ((and SubFolders
	       (= :vlax-true(vlax-get-property itm 'IsFolder))
	       ); end and
	     (setq dirLst
		    (append dirLst
		      (list(vlax-get-property itm 'GetFolder))))
	     ); end condition #3
	  ); end cond
	  (setq Count(1+ Count))
	  ); end repeat
	(setq dirLst(cdr dirLst))
	(vlax-release-object curDir)
	(setq curDir nil)
	); end while
      ); end progn
    ); end if
  dwgLst
  ); end of asmi-GetSubFolderDrawings

{Smirnoff} · 01.11.2005, 23:57

Если кто использовал предыдущую функцию, то замените её на новую. У старой наблюдалась большая утечка оперативки.

Код:

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

(defun asmi-GetSubFolderDrawings(
                
                             ;;;*** ARGUMENTS ***
                
              SubFolders   	; if not Nil gets files in subfolders
              Dwg   		; if not Nil gets *.dwg files
              Dxf   		; if not Nil gets *.dxf files
	      Message		; Window message (string)	
              
              / Count curDir winMes
              Direct dirLst dwgLst itm
              itmCol itmCount ShellApp
	      folItm itType
              )
  (vl-load-com)
  (if
    (and
    (setq ShellApp
      (vla-getInterfaceObject
        (vlax-get-acad-object)
        "Shell.Application"))
    (setq Direct
      (vlax-invoke-method ShellApp 'BrowseForFolder
        0 Message 0))
     ); end and
    (progn
      (setq dirLst(list Direct)
       dwgLst '()
       ); end setq
      (vlax-release-object ShellApp)
      (setq ShellApp nil)
      (while dirLst
   (setq curDir(car dirLst)
         itmCol(vlax-invoke-method curDir 'Items)
         itmCount(vlax-get-property itmCol 'Count)
         Count 0
         ); end setq
   (repeat itmCount
     (if
       (and
       (not
	 (vl-catch-all-error-p
	   (setq itm
	    (vl-catch-all-apply
	      'vla-item(list itmCol Count)))))
       (= :vlax-true(vlax-get-property itm 'IsFileSystem))
       (= :vlax-false(vlax-get-property itm 'IsLink))
       ); end and
       (progn
	 (setq itType(vla-get-Type itm))
     (cond
       ((and Dwg
        (= "AutoCAD Drawing" itType)
	     ); end and
       (setq dwgLst
        (append dwgLst
           (list(vla-get-Path itm))))
       ); end condition #1
       ((and Dxf
        (= "AutoCAD Drawing Interchange" itType)
         ); end and
       (setq dwgLst
        (append dwgLst
           (list(vla-get-Path itm))))
       ); end condition #2
       ((and SubFolders
          (= :vlax-true(vlax-get-property itm 'IsFolder))
          ); end and
     (if
       (not
	 (vl-catch-all-error-p
	   (setq folItm
	    (vl-catch-all-apply
	      'vlax-get-property(list itm 'GetFolder)))))
        (setq dirLst
          (append dirLst
            (list folItm)))
       ); end if
        ); end condition #3
     ); end cond
      (vlax-release-object itm)
      (setq itm nil)
        ); end progn
       ); end if
     (setq Count(1+ Count))
     ); end repeat
   (setq dirLst(cdr dirLst))
   (vlax-release-object curDir)
   (setq curDir nil)
   (gc)
   ); end while
      ); end progn
    ); end if
  dwgLst
  ); end of asmi-GetSubFolderDrawings

Лентяй · 02.11.2005, 09:34

Цитата:

{Smirnoff}: Всё хорошо, только ИМХО пользоваться Total Comander, как то не очень.

Ну, дык, эта... Музыкант играет, как умеет. Поэтому стрелять в него низ-з-зя!

Цитата:

Попробуй мою новую писанину.

Попробовал. Функция "Shell.Application" мне очинна понравилась. Это именно то, что нужно и чего я не знал, по каковой причине и пременил свое еорявое посторение путь-через-указание-файла. Так что щирояайшее вам от меня за это мерси. О прочих достоинствах писанины говорить не будем, ибо они очевиды, поговорим лучше о недостатках.
1. В откорркетированном варианте утеряно описание переменной winMes, и непонятно окуда появляеся Message.
2. Не могу представить, при каких условиях выражение

Код:

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

(and (setq ShellApp (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
           (setq Direct (vlax-invoke-method ShellApp 'BrowseForFolder 0 winMes 0)))

может приобретать значение nil, потому как оба подуслувия - всегда Т.
3. Значение

Код:

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

(not (vl-catch-all-error-p (setq itm ...)))

равно Т, если itm не nil. На хрена огород городить, спаршивается? Не проще ли

Код:

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

(if (and (setq itm ...

и далее по тексту?
4.

Код:

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

(and (= :vlax-true (vlax-get-property itm 'IsFileSystem))
                   (= :vlax-false (vlax-get-property itm 'IsLink)));and

- ПМСМ явное излишество, т.к. объект не может быть тем и другим одновременно.
5.

Код:

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

(vla-get-Path itm)

возвращает полное имя файла, а не путь. Поэтому надо применять

Код:

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

(vl-string-right-trim "\\" (vla-get-Path itm))

6.

Код:

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

 (setq dwgLst (append dwgLst (list (vla-get-Path itm)))

Перемудрили-с, батенька. Проще надо быть:

Код:

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

(setq dwgLst (cons (vla-get-Path itm) dwgLst))

7. Проверка на "dfx". Вторично спрашиваю - на хрена? Моя программа с текстовыми файлами не работает.
8.

Код:

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

(if (not (vl-catch-all-error-p (setq folItm (vl-catch-all-apply 'vlax-get-property (list itm 'GetFolder)))))
                       (setq dirLst (append dirLst (list folItm))))

См. п.п. 4 и 5 выше.
9.

Код:

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

(setq Count (1+ Count))

Обрабатывать коллекцию itmCol счетчиком есть, на мой взгляд, дурной тон. Чем вам vlax-for не угодило?
Заключение: Писанина нуждается в доработке. Однако, не смотря на указанные недостатки, вышеобсужденное творение заслуживает быть рекомендованным для применения оной всеми заинтересованными сторонами.

{Smirnoff} · 02.11.2005, 10:08

>Лентяй

Цитата:

1. В откорркетированном варианте утеряно описание переменной winMes, и непонятно окуда появляеся

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

Цитата:

2. Не могу представить, при каких условиях выражение
Код:
(and (setq ShellApp (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
(setq Direct (vlax-invoke-method ShellApp 'BrowseForFolder 0 winMes 0)))

А кнопочку Cancel в окне выбора директории жать не пробывали?

Цитата:

3. Значение

Код:
(not (vl-catch-all-error-p (setq itm ...)))

Ну батенька вы даёте... Оно ж для того чтобы отлавливать ошибку исполнения. Если (vl-catch-all-error-p не отлавливает ошибки значит исполняется остальное. Ни T ни Nil в данном случае и в помине нет, есть сообщение о конкретной ошибке.

Цитата:

4.
Код:
(vla-get-Path itm)
возвращает полное имя файла, а не путь. Поэтому надо применять

Надо было для понятности писать (vlax-get-property itm 'Path). В данном случае это свойство 'Path объекта типа FolderItem. Данный объект не Автокадовский и данное его свойство возвращает именно полный путь.

Цитата:

5.
Код:
(setq dwgLst (append dwgLst (list (vla-get-Path itm)))
Перемудрили-с, батенька. Проще надо быть:
(setq dwgLst (cons (vla-get-Path itm) dwgLst))

Дело вкуса, но наверное по твоему лучше.

Цитата:

6. Проверка на "dfx". Вторично спрашиваю - на хрена? Моя программа с текстовыми файлами не работает.

Причём здесь твоя программа. Я это больше для себя писал. Не нужен *.DXF поставь nil.

Цитата:

8.
Код:
(setq Count (1+ Count))
Обрабатывать коллекцию itmCol счетчиком есть, на мой взгляд, дурной тон. Чем вам vlax-for не угодило?

Хе, хе...

А ты попробуй обработать коллекцию не Автокадовских Объектов vlax-for. Доложи о результатах. Или сразу догадаешься?

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

Лентяй · 02.11.2005, 11:01

Цитата:

{Smirnoff}: А кнопочку Cancel в окне выбора директории жать не пробывали?

Ох, кум, умеешь ты уговорить!

(С)

Цитата:

В данном случае это свойство 'Path объекта типа FolderItem. Данный объект не Автокадовский и данное его свойство возвращает именно полный путь.

Не знаю, не знаю. :? У меня itm случился быть bak-файлом, так вернулось его полное имя.

Цитата:

Причём здесь твоя программа. Я это больше для себя писал. Не нужен *.DXF поставь nil.

Тема у нас какая? Поиск файлов с 3D- примитивами. Для этого я помощи страждущему Danilin'у прогу и наваял. Про "Мамаша, не отвлекайтесь!" слышать не приходилось?

Цитата:

А ты попробуй обработать коллекцию не Автокадовских Объектов vlax-for. Доложи о результатах.

Гы-ы-ы, действительно, не хвурываект! :? Ну, и неча здеся интеллект свой показывать!

Мы тута люди простые, все более по делу чертильному... А то приходют всякие и умствують.

{Smirnoff} · 02.11.2005, 11:58

>Лентяй

Ну можно ещё чуть чуть поумничать :?:

Цитата:

Не знаю, не знаю. У меня itm случился быть bak-файлом, так вернулось его полное имя.

Вот все свойства и методы объекта Folder Item приложения Shell Apllication: http://msdn.microsoft.com/library/de...folderitem.asp

Так, для справки если будешь копаться...

Лентяй · 03.11.2005, 09:06

За сылку - спасибо. Что же касается команы vla-get-Path, то

Цитата:

Я, любимый:Код: (vla-get-Path itm) возвращает полное имя файла, а не путь.

{Smirnoff}: Данный объект не Автокадовский и данное его свойство возвращает именно полный путь.

По ссылке же читаем: "Path - Contains the item's full path and name". Так о чем спор, спрашивается?

{Smirnoff} · 03.11.2005, 09:25

>Лентяй

Цитата:

Так о чем спор, спрашивается?

Это я в запарке не понял сути. Так что не о чём

21.10.2005, 17:54
Как выявить 3Д чертежи из тысяч штук? Danilin Сообщений: n/a Как в массе тысяч чертежей выявить те, что имеют 3Д элементы? Как сделать это стандартными средствами поиска Windows?
Просмотров: 7534