В пересечение отрезков ставить точку.

АлексЮстасу · 23 авг 2013

АлексейМанс сказал(а): ↑

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

Нда...

Если бы речь шла только о прямоугольных колоннах, то я бы сразу посоветовал просто выделить прямоугольники вместе с размерами и передвинуть углы колонн вручную на новые точки. Размеры при этом передвинутся, пересчитаются сами. И никаких _adersheet не советовал бы. Вручную быстрее и надежнее.
А Disney как всегда на высоте!

АлексейМанс · 24 авг 2013

to АлексЮстасу это то да, теперь на этой злополучной комплексной стене пользуюсь _adersheet-ом, за что вам огромное спасибо! Гораздо быстрее выходит в чем в ручную, да и стен всего 3 таких на объекте, которых по углам щитов опалубки снимать. А про колонны я "заодним" спрашивал, дабы упростить объяснение, а потом понял что если автоматизировать все, то было бы очень круто =)
to Disney спасибо! Будем пробовать и вспоминать добрым словом =)

Bose Vermesser · 10 фев 2015

Alexandr-GR сказал(а): ↑

Код:

(vl-load-com)
(DEFUN C:GR-INTERS (/)
  (command nil)
  (setq old_CMDECHO (getvar 'CMDECHO))
  (SETVAR 'CMDECHO 0)
  (vl-catch-all-apply 'myINTERS)
  (SETVAR 'CMDECHO old_CMDECHO)
)
(defun myINTERS	(/		  nabor	  gr-lst-krd	ALL-LST-NB
		1$LST		  1$OTR	  FULL-LST	MY&LIST$SEGMENT
		MY&LIST
		)
  (setq	gr-lst-krd
	(lambda (nb / i lst)
	  (setq i 0)
	  (repeat (fix (vlax-curve-getEndParam nb))
		(setq lst (cons (LIST (vlax-curve-getPointAtParam nb i)
				  (vlax-curve-getPointAtParam nb (1+ i))
				)
				lst
			  )
		  i  (1+ i)
		)
	  )
	  (setq lst (reverse lst))
	)
  )
  (setq	nabor (ssget '((0 . "*LINE")))
	nabor (vl-remove-if 'listp (mapcar 'cadr (ssnamex nabor)))
  )
  (setq	ALL-LST-NB
	(mapcar
	  (function
		(lambda (x) (gr-lst-krd (vlax-ename->vla-object x)))
	  )
	  nabor
	)
  )
  (REPEAT (1- (length ALL-LST-NB))
	(Setq 1$LST		(car ALL-LST-NB)
	  ALL-LST-NB (vl-remove (car ALL-LST-NB) ALL-LST-NB)
	  FULL-LST  (APPLY 'APPEND ALL-LST-NB)
	)
	(REPEAT (length 1$LST)
	  (Setq 1$OTR		(CAR 1$LST)
		1$LST		(vl-remove (CAR 1$LST) 1$LST)
		MY&LIST$SEGMENT (MAPCAR (FUNCTION
					  (LAMBDA (X)
					(APPLY 'INTERS
						  (APPLY 'APPEND (LIST 1$OTR X))
					)
					  )
					)
					FULL-LST
				)
		MY&LIST		(CONS MY&LIST$SEGMENT MY&LIST)
	  )
	)
  )
  (MAPCAR
	(function
	  (LAMBDA (X)
	(entmakex (list (cons 0 "CIRCLE") (cons 40 0.4) (cons 10 X))
	)
	  )
	)
	(vl-remove nil (apply 'append MY&LIST))
  )
)
(PRINC "\nЗапуск: _GR-INTERS")

пробовал только с полилиниями и отрезками

Нажмите, чтобы раскрыть...

Привет всем! А можно ли сделать так чтобы вместо круга в местах пересечений проставлялись точки? Большое спасибо.

FlaShTroN · 14 фев 2015

Disney, спасибо огромное, утилита просто огонь! хотелось бы только чтобы она еще с точками подружилась

BearDyugin · 16 фев 2015

FlaShTroN сказал(а): ↑

хотелось бы только чтобы она еще с точками подружилась
Нажмите, чтобы раскрыть...

Всё, подружил :) имя команды соответственно polyline_to_point

FlaShTroN · 16 фев 2015

@Disney Большое спасибо! Сейчас чертежи в рабочку будут улетать в два клика. А вообще данную программу нужно развивать, чтобы она стала всенародной любимицей как ваша линейка geo_. Так как в России все стройки в основном прямоугольно-квадратные мое предложение такое. Есть проект нарисованный полилинией ( допустим некий фундамент-пилон-плита-колонна ) Я выполняю съемку. В итоге получаю определенное количество точек. Корректирую их таким образом чтобы остались только 4 точки по углам.. Нажимаю на программу и получаю результат готовый на печать А именно хотелось бы чтобы программа автоматические нашла центр проектного фундамента, нарисовала проектные размеры от условных центральных осей данной конструкции ( тоесть размеров будет 8 штук вокруг всего конструктива), а под ними фактические размеры по 4 точкам. Размеры линейные (строго параллельно проектному объекту или заданной МСК) и аннотивные дабы одним кликом подогнать под нужный масштаб печати. Ну вообщем такие вот мечты-пожелания

Bose Vermesser · 18 фев 2015

Disney сказал(а): ↑

Всё, подружил :) имя команды соответственно polyline_to_point
Посмотреть вложение 47621
Нажмите, чтобы раскрыть...

спасибо!!!

Alexandr-GR · 19 апр 2015

Leonix сказал(а): ↑

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

извиняюсь, сразу не увидел...
надо заменить строку:
Код:
(entmakex (list (cons 0 "CIRCLE") (cons 40 0.4) (cons 10 X))
на
Код:
(entmakex (list (cons 0 "POINT") (cons 10 X))

АЮП · 26 июл 2021

Здравствуйте.
Есть полилиния и её пересекает много других полилиний на всем её протяжении. Необходимо получить точки в местах пересечения полилиний.
Попробовал Ваш лисп, команда GR-INTERS, предлагает выбор - выбираю - пишет Выбрано- далее ничего не происходит, точки в местах пересечения полилиний не появляются.
Наверное, делаю что-то не так.
Autocad civil 3d 2017

--- Сообщения объединены, 26 июл 2021, Оригинальное время сообщения: 26 июл 2021 ---

(PRINC "\nЗапуск: _GR-INTERS")

Эта строка при сохранении кода из Блокнот с расширением LSP - заменяется Запуск на непечатаемые символы. Это влияет на работу этого Лиспа?

FOXXX591 · 26 июл 2021

АЮП, полилинии на одной высоте должны быть вроде.

АЮП · 27 июл 2021

Все полилинии на отметке 0.00
Все вроде работает, указывает количество выбранных полилиний и т.д. - но в местах пересечения полилиний не появляются точки (окружности).
Ничего не изменяется.
Может какие-то системные настройки должны быть указаны?

--- Сообщения объединены, 27 июл 2021, Оригинальное время сообщения: 27 июл 2021 ---

Файл

Alexandr-GR · 30 июл 2021

АЮП сказал(а): ↑

Все полилинии на отметке 0.00
Все вроде работает, указывает количество выбранных полилиний и т.д. - но в местах пересечения полилиний не появляются точки (окружности).
Ничего не изменяется.
Может какие-то системные настройки должны быть указаны?

--- Сообщения объединены, 27 июл 2021, Оригинальное время сообщения: 27 июл 2021 ---

Файл
Нажмите, чтобы раскрыть...

РомаРомаРоман · 15 фев 2025

Alexandr-GR сказал(а): ↑

Код:

(vl-load-com)
(DEFUN C:GR-INTERS (/)
  (command nil)
  (setq old_CMDECHO (getvar 'CMDECHO))
  (SETVAR 'CMDECHO 0)
  (vl-catch-all-apply 'myINTERS)
  (SETVAR 'CMDECHO old_CMDECHO)
)
(defun myINTERS    (/          nabor      gr-lst-krd    ALL-LST-NB
        1$LST          1$OTR      FULL-LST    MY&LIST$SEGMENT
        MY&LIST
        )
  (setq    gr-lst-krd
    (lambda (nb / i lst)
      (setq i 0)
      (repeat (fix (vlax-curve-getEndParam nb))
        (setq lst (cons (LIST (vlax-curve-getPointAtParam nb i)
                  (vlax-curve-getPointAtParam nb (1+ i))
                )
                lst
              )
          i  (1+ i)
        )
      )
      (setq lst (reverse lst))
    )
  )
  (setq    nabor (ssget '((0 . "*LINE")))
    nabor (vl-remove-if 'listp (mapcar 'cadr (ssnamex nabor)))
  )
  (setq    ALL-LST-NB
    (mapcar
      (function
        (lambda (x) (gr-lst-krd (vlax-ename->vla-object x)))
      )
      nabor
    )
  )
  (REPEAT (1- (length ALL-LST-NB))
    (Setq 1$LST        (car ALL-LST-NB)
      ALL-LST-NB (vl-remove (car ALL-LST-NB) ALL-LST-NB)
      FULL-LST  (APPLY 'APPEND ALL-LST-NB)
    )
    (REPEAT (length 1$LST)
      (Setq 1$OTR        (CAR 1$LST)
        1$LST        (vl-remove (CAR 1$LST) 1$LST)
        MY&LIST$SEGMENT (MAPCAR (FUNCTION
                      (LAMBDA (X)
                    (APPLY 'INTERS
                          (APPLY 'APPEND (LIST 1$OTR X))
                    )
                      )
                    )
                    FULL-LST
                )
        MY&LIST        (CONS MY&LIST$SEGMENT MY&LIST)
      )
    )
  )
  (MAPCAR
    (function
      (LAMBDA (X)
    (entmakex (list (cons 0 "CIRCLE") (cons 40 0.4) (cons 10 X))
    )
      )
    )
    (vl-remove nil (apply 'append MY&LIST))
  )
)
(PRINC "\nЗапуск: _GR-INTERS")

пробовал только с полилиниями и отрезками

Нажмите, чтобы раскрыть...

Alexandr-GR сказал(а): ↑

Код:

(vl-load-com)
(DEFUN C:GR-INTERS (/)
  (command nil)
  (setq old_CMDECHO (getvar 'CMDECHO))
  (SETVAR 'CMDECHO 0)
  (vl-catch-all-apply 'myINTERS)
  (SETVAR 'CMDECHO old_CMDECHO)
)
(defun myINTERS    (/          nabor      gr-lst-krd    ALL-LST-NB
        1$LST          1$OTR      FULL-LST    MY&LIST$SEGMENT
        MY&LIST
        )
  (setq    gr-lst-krd
    (lambda (nb / i lst)
      (setq i 0)
      (repeat (fix (vlax-curve-getEndParam nb))
        (setq lst (cons (LIST (vlax-curve-getPointAtParam nb i)
                  (vlax-curve-getPointAtParam nb (1+ i))
                )
                lst
              )
          i  (1+ i)
        )
      )
      (setq lst (reverse lst))
    )
  )
  (setq    nabor (ssget '((0 . "*LINE")))
    nabor (vl-remove-if 'listp (mapcar 'cadr (ssnamex nabor)))
  )
  (setq    ALL-LST-NB
    (mapcar
      (function
        (lambda (x) (gr-lst-krd (vlax-ename->vla-object x)))
      )
      nabor
    )
  )
  (REPEAT (1- (length ALL-LST-NB))
    (Setq 1$LST        (car ALL-LST-NB)
      ALL-LST-NB (vl-remove (car ALL-LST-NB) ALL-LST-NB)
      FULL-LST  (APPLY 'APPEND ALL-LST-NB)
    )
    (REPEAT (length 1$LST)
      (Setq 1$OTR        (CAR 1$LST)
        1$LST        (vl-remove (CAR 1$LST) 1$LST)
        MY&LIST$SEGMENT (MAPCAR (FUNCTION
                      (LAMBDA (X)
                    (APPLY 'INTERS
                          (APPLY 'APPEND (LIST 1$OTR X))
                    )
                      )
                    )
                    FULL-LST
                )
        MY&LIST        (CONS MY&LIST$SEGMENT MY&LIST)
      )
    )
  )
  (MAPCAR
    (function
      (LAMBDA (X)
    (entmakex (list (cons 0 "CIRCLE") (cons 40 0.4) (cons 10 X))
    )
      )
    )
    (vl-remove nil (apply 'append MY&LIST))
  )
)
(PRINC "\nЗапуск: _GR-INTERS")

пробовал только с полилиниями и отрезками

Нажмите, чтобы раскрыть...

Alexandr-GR,

Не подскажите как в коде изменить круги на точки?

АлексЮстасу · 15 фев 2025

РомаРомаРоман сказал(а): ↑

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

Он вроде ж ответил выше в #28.

РомаРомаРоман · 15 фев 2025

АлексЮстасу сказал(а): ↑

Он вроде ж ответил выше в #28.
Нажмите, чтобы раскрыть...

Я изменил строку с CIRCLE на POINT но лисп после просьбы выделить линии уходит в загрузку и не выдает никакого результата

АлексЮстасу · 17 фев 2025

РомаРомаРоман сказал(а): ↑

Я изменил строку с CIRCLE на POINT но лисп после просьбы выделить линии уходит в загрузку и не выдает никакого результата
Нажмите, чтобы раскрыть...

Я попробовал и без замены, и с заменой - работает. Видимо, проблема не из-за этой строки, т.к. в ней меняется только тип создаваемого примитива.

В пересечение отрезков ставить точку.

АлексЮстасу Форумчанин

АлексейМанс Форумчанин

Bose Vermesser Форумчанин

FlaShTroN Форумчанин

BearDyugin Модератор Форумчанин

Вложения:

polyline_to_point.LSP

FlaShTroN Форумчанин

Bose Vermesser Форумчанин

Alexandr-GR Форумчанин

АЮП Форумчанин

FOXXX591 Форумчанин

АЮП Форумчанин

Вложения:

Чертеж1.zip

Чертеж1.7z

Alexandr-GR Форумчанин

РомаРомаРоман

АлексЮстасу Форумчанин

РомаРомаРоман

АлексЮстасу Форумчанин

В пересечение отрезков ставить точку.

АлексЮстасу Форумчанин

АлексейМанс Форумчанин

Bose Vermesser Форумчанин

FlaShTroN Форумчанин

BearDyugin Модератор Форумчанин

Вложения:

polyline_to_point.LSP

FlaShTroN Форумчанин

Bose Vermesser Форумчанин

Alexandr-GR Форумчанин

АЮП Форумчанин

FOXXX591 Форумчанин

АЮП Форумчанин

Вложения:

Чертеж1.zip

Чертеж1.7z

Alexandr-GR Форумчанин

РомаРомаРоман

АлексЮстасу Форумчанин

РомаРомаРоман

АлексЮстасу Форумчанин

Быстрый поиск