Здравствуйте, гость ( Вход | Регистрация )
Here You Can Support Our Work and .:LavTeaM:. Services |
Дата поста: | В теме: | За сообщение: | Спасибо сказали: | ||
---|---|---|---|---|---|
12.03.2012 - 16:33 | AutoCAD 2011 | imageframe установить не в 0 |
yurasevo, | ||
19.10.2011 - 22:41 | Утилиты для AutoCAD | А незачем менять значения размеров Хотя лично я бы, наверное, для решения подобной задачи вообще собственного сочинения лисп использовал. В качестве дополнительных элементов - исключение внешних ссылок из обработки, обработка заблокированных и замороженных слоев, возврат исходных значений, с выделение "отредактированных" цветом. Код, естественно, под конкретные нужды можно подгонять, а так, навскидку: Код (vl-load-com) (defun c:repair-dim (/ adoc lst:layer err) (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for item (vla-get-layers adoc) (if (not (wcmatch (vla-get-name item) "*|*")) (setq lst:layer (cons (list item (mapcar (function (lambda (x / tmp) (setq tmp (vlax-get-property item x)) (vl-catch-all-apply (function (lambda () (vlax-put-property item x :vlax-false) );_ end of lambda );_ end of function );_ end of vl-catch-all-apply (cons x tmp) );_ end of lambda );_ end of function '("freeze" "lock") );_ end of mapcar );_ end of list lst:layer );_ end of cons );_ end of setq );_ end of if );_ end of vlax-for (vlax-for blk_def (vla-get-blocks adoc) (if (and (equal (vla-get-isxref blk_def) :vlax-false) (not (wcmatch (vla-get-name blk_def) "`*D*")) );_ end of and (vlax-for ent blk_def (if (and (wcmatch (strcase (vla-get-objectname ent)) "*DIMENSION") (/= (vla-get-textoverride ent) "") (not (wcmatch (vla-get-textoverride ent) "*<>*")) );_ end of and (vl-catch-all-apply (function (lambda () (vla-put-textoverride ent (strcat "<>" "\\X" (vla-get-textoverride ent) );_ end of strcat );_ end of vla-put-textoverride (vla-put-color ent 1) );_ end of lambda );_ end of function );_ end of vl-catch-all-apply );_ end of if );_ end of vlax-for );_ end of if );_ end of vlax-for (foreach item lst:layer (foreach prop (cdr item) (vl-catch-all-apply (function (lambda () (vlax-put-property (car item) (car prop) (cdr prop)) );_ end of lambda );_ end of function );_ end of vl-catch-all-apply );_ end of foreach );_ end of foreach (vla-endundomark adoc) (princ) );_ end of defun Это я к тому, что совсем необязательно начинать использовать достаточно большие комплексы, если можно обойтись маахонькой утилиткой... |
brainz, tukoan, | ||
12.03.2010 - 21:23 | ИДЕаЛ-А -- новое приложение для AutoCad | ADO (ActiveX Data Object) - механизм доступа к данным в многопользовательском режиме. Гарантированно присутствует в любой Windows, даже если не установлен MS Office. Частичное объяснение есть здесь: http://ru.wikipedia.org/wiki/ADO ; остальное - в любой книге по программированию. Там же можно посмотреть и на разницу между ADO и DAO. |
ideal-a, | ||
2.10.2009 - 21:27 | AutoCAD 200х | flatten из Express Tools или с dwg.ru/dnl/607 использовать команду ConvTo2d |
intrro, | ||
28.05.2009 - 01:06 | Перестают работать некоторые функции в AutoCAD! | 1. На 2007 установить ServicePack 2. Пытаться открывать, например, через BricsCAD. Или DWGTrueView (кажется, так называется). Или DWGGateway. Последнюю софтину где-то у себя видел, если надо - могу поискать и выложить, например, на рапиду. Выложи, если не сложно, ну и скинь мне соответственно ссылку.)) Заранее спасибо. http://rapidshare.com/files/237956363/DWGgateway.msi |
Dayana, | ||
6.05.2009 - 15:26 | VBA for ACAD | Количество листов: Код ThisDrawing.Layouts - 1 Если надо получать все ВЭ, то либо идти через SelectionSet, либо пробовать нечто типа Код Function GetAllViewPorts() As Variant Dim Res() As Object Dim oLayout As AcadLayout, oEnt As AcadEntity For Each oLayout In ThisDrawing.Layouts If Not (UCase(oLayout.Name) Like "*[*]") Then On Error GoTo lErrorReDim For Each oEnt In oLayout.Block If oEnt.ObjectName = "AcDbViewport" Then ReDim Preserve Res(UBound(Res) + 1) Set Res(UBound(Res)) = oEnt End If Next oEnt End If Next oLayout GetAllViewPorts = Res Exit Function lErrorReDim: ReDim Res(0) Resume Next End Function Sub Test() Dim arVP As Variant arVP = GetAllViewPorts End Sub Код я на корректность результата не проверял - тупо некогда |
Agens, | ||
5.05.2009 - 17:45 | VBA for ACAD | Пойми, я лисповик Посему и решение предлагаю "хоть чутка поближе к себе" Код (defun execute-magiexp () А в остальном как и было раньше сказано..(command magiexp "" "_all" "" "") (while (/= (getvar "cmdactive") 0) (command pause) );_ end of while );_ end of defun |
Agens, | ||
5.05.2009 - 15:39 | VBA for ACAD | Под подобные приложения вообще тяжело что бы то ни было пишется. Мне в свое время пришлось "забирать" данные с объектов СПДС 4.0, вот я тогда порадовался, что сделал ставку на лисп... Другими методами добраться до значений тех же узловых выносок было никак невозможно. Ну или использовать C++ / C# / VB.NET и работать уже глубоко внутри ядра. А это надо время учиться, которого мне никто не выделял Ладно, это лирика. А по поводу SendCommand... Я бы, наверное, сделал так: 1. На лиспе пишется нечто типа Код (defun execute-command (cmdname) (command cmdname) (while (/= (getvar "cmdactive") 0) (command pause) );_ end of while );_ end of defun 2. Полученный файл загружается в текущий чертеж (любым из доступных методов) 3. В VBA выполняется нечто типа Код ThisDrawing.SendCommand "(execute-command " & Chr(34) & ИмяВыполняемойКоманды & Chr(34) & ")" & vbCr Только учти, что я подобными играми занимался примерно года три назад, с тех пор так ни разу и не пригодилось. Так что работоспособность метода под бааальшим вопросом. |
Agens, | ||
5.05.2009 - 15:14 | VBA for ACAD | Стоп. А что ты посылаешь в ком.строку? Если набор формировать, то смотри SelectSets.Add (да и так у тебя уже есть аналог; ключи только надо поменять). |
Agens, | ||
5.05.2009 - 14:43 | VBA for ACAD | Пока не забыл: для полноты картины я бы задумался еще и о замороженных слоях. <offtop>Я немного соображаю в лиспе и на основе этого пишу VBA-шный код... Грубо говоря, "портирую" код Но за добрые слова спасибо Приятно, черт возьми </offtop> |
Agens, | ||
5.05.2009 - 14:34 | VBA for ACAD | Сейчас лиспом машина занята по самое не хочу, поэтому пишу насухую Код If Not (ThisDrawing.Layers.Item(objSelSet.Item(i).Layer).Lock) Then по идее для коллекции слоев допускается и нормально срабатывает Item(ИмяСлоя).objSelSet.Item(i).Explode objSelSet.Item(i).Erase End If --- Исправил 1 опечатку и положение 1 скобки |
Agens, | ||
5.05.2009 - 14:25 | VBA for ACAD | А нету у меня такой книги. Встроенной справки зачастую достаточно. Правда, на английском А для сложных вопросов и существуют форумы |
Agens, | ||
5.05.2009 - 14:03 | VBA for ACAD | .Delete просто удалит блок. А где разбитие? Я зануда та еще |
Agens, | ||
5.05.2009 - 12:49 | VBA for ACAD | Ага, с тонкостями... Не обрабатываются "вложенные" блоки. В фильтре выбора нет дополнительной фильтрации по имени блока. В коде нет прямого указания на разбитие блока. |
Agens, | ||
5.05.2009 - 09:43 | VBA for ACAD | Я тоже предпочитаю VisualLISP А так-то по логике все просто: сначала разблокируются и включаются все слои; потом проходим по коллекции блоков. Внутри каждого описания блока проходим по элементам этого блока (пользуясь тем, что, например, пространство модели - тоже описание блока). Если, уже находясь внутри описания какого-то блока, натыкаемся на AcDbBlockReference (то есть вхождение блока), и имя этого блока похоже на sBlockNameExclude, то мы этот элемент расчленяем и удаляем. А потом восстановление состояния слоев в исходное состояние. P.S. Вызывать код можно как Код Sub Test() ExplodeBlocksExcule 'разбить вообще все блоки End Sub Sub Test1() ExplodeBlocksExcule "2" 'Разбить все блоки с именем "2" End Sub Sub Test2() ExplodeBlocksExcule "*2*" ' Разбить все блоки с именами, в которых содержится цифра 2 End Sub |
Agens, | ||
5.05.2009 - 09:21 | VBA for ACAD | Ты вот что определи - у тебя имена блоков твоих есть? Если да, то как вариант (я код не проверял): Код Type typLayer oPointer As Object IsLock As Boolean IsFrozen As Boolean End Type Public Sub ExplodeBlocksExcule(Optional sBlockNameExclude As String) If IsMissing(sBlockNameExclude) Then sBlockNameExclude = "*" Else sBlockNameExclude = UCase(sBlockNameExclude) End If Dim oLayer As AcadLayer, arLayers() As typLayer, iCounter As Integer ReDim arLayers(ThisDrawing.Layers.Count - 1) iCounter = 0 On Error Resume Next For Each oLayer In ThisDrawing.Layers arLayers(iCounter).oPointer = oLayer arLayers(iCounter).IsFrozen = oLayer.Freeze arLayers(iCounter).IsLock = oLayer.Lock oLayer.Freeze = False oLayer.Lock = False Next oLayer On Error GoTo 0 Dim oBlockDef As AcadBlock, oEnt As AcadEntity For Each oBlockDef In ThisDrawing.Blocks For Each oEnt In oBlockDef If oEnt.ObjectName = "AcDbBlockReference" And UCase(oEnt.Name) Like sBlockNameExclude Then oEnt.Explode oEnt.Erase End If Next oEnt Next oBlockDef On Error Resume Next For iCounter = 0 To UBound(arLayers) arLayers(iCounter).oPointer.Lock = arLayers(iCounter).IsLock arLayers(iCounter).oPointer.Freeze = arLayers(iCounter).IsFrozen Next iCounter End Sub |
Agens, | ||
4.05.2009 - 23:34 | VBA for ACAD | А что делать, если блоки лежат в пространствах листов? По-моему, более верным будет код наподобие Код Option Explicit Public Sub EraseBlocks(Optional sBlockName As String) Dim blkRef As AcadBlock If IsMissing(sBlockName) Then sBlockName = "*" On Error Resume Next For Each blkRef In ThisDrawing.Blocks blkRef.Erase Next blkRef Dim oLayout As AcadLayout, blkLay As AcadBlock, oEnt As AcadEntity For Each oLayout In ThisDrawing.Layouts Set blkLay = oLayout.Block For Each oEnt In blkLay If oEnt.ObjectName = "AcDbBlockReference" And UCase(oEnt.Name) Like UCase(sBlockName) Then oEnt.Delete End If Next oEnt Next oLayout End Sub Вечно путаю методы .Erase и .Delete, так что проверяйте. |
Agens, | ||
23.09.2008 - 07:23 | Ваше мнение о политике компании "Нанософт" | gipro, ну если человек хочет обидеться, он обидится Теперь насчет табличного редактора и проч. Excel "прост" не столько потому, что у него история не меньше 15 лет, сколько потому, что (как мне кажется): 1. Он "сам по себе". Данные, вносимые в файл, никак не связаны с графикой. Это в чертеже прямоугольник может быть и вент.отверстием, и столом, и проемом в стене/перекрытии. В Excel'е либо засовывай в разные листы, либо в разные таблицы (кстати, как выводить на печать тогда? руками устанавливать область печати собираешься?), либо вводить дополнительные столбцы и использовать, например, функцию СУММЕСЛИ. В графическом файле такой номер реализовать нереально. 2. Практически любая попытка автоматизировать Excel для получения ГОСТовских таблиц рано или поздно приводит к необходимости писать программы. Или (как минимум) использовать сводные таблицы (а с их созданием не так просто разобраться). Если же не делать этой автоматизации, то работа с Excel'ом мало чем отличаться будет от AutoCAD'овских таблиц - точно так же устанавливай высоту строк, ширины столбцов и вбивай данные. Руками. |
MCAD, | ||
24.07.2008 - 07:21 | AutoCAD 200х | AutoCAD 2008 Eng + SP1, Windows XP SP2 + все обновления (SP3 не ставил): глюк на месте и никуда не делся. Сейчас сижу на работе, а тут 6-й студии нет Поэтому придется делать через VBA... Код Option Explicit Function CreateCombinedRegion(docPointer As AcadDocument, _ PointLowCenter As Variant, _ PointUpCenter As Variant, _ Radius As Double) As AcadEntity ' Piblished by kpblc 24/07/2008 at lavteam.org ' Создание региона с "закруглениями" ' Параметры вызова: ' docPointer -> указатель на активный документ ' PointLowCenter -> массив из 2 чисел Double, нижний центр бывшего кружка ' PointUpCenter -> массив из 2 чисел Double, верхний центр бывшего кружка ' Radius -> радиус закругления. ' Возвращает указатель на созданный регион. ' Никакие ошибки не отслеживаются. Dim docModel As AcadBlock Dim ResRegion As Variant Set docModel = docPointer.ModelSpace Dim tmpArray(0) As AcadEntity Dim tmpLWVertex(7) As Double tmpLWVertex(0) = PointLowCenter(0) - Radius: tmpLWVertex(1) = PointLowCenter(1) tmpLWVertex(2) = PointLowCenter(0) + Radius: tmpLWVertex(3) = PointLowCenter(1) tmpLWVertex(4) = PointUpCenter(0) + Radius: tmpLWVertex(5) = PointUpCenter(1) tmpLWVertex(6) = PointUpCenter(0) - Radius: tmpLWVertex(7) = PointUpCenter(1) Set tmpArray(0) = docModel.AddLightWeightPolyline(tmpLWVertex) tmpArray(0).Closed = True tmpArray(0).SetBulge 0, 1 tmpArray(0).SetBulge 2, 1 ResRegion = docModel.AddRegion(tmpArray) tmpArray(0).Delete Set CreateCombinedRegion = ResRegion(0) End Function Sub Test() Dim lc(2) As Double Dim uc(2) As Double Dim res As AcadEntity lc(0) = 100#: lc(1) = 100# uc(0) = 100#: uc(1) = 560.5 Set res = CreateCombinedRegion(ThisDrawing, lc, uc, 20) End Sub Примерно так... Работает только в мировой системе координат; состояние слоев не отслеживается. |
SNGP.Pavel, | ||
6.04.2008 - 16:31 | Организация чертежа | Попробуй работать с именованными видами - как правило, этого достаточно. |
Valery888, | ||
20.02.2008 - 09:19 | Широкоформатные мониторы | А если поставить расширение в соотношении сторон не 4:3, а 16:9, чего будет? |
sashaiolena, | ||
11.02.2008 - 22:29 | AutoCAD 200х | ruCAD 2.0 лежит на dwg.ru: _http://dwg.ru/dnl/401 _http://dwg.ru/dnl/402 _http://dwg.ru/dnl/403 _http://dwg.ru/dnl/404 _http://dwg.ru/dnl/405 _http://dwg.ru/dnl/406 _http://dwg.ru/dnl/419 _http://dwg.ru/dnl/434 Обозреватель исходных текстов ruSourceExplorer 4.0 : http://dwg.ru/dnl/2548 ruCAD 2.0 поставляется в компилированном виде, без исходников. Крыс, спасибо за совет, Но не особо помогло свойства действительно легче править когда выделишь все объекты - это я просто тупанул - искал какой-то сложный путь а вот с фонтами пробовал не помогает - разные пробовал а Вы сами пробовали набирать несколько строчек? что у Вас получилось ? Ну, меня-то один Откровенно говоря, я ставил эксперименты только над 1-2 строками. Результат (точно так же, как и в случае с обычным _.leader или _.qleader) меня особо не устроил. Но ничего принципиально <нового / лучшего / просто другого> пока в штатном варианте я не видел |
delux, matez, | ||
17.01.2008 - 09:57 | AutoCAD 200х | В ярлыке запуска AutoCAD надо прописать используемый профиль через ключ /p. Примерно так: Код "C:\Program Files\AutoCAD 2005\acad.exe" /p "<<Unnamed Profile>>" Если путь до acad.exe содержит пробелы, его надо заключать в кавычки. Если имя профиля содержит пробелы, его надо заключать в кавычки (если нет - можно и не делать; но вреда от них не будет). |
airflow, | ||
Текстовая версия | Сейчас: 25.04.2024 - 02:40 |