Подобие прямоугольников по X, Y

Подобие прямоугольников по X, Y · 06.10.2014, 14:34

Подскажите, пожалуйста, может уже есть у кого лисп, который смещает выбранные объекты (прямоугольники), а именно их стороны, в одном направлении. По X, без смещения по У, и наоборот. Спасибо.

Кулик Алексей aka kpblc · 06.10.2014, 14:41

_.move с установленной orthomode = 1

SSTRESS · 06.10.2014, 15:00

Наверное плохо объяснил, я имел ввиду команду offset, только в нужном направлении.

Кулик Алексей aka kpblc · 06.10.2014, 15:11

Ок, строим полилинию по коду:

Код:

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

 (entmakex '((0 . "LWPOLYLINE")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (100 . "AcDbPolyline")
            (90 . 4)
            (70 . 1)
            (43 . 0.0)
            (38 . 0.0)
            (39 . 0.0)
            (10 752.821 1381.72)
            (40 . 0.0)
            (41 . 0.0)
            (42 . 0.0)
            (91 . 0)
            (10 1576.06 1966.78)
            (40 . 0.0)
            (41 . 0.0)
            (42 . 0.0)
            (91 . 0)
            (10 1765.29 1700.51)
            (40 . 0.0)
            (41 . 0.0)
            (42 . 0.0)
            (91 . 0)
            (10 942.059 1115.44)
            (40 . 0.0)
            (41 . 0.0)
            (42 . 0.0)
            (91 . 0)
            (210 0.0 0.0 1.0)
            )
          ) ;_ end of entmakex

В какую сторону и как сдвигать? Что должно получиться в результате? Что значит "offset в нужном направлении"? И на чем "споткнулся" сам?

SSTRESS · 06.10.2014, 15:38

Выполняю мон. пояс по арх. плану. обрисовал все проёмы прямоугольниками. Для того чтобы нанести зоны армирования поперечной арматурой с иным шагом надо увеличить мне прямоугольники на 250 в данном случае по стене в обе стороны (в направлении X для проёмов расположенных горизонтально на плане, в направлении Y для проёмов расположенных вертикально на плане.
Раньше просто офсетил все проёмы и вручную их редактировал командой растянуть. Но сейчас проёмов ОЧЕНЬ много, вот и решил написать сюда, может кто поможет. С лиспом не дружу, только юзаю), так что на вопросы программирования врядли отвечу.

Boxa · 06.10.2014, 16:58

ИМХО, если Вы сами писать ничего не будете и Вам нужен готовый инструмент, то надо было писать не в эту ветку, а сюда: http://forum.dwg.ru/forumdisplay.php?f=33
ЗЫ.
На самом деле Вам бы изменить подход и не отрисовывать прямоугольники, а вставлять соответствующий динамический блок, в котором в одном из видов добавить растяжение на 250 в нужные стороны...
ЗЗЫ.
Где то на форуме был лисп по замене прямоугольников на дин блоки... не так давно проскакивала эта тема...

art_rrc · 06.10.2014, 17:21

Вот на например на VBA. Хватает первый попавшийся ортогональный прямоугольник:

Код:

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

Sub Example_Coordinates()
Dim SelSet1 As AcadSelectionSet
Dim plineObj As AcadLWPolyline
Dim points(7) As Double
Dim Coord As Variant
Dim Entry As AcadEntity
Dim strXY, strL As String
Dim dblL As Double
Dim MinPoint, MaxPoint As Variant
On Error Resume Next
Set SelSet1 = ThisDrawing.SelectionSets.Add("SelS1")
SelSet1.SelectOnScreen
If SelSet1.Count = 0 Then GoTo DavayDoSvidaniya
For Each Entry In SelSet1
    If Entry.ObjectName = "AcDbPolyline" Then
    Set plineObj = Entry
    strXY = ThisDrawing.Utility.GetString(0, "Укажите направление X или Y:  ")
    strL = ThisDrawing.Utility.GetString(0, "Величину смещения:  ")
    If IsNumeric(strL) Then
    'dblL = ThisDrawing.Utility.GetReal("Величину смещения:  ")
    dblL = CDbl(strL)
    If UCase(strXY) = "X" Or UCase(strXY) = "Y" Or _
       UCase(strXY) = "Ч" Or UCase(strXY) = "Н" Then
        Coord = plineObj.Coordinates
        plineObj.GetBoundingBox MinPoint, MaxPoint
        If UCase(strXY) = "X" Or UCase(strXY) = "Ч" Then
            For i = 0 To 6 Step 2
            If Coord(i) = MinPoint(0) Then
                Coord(i) = Coord(i) - dblL
                Else
                Coord(i) = Coord(i) + dblL
            End If
            Next i
        Else
            For i = 1 To 7 Step 2
            If Coord(i) = MinPoint(1) Then
                Coord(i) = Coord(i) - dblL
                Else
                Coord(i) = Coord(i) + dblL
            End If
            Next i
        End If
        GoTo ExitFor
        Else
        GoTo ExitFor
        End If
        Else
        MsgBox ("Некорректная величина смещения!")
        End If
        
    End If
Next
ExitFor:
plineObj.Coordinates = Coord
plineObj.Update
DavayDoSvidaniya:
SelSet1.Delete
End Sub

А вообще Boxa прав, но это уже совсем другая история...
Offtop: ps. Код на выполнение запускал 1 раз.. И был выполнен по методу чукчи.. что вижу то и пою..

SSTRESS · 06.10.2014, 17:31

Не думал что всё настолько сложно, спасибо за попытки.

skkkk · 11.10.2014, 11:10

SSTRESS, я бы, может, и смог помочь, написать лисп, но, во-первых, быстро не обещаю, поскольку много работы, а во-вторых, нужна более развернутая постановка задачи.
1. Каковы критерии отбора? Эти прямоугольники на отдельном слое? Или выбирать нужно мышкой по одному?
2. Я так понял, что нужно удлинять прямоугольник всегда по длинной стороне, т.е., ширина проема всегда больше толщины стены или нет?
3. Смещение в 250 - это фиксированная величина или ее лучше спросить у пользователя? А может, нужно будет укорачивать прямоугольники?
4. Нужно ли после возвращать размеры проемов к начальным значениям? В таком случае, может, стоит создавать на новом временном слое копии прямоугольников и растягивать их, а затем новый слой удалять?

SSTRESS · 13.10.2014, 15:13

Цитата:

Сообщение от skkkk

SSTRESS, я бы, может, и смог помочь, написать лисп, но, во-первых, быстро не обещаю, поскольку много работы, а во-вторых, нужна более развернутая постановка задачи.
1. Каковы критерии отбора? Эти прямоугольники на отдельном слое? Или выбирать нужно мышкой по одному?
2. Я так понял, что нужно удлинять прямоугольник всегда по длинной стороне, т.е., ширина проема всегда больше толщины стены или нет?
3. Смещение в 250 - это фиксированная величина или ее лучше спросить у пользователя? А может, нужно будет укорачивать прямоугольники?
4. Нужно ли после возвращать размеры проемов к начальным значениям? В таком случае, может, стоит создавать на новом временном слое копии прямоугольников и растягивать их, а затем новый слой удалять?

1. Прямоугольники будут на отдельном слое.
2. Так точно.
3. Лучше будет так как вы говорите, может кто-то применит этот лисп под себя.
4. Не знаю как правильно это делается, но для меня лучше было бы старые прямоугольники переносить на слой Defpoints, а новые - оставлять на текущем слое. Или же старые просто удалить(но это не желательно).
Если есть возможность штриховки новых прямоугольников, то в конце спросить штриховать или нет.
У меня ACad2006 sp1, WindowsXP sp3 если что. Спасибо Вам! Буду ждать.

skkkk · 13.10.2014, 16:06

Цитата:

Сообщение от SSTRESS

1. Прямоугольники будут на отдельном слое.

То есть, выбор объектов осуществляться будет до запуска команды? Например, при помощи _QSELECT или _LAYISO? И все предварительно выбранные прямоугольники удлинятся по длинной стороне? А если перед запуском команды объекты не выбраны, то будет предложено выбирать по одному? Или скопом? А полилинии-прямоугольники все замкнутые или нет? А если нет, то точно ли совпадают их крайние точки? Какой командой они были построены? Лучше бы приложить файл с примером.

Цитата:

Сообщение от SSTRESS

3. Лучше будет так как вы говорите, может кто-то применит этот лисп под себя.

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

Цитата:

Сообщение от SSTRESS

4. Не знаю как правильно это делается, но для меня лучше было бы старые прямоугольники переносить на слой Defpoints, а новые - оставлять на текущем слое. Или же старые просто удалить(но это не желательно).

Слой Defpoints я бы трогать не стал, но предложил бы создавать новый слой для новых либо для старых прямоугольников - тут надо подумать, и не мне, в том числе и о том, как его назвать: может к имени старого слоя добавлять суффикс или префикс, или назвать его "Вспомогательный", сделать красным и непечатаемым, если нужно.

Цитата:

Сообщение от SSTRESS

Если есть возможность штриховки новых прямоугольников, то в конце спросить штриховать или нет.

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

1. Если объекты уже выбраны, то программа:
- удлиняет каждый из подходящих под критерии объектов (прямоугольников на слое "...")
- спрашивает, штриховать ли, если да, то штрихует все удлиненные.....Какой-то штриховкой....

ну и так далее.

SSTRESS · 13.10.2014, 19:05

Цитата:

Сообщение от skkkk

То есть, выбор объектов осуществляться будет до запуска команды? Например, при помощи _QSELECT или _LAYISO? И все предварительно выбранные прямоугольники удлинятся по длинной стороне? А если перед запуском команды объекты не выбраны, то будет предложено выбирать по одному? Или скопом? А полилинии-прямоугольники все замкнутые или нет? А если нет, то точно ли совпадают их крайние точки? Какой командой они были построены? Лучше бы приложить файл с примером.

Цитата:
Сообщение от SSTRESS
3. Лучше будет так как вы говорите, может кто-то применит этот лисп под себя.
Пожалуй, величину смещения лучше вывести в настройки, дать возможность задавать ей отрицательные значения - если понадобится вдруг прямоугольники уменьшить. Подумаю над этим.
Цитата:
Сообщение от SSTRESS
4. Не знаю как правильно это делается, но для меня лучше было бы старые прямоугольники переносить на слой Defpoints, а новые - оставлять на текущем слое. Или же старые просто удалить(но это не желательно).
Слой Defpoints я бы трогать не стал, но предложил бы создавать новый слой для новых либо для старых прямоугольников - тут надо подумать, и не мне, в том числе и о том, как его назвать: может к имени старого слоя добавлять суффикс или префикс, или назвать его "Вспомогательный", сделать красным и непечатаемым, если нужно.
Цитата:
Сообщение от SSTRESS
Если есть возможность штриховки новых прямоугольников, то в конце спросить штриховать или нет.
Возможность есть. Только вот в случае, если объекты предварительно не выбраны, спрашивать о штриховке после указания каждого прямоугольника или всех?
В общем, вопросов много, лучше все сразу продумать. По пунктам расписать каждый шаг, примерно так:
Нажать, чтобы открыть

1. Если объекты уже выбраны, то программа:
- удлиняет каждый из подходящих под критерии объектов (прямоугольников на слое "...")
- спрашивает, штриховать ли, если да, то штрихует все удлиненные.....Какой-то штриховкой....

Желательно уже работать с выбранными объектами, а потом запускать команду (). Если нет то выбор производить рамкой с возможностью добавления их.
Все полилинии-замкнутые прямоугольники построены командой_rectang, крайние точки совпадают.
На счёт величины смещения согласен. Но при отрицательным "невозможном" значении, что делать?Ввести его заново или вылет команды?Ведь допустимое отрицательное значение будет отсчитываться от центра фигуры или середины длинной стороны до его меньшей стороны, потому как строить фигуры в отрицательном направлении будет не совсем практично, имхо.
На счёт слоёв, я уже писал, как мне будет лучше, но на какой слой будут перенесены старые прямоугольники для меня не столь важно. Можно задать вопрос оставить их или нет. Если да, то на слой "0" допустим либо новый независимо, главное что б отличался.
На счёт штриховки, задать в конце вопрос штриховать удлинённые или нет. "Нет" - просто отрисовывает новыё прямоугольники, "Да" штрихует некоторым образцом (если возможно реализовать выбор образца будет круто). Как то так.

skkkk · 13.10.2014, 20:05

SSTRESS, как насчет файла с примером?

SSTRESS · 14.10.2014, 10:00

Цитата:

Сообщение от skkkk

SSTRESS, как насчет файла с примером?

Как вариант

skkkk · 14.10.2014, 17:53

Вот набросал кое-что на скорую руку. Черновой, так сказать, вариант. Программа позволяет выбрать и обрабатывает только замкнутые полилинии с четырьмя вершинами. Добавил вначале проверку на "прямоугольность" отсюда (спасибо Эдуарду), но в приложенном файле эта проверка отсеяла добрую часть прямоугольников, углы у которых почему-то оказались 89.9999999 градусов, поэтому я решил эту проверку пока снести. Программа создает в текущем слое копии указанных четырехугольников (приближенных к прямоугольникам), удлиненные по длинным сторонам. С квадратами и четырехугольниками, сильно отличающимися от прямоугольника, программа работает непредсказуемо. После программа задаст вопрос "Штриховать?", и в случае положительного ответа выдаст окно Штриховка. В этом окне нужно нажать кнопку Добавить: выбрать объекты, и программа "подсунет" в ответ на запрос только что созданные объекты. Снова само вернется окно Штриховка, далее в нем нужно выбрать нужные опции и нажать ОК. Можно тестировать, в случае необходимости позднее смогу добавить исправления и нужные проверки.

Код:

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

 (defun C:ExtendRectangle ( / *error* adoc oldCMDECHO ss i new_ss)
	(vl-load-com)
	(defun *error* (msg)   
		(if oldCMDECHO (setvar "CMDECHO" oldCMDECHO))
		(princ msg)
		(vla-EndUndoMark adoc)
		(princ)
	) ;_end of defun *error*
	(vla-StartUndoMark (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))))
	(princ)
	(setq oldCMDECHO (getvar "CMDECHO"))
	(setvar "CMDECHO" 0)
	(if (ssget "_I")
		(if (not (setq ss (ssget "_I" '((0 . "*POLYLINE")(90 . 4)(70 . 1)))))
			(progn 
				(princ "Замкнутые четырехугольники не найдены.")
				(sssetfirst nil nil)
			)
		)
		(setq ss (ssget '((0 . "*POLYLINE")(90 . 4)(70 . 1))))
	) ;_end of if
	(princ)
	(setq i 0 new_ss (ssadd))
	(if (and ss (> (sslength ss) 0))
		(progn
			(setq i 0)
			(repeat (sslength ss)
				(ExtendRectangle (ssname ss i) 250)
				(ssadd (entlast) new_ss)
				(setq i (1+ i))
			) ;_end of repeat
			(princ (strcat "\nСоздано удлиненных четырехугольников: " (vl-princ-to-string i)))
			(princ)
			(initget "Да Нет _Y N")
			(setq kword (getkword "\nШтриховать? [Да/Нет] <Нет>"))
			(if (null kword) (setq kword "N"))
			(if (= kword "Y") 
				(progn 
					(initdia)
					(vl-cmdf "_hatch")
					(if (> (getvar "CMDACTIVE") 0)(vl-cmdf new_ss ""))
					(princ)
				) ;_end of progn
			) ;_end of if
		) ;_end of progn
		(princ "\nЗамкнутые четырехугольники не найдены. Функция завершена.")
	) ;_end of if
	(setvar "CMDECHO" oldCMDECHO)
	(vla-EndUndoMark adoc)
	(princ)
) ;_end of defun

(defun ExtendRectangle (lwpoly dst / crv pt01 pt02 pt03 pt04 pt1 pt2 pt3 pt4)
	(setq crv  (vlax-ename->vla-object lwpoly)
		  pt01 (vlax-curve-getPointAtParam crv 0)
		  pt02 (vlax-curve-getPointAtParam crv 1)
		  pt03 (vlax-curve-getPointAtParam crv 2)
		  pt04 (vlax-curve-getPointAtParam crv 3)
		  pt1 (if (> (distance pt01 pt02) (distance pt01 pt04))
				  (polar pt01 (angle pt02 pt01) dst)
				  (polar pt01 (angle pt04 pt01) dst)
			  
			  ) ;_end of if
		  pt2 (if (> (distance pt02 pt03) (distance pt02 pt01))
				  (polar pt02 (angle pt03 pt02) dst)
				  (polar pt02 (angle pt01 pt02) dst)
			  
			  ) ;_end of if
		  pt3 (if (> (distance pt03 pt04) (distance pt03 pt02))
				  (polar pt03 (angle pt04 pt03) dst)
				  (polar pt03 (angle pt02 pt03) dst)
			  
			  ) ;_end of if
		  pt4 (if (> (distance pt04 pt01) (distance pt04 pt03))
				  (polar pt04 (angle pt01 pt04) dst)
				  (polar pt04 (angle pt03 pt04) dst)
			  
			  ) ;_end of if
	) ;_end of setq
	(vl-cmdf "_PLINE" "_none" pt1 "_none" pt2 "_none" pt3 "_none" pt4 "_C")
) ;_end of defun

SSTRESS · 14.10.2014, 18:58

Углы с таким значением, возможно, по вине Архикада на плане которого я обводил проёмы.
Программа понравилась, для меня то что нужно, огромная благодарность Вам.
А значение смещения редактировать в коде, на сколько я понял?

skkkk · 14.10.2014, 19:58

Ну да, я пока оставил так. Там число "250" только в одном месте. Там и менять

. Если понадобится, выведу в настройки. Надо только подумать, как. Не очень каждый раз вводить значения. Думаю, появятся еще замечания.

Mozgunov · 18.10.2014, 02:00

----- добавлено через ~2 мин. -----

Цитата:

Сообщение от SSTRESS

Углы с таким значением, возможно, по вине Архикада на плане которого я обводил проёмы.
Программа понравилась, для меня то что нужно, огромная благодарность Вам.
А значение смещения редактировать в коде, на сколько я понял?

вместо 250 напиши

Код:

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

 (getint "Введите приращение:\n")

и попросит она ввести приращение.

gomer · 18.10.2014, 02:26

Пользовательские настройки обычно выносятся в начала кода и документируются

skkkk · 18.10.2014, 12:52

Цитата:

Сообщение от Mozgunov

вместо 250 напиши

Цитата:

Сообщение от gomer

Пользовательские настройки обычно выносятся в начала кода и документируются

Mozgunov, а если понадобиться вводить не целое число? Тогда уж лучше getdist, а не getint или getreal. Так у пользователя будет возможность не только ввести значение с клавиатуры, но и указать расстояние прямо на чертеже по двум точкам.
Да не просто так, а еще и с обработкой пустого ввода и выводом в подсказку значения по умолчанию или последнего введенного значения? чтобы получить его при нажатии правой кнопки или Enter. Это все можно легко добавить, главное, чтоб это было кому-нибудь нужно.

Mozgunov · 18.10.2014, 13:29

Цитата:

Сообщение от skkkk

Mozgunov, а если понадобиться вводить не целое число? Тогда уж лучше getdist, а не getint или getreal. Так у пользователя будет возможность не только ввести значение с клавиатуры, но и указать расстояние прямо на чертеже по двум точкам.
Да не просто так, а еще и с обработкой пустого ввода и выводом в подсказку значения по умолчанию или последнего введенного значения? чтобы получить его при нажатии правой кнопки или Enter. Это все можно легко добавить, главное, чтоб это было кому-нибудь нужно.

Ну да. Но размеров проемов с плавающей точкой я не видел. Может какие-то очень точные проемы если. По поводу проверок понятно.

skkkk · 18.10.2014, 15:57

Речь ведь может пойти не только о проемах. Я считаю, в данном случае универсальнее вещественное число, к тому же эта универсальность не требует никаких дополнительных телодвижений от пользователя, пусть вбивает что хочет: хоть int, хоть real. Другой вопрос, когда речь идет не о расстоянии, а о количестве предметов, например. Тогда ввод real недопустим.

Mozgunov · 18.10.2014, 16:21

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

06.10.2014, 14:34		#1
Подобие прямоугольников по X, Y SSTRESS Регистрация: 18.12.2008 Сообщений: 23 Подскажите, пожалуйста, может уже есть у кого лисп, который смещает выбранные объекты (прямоугольники), а именно их стороны, в одном направлении. По X, без смещения по У, и наоборот. Спасибо.
Просмотров: 6657

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Команда Подобие работает некорректно	lurkin	AutoCAD	11	16.07.2013 12:47
LISP. Подсчет кол-ва прямоугольников, с их маркировкой и offset-ом	AndruxaZ	LISP	8	13.05.2013 06:42
Подобие выбранных замкнутых полилиний (прямоугольников).	SSTRESS	Программирование	5	29.11.2012 20:17
как сделать подобие (смещение) блока	Iskander111	AutoCAD	2	04.04.2012 20:01
Как построить за раз много прямоугольников?	anthonyS	AutoCAD	37	20.05.2010 12:49