Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2005.01.30;
Скачать: [xml.tar.bz2];

Вниз

Господа, кто писал под Автокад?   Найти похожие ветки 

 
syte_ser78 ©   (2005-01-12 11:30) [0]

сабж


 
DiamondShark ©   (2005-01-12 11:37) [1]

Удалено модератором


 
syte_ser78 ©   (2005-01-12 11:46) [2]

Не совсем коректный вопрос.
Ктонибудь из вас писал под Автокад?


 
Чеширский_Кот ©   (2005-01-12 12:10) [3]

Удалено модератором


 
syte_ser78 ©   (2005-01-12 12:12) [4]

Ктонибудь под Автокад писал?


 
REP ©   (2005-01-12 12:40) [5]

-Вы когда-нибудь имели гомосексуалиста?
-Нет, но я имел человека, который имел гомосексуалиста.

**********************
Я знаю человека, который пишет под автокад.
Могу спросить его, если есть конкретные вопросы.


 
k2 ©   (2005-01-12 12:56) [6]

да


 
syte_ser78 ©   (2005-01-12 13:00) [7]

REP ©   (12.01.05 12:40) [5]
Нижеприведенная процедура ищет блоки штампов в акадовских чертежах и сохраняет из заполнение в бд, но... в некоторых случаях при нахождении штампа процедура берет не тот блок для обработки. А, Б, С - для отладки

//ФУНКЦИЯ ПОЛУЧЕНИЯ АТРИБУТОВ ИЗ ШТАМПА АКАДА
procedure search_atrib_dwg(dwg_file_name:string);
var
 adoc, atr, itm : variant;
 acd:variant;
 adress:string;
 mds:variant;
 t, k : integer;
 i,ii:integer;
 a,b,c:string;
begin
 try
   acd := GetActiveOleObject( "AutoCad.Application");
 except
   acd := CreateOLEObject( "AutoCad.Application");
 end;
 acd.Visible := true;
 try
   adoc := acd.Documents.Open(dwg_file_name);
 except
 end;
//нижеследующий код - ошибка природы, но он - рабоатет!
//ФИГ ТАМ. РАБОТАЕТ НО НЕ ВСЕГДА
 mds := adoc.ModelSpace;
 t:=mds.Count-1;
   begin
   itm := mds.Item(t);
   if (itm.ObjectName = "AcDbBlockReference") then
     begin
     for i:=1 to acd.ActiveDocument.Database.Blocks.Count-1 do
       begin
       a:=acd.ActiveDocument.Database.Blocks.Item(i).name;
       if (a="Штамп_СПДС") or (a="Штамп_РЧ") or (a="Штамп_РЧ_2") or (a="SHTAMP") then
         begin
         if itm.hasattributes then //ТУТА ПРОБЛЕМКИ. БЛОК НАХОДИТСЯ, А АТРИБУТЫ НЕТ
           begin
           atr:=itm.getattributes;
           if not frm_main.tbl_file_atrib.Locate("LINK",dwg_file_name,[]) then
             begin
             frm_main.tbl_file_atrib.Append;
             frm_main.tbl_file_atribLINK.AsString:=dwg_file_name;
             for k:= VarArrayLowBound(atr,1) to VarArrayHighBound(atr,1) do
               begin
                 begin
                 a:=acd.ActiveDocument.Database.Blocks.Item(i).name;
                 c:=itm.name[i];
                 b:=atr[k].Tagstring;
                 if atr[k].Tagstring="Ф_РАЗРАБ" then
                   frm_main.tbl_file_atribDESIGNER.AsString:=atr[k].TextString;
                 if atr[k].Tagstring="ИНЖ1" then
                   frm_main.tbl_file_atribDESIGNER.AsString:=atr[k].TextString;
   ...
   ...
                 end;
               end;
             frm_main.tbl_file_atrib.post;
             end;
           end;
         end;
       end;
     end;
   end;
//до сюда код - ошибка природі.
   acd.Documents.close;
end;


 
REP ©   (2005-01-12 13:18) [8]

syte_ser78 ©   (12.01.05 13:00) [7]
Хм... к сожалению. этот человек пишет непосредственно под Автокад (LISP), а Delphi не знает совсем.
Извини, не понял вопроса. (просто бывает спрашивают про другие языки программирования PHP например...)


 
k2 ©   (2005-01-12 13:56) [9]

Времени немножко нехватка разобраться с твоим кодом, попробуй запустить процедурку, если твои аттрибуты не найдутся, то возможно проблема в файле, блоки возможно ExternalReference или ещё куча причин, если што я в чате часик побуду, удачи

procedure GetAttributesInfoFromActiveDocument;
var
 acad: AcadApplication;
 adoc: AcadDocument;
 mp: AcadModelSpace;
 i, j: integer;
 bref: IAcadBlockReference;
 attrs: OleVariant;
 obj: IDispatch;
 atref: IAcadAttributeReference;
begin
 try
   acad := GetActiveOleObject("AutoCad.Application")as AcadApplication;
 except
   showmessage("Запустите Автокад");
 end;
 if not assigned(acad) then
   exit;
 adoc := acad.ActiveDocument;
 mp := adoc.ModelSpace;
 form1.memo1.Clear;
 for i := 0 to pred(mp.Count) do begin
   if mp.Item(i).ObjectName = "AcDbBlockReference" then begin
     bref := mp.Item(i) as IAcadBlockReference;
     Form1.Memo1.Lines.Add("*** BlockReferenceName: " + bref.Name + "***");
     end
   else
     continue;
   if bref.HasAttributes then
     attrs := bref.GetAttributes
   else
     continue;
   for j := VarArrayLowBound(attrs,1) to VarArrayHighBound(attrs,1) do
     try
       obj := attrs[j];
       atref := obj as IAcadAttributeReference;
       Form1.Memo1.Lines.Add("Аттрибут: "+ atref.TagString + "    Значение аттрибута: " + atref.TextString);
     except
       Form1.Memo1.Lines.Add(Ошибка определения аттрибута.");
     end;
   end;
end;


 
syte_ser78 ©   (2005-01-12 14:43) [10]

ОГРОМНОЕ СПАСИБО!!!!!!!!!!!!!!


 
syte_ser78 ©   (2005-01-12 15:15) [11]

Еще вопрос с К2
Есть огромные чертежи из которых меня интересует всего один блок (штамп). Может проще использовать qselect для выбора этого блока а не перебирать все блоки?


 
k2 ©   (2005-01-13 11:24) [12]

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

procedure TForm1.Button2Click(Sender: TObject);
var
 bref: IAcadBlockReference;
 ss: IAcadSelectionSet;
 ft, fd, llp, urp: OleVariant;
 i: integer;
begin
 try
   acad := GetActiveOleObject("AutoCad.Application")as AcadApplication;
 except
   showmessage("Откройте файл.");
 end;
 if not assigned(acad) then
   exit;
 adoc := acad.ActiveDocument;
 mp := adoc.ModelSpace;
 try
   ss := adoc.SelectionSets.Item("ShtampSS");
 except
   ss := adoc.SelectionSets.Add("ShtampSS");
 end;
 if not assigned(ss) then
   exit;
 ss.Clear;
 ft := VarArrayCreate([0, 0], varSmallint);
 fd := VarArrayCreate([0, 0], varVariant);
 ft[0] := 2;
 fd[0] := "ЗнакА";
 llp := VarArrayCreate([0, 2], varDouble);
 urp := VarArrayCreate([0, 2], varDouble);
 llp[0] := 0;    llp[1] := 0;    llp[2] := 0; //можно использовать границы окна или ещё што
 urp[0] := 1000; urp[1] := 1000; urp[2] := 0;
 ss.Select(acSelectionSetWindow, llp, urp, ft, fd);
 ss.Highlight(true);
 acad.Update;
end;


 
k2 ©   (2005-01-13 11:27) [13]

fd[0] := "ЗнакА"; - название блока :) просто проверяла на всякий случай
PS. с продолжением лучше наверное будет в основную перебраться, внешняя почта с работы закрыта к сожалению


 
syte_ser78 ©   (2005-01-13 13:30) [14]

k2 ©   (13.01.05 11:24) [12]
Огромное спасибо тебе еще раз
Пока что вроде вопросов нет. Появятся, встретимся в основной.


 
syte_ser78 ©   (2005-01-13 15:34) [15]

небольшой вопросик по FilterType (ft)
Какое необходимо установить значение если я хочу включить в селекшинсэт несколько блоков (с разным именем) и не уверен что все они есть. Тоесть включить в селекшинсет те блоки имена которых будут перечисленны в fd и которые найдутся в пространстве модели


 
k2 ©   (2005-01-14 03:48) [16]


 ft := VarArrayCreate([0, 3], varSmallint);
 fd := VarArrayCreate([0, 3], varVariant);
 ft[0] := -4;  fd[0] := "<or";
 ft[1] := 2;   fd[1] := "Name1";
 ft[2] := 2;   fd[2] := "Name2";
 ft[3] := -4;  fd[3] := "or>";

В справке и более сложное условие есть, запиши fd в одну строку и поймешь сразу как они генерятся


 
syte_ser78 ©   (2005-01-14 09:23) [17]

Ок. Спасибо. Чуть позже (отметим Старый Новый Год), попробую. С праздничком!



Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2005.01.30;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.5 MB
Время: 0.035 c
1-1105613795
pavel_guzhanov
2005-01-13 13:56
2005.01.30
Как остановить работающую программу?


14-1105492871
aus
2005-01-12 04:21
2005.01.30
Антивирус


1-1106050793
AlexLumpov
2005-01-18 15:19
2005.01.30
Уменьшить rtl70.bpl


14-1105608489
DiamondShark
2005-01-13 12:28
2005.01.30
Проверь свою политическую грамотность!


3-1104177126
NEEDHELP
2004-12-27 22:52
2005.01.30
Oshibka pri vvode dati =(





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский