[Gostushev]

коллеги
нужен лисп для работы с типом линии "сварка", т.е у меня есть самостоятельно написанный тип линии, все рисуется нормально, но при выполнении команды "зеркало", к примеру, вся сварка переворачивается шиворот навыворот. Как бы такую програмку, что бы она локально скажем из выбранных секущей рамкой количества линий отыскивала мою сварку и делала бы "поворот" для таких линий относительно средней точки. Они бы чудным образом становились нормально нанесенной сваркой. Может что то подобное и есть. Скажу сразу, что СПДС - не выход.

[EasyD]

Думаю, шиворот-навыворот происходит от того, что при зеркалировании порядок обхода точек полилинии меняется на противоположный (могу ошибаться). Если так, то есть такие lisp-ы, которые этот обход переворачивают (натыкался как-то на просторах интернета!)

[Лентяй]

Ну вот. опять шанс еще одного страждущего осчастливить... Ску-у-учно!!!
Ловите лиспу, пользуйтесь на хздоровье и сугубо и трегубо благодарите меня, любимого, за то, что я есть.

Код:

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

(defun C:MirrLine ( / sp ep)
  (prompt "\nSelect Lines To Mirror")
  (ssget)
  (setq	adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	ass (vla-get-ActiveSelectionSet adoc))
  (vlax-for lob ass
    (setq sp (vla-get-StartPoint lob)
	  ep (vla-get-EndPoint lob))
    (vla-put-StartPoint lob ep)
    (vla-put-EndPoint lob sp));vlax-for
);

[Кулик Алексей aka kpblc]

> Лентяй : так "на х..." или "на здоровье" ? Шутка.
У меня вопрос - можно ли подобное сварганить, но без применения ActiveX-функций?
Причина такого ограничения: лисп под LT идет с поддержкой только vl-* функций (т.е. vla-get-startpoint, vla-get-endpoint и т.п. откажутся работать напрочь). А лиспик весьма нужон.
Прошу прощения, что обращаюсь с такой "тупой" просьбой, но в лиспе я... гхм... в общем, никто я там.

[Chief Justice]

Сообщение от Лентяй Ну вот. опять шанс еще одного страждущего осчастливить... Ску-у-учно!!! Ловите лиспу, пользуйтесь на хздоровье и сугубо и трегубо благодарите меня, любимого, за то, что я есть. Код: [Выделить все] (defun C:MirrLine ( / sp ep) (prompt "\nSelect Lines To Mirror") (ssget) (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) ass (vla-get-ActiveSelectionSet adoc)) (vlax-for lob ass (setq sp (vla-get-StartPoint lob) ep (vla-get-EndPoint lob)) (vla-put-StartPoint lob ep) (vla-put-EndPoint lob sp));vlax-for );

Command: MIRRLINE
Select Lines To Mirror
Select objects: 1 found

Select objects: ; error: ActiveX Server returned the error: unknown name:
StartPoint

[{Smirnoff}]

>Chief Justice

Лентяй забыл сделать так чтобы выбирались только линии и при выборе объектов другого типа (к примеру полилиний) лисп будет выдавать ошибку. Наверное поленился

>kpblc

Вот без VLA-* и VLAX-*:

Код:

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

(defun c:lmir(/ liLst oldDxf newStart newEnd)
  (princ "\n*** Select lines ***")
  (if
    (setq liLst(ssget '((0 . "LINE"))))
  (progn
    (setq liLst
	   (vl-remove-if 'listp
              (mapcar 'cadr(ssnamex liLst))))
    (foreach line liLst
      (setq oldDxf(entget line)
	    newStart(cons 10(cdr(assoc 11 oldDxf)))
	    newEnd(cons 11(cdr(assoc 10 oldDxf)))
	    newDxf(subst newStart(assoc 10 oldDxf)oldDxf)
	    newDxf(subst newEnd(assoc 11 newDxf)newDxf)
	    ); end setq
      (entmod newDxf)
      ); end foreach
    ); end progn
  (princ "\nLines not found ")
  ); end if
(princ)
); end of c:lmir

[Кулик Алексей aka kpblc]

> Fantomas : Thanks, буду пробовать. Кстати, дурной вопрос - для полилиний (lwpolyline) что принципиально надо добавить в код, кроме замены строки (setq liLst(ssget '((0 . "LINE")))) на (setq liLst(ssget '((0 . "PLINE"))))? Я так подозреваю, что элементарно заменить начальную и конечную точки не получится.
Конечно, попробую сам разобраться, но знаний-то минимум, хочется увидеть решение профи.

[{Smirnoff}]

>kpblc
Добавил полилинии. К сожалению "спрямляет" дуговые сегменты. Ответ на твой вопрос внутри кода в виде логических операторов (-4 . "<OR") ... (-4 . "OR>").

Код:

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

(defun c:lmir(/ liLst oldDxf newStart newEnd verLst othLst)
  (princ "\n*** Select lines ***")
  (if
    (setq liLst(ssget '((-4 . "<OR")(0 . "LINE")
			(0 . "LWPOLYLINE")
			(0 . "POLYLINE")(-4 . "OR>"))))
  (progn
    (setq liLst
	   (vl-remove-if 'listp
              (mapcar 'cadr(ssnamex liLst))))
    (foreach line liLst
      (if(= "LINE"(cdr(assoc 0(setq oldDxf(entget line)))))
      (setq newStart(cons 10(cdr(assoc 11 oldDxf)))
	    newEnd(cons 11(cdr(assoc 10 oldDxf)))
	    newDxf(subst newStart(assoc 10 oldDxf)oldDxf)
	    newDxf(subst newEnd(assoc 11 newDxf)newDxf)
	    ); end setq
	(progn
	  (setq verLst(reverse(vl-remove-if
				'(lambda(x)(/=(car x)10))oldDxf))
		othLst(vl-remove-if
			'(lambda(x)(=(car x)10)) oldDxf)
		newDxf(append othLst verLst)
		); end setq
	  ); end progn
	); end if  
      (entmod newDxf)
      ); end foreach
    ); end progn
  (princ "\nLines not found ")
  ); end if
(princ)
); end of c:lmir

Насчёт профи ошибаешся, до этого мне далеко...

[Кулик Алексей aka kpblc]

> Fantomas : ну уж не скромничай, не скромничай.
За лисп сыпасибо, с меня причитается.

[ShaggyDoc]

Как сделать реверс и LINE, и LWPOLYLINE и POLYLINE и SPLINE

http://www.kurganobl.ru/cad/book.jsp...=845&tn=main#b

[{Smirnoff}]

>kpblc

Вот кстати и "профи" прорезались.

>ShaggyDoc

Бегло просмотрел, у меня примерно те же идеи были насчет реверса. Только делов тут не на 15 минут, как с этим лиспом. Спасибо.

[Gostushev]

Смотрю подкинул идею а ее как хорошо развернули. Всем спасибо, большое спасибо, тоже буду обкатывать предложенное :-)

[{Smirnoff}]

>Gostushev

Для того чтобы работал более совершенный вариант предложенный ShaggyDoc, скачайте библиотеку ЛИСП-функций RU-CAD на сайте www.autocad.ru в разделе Download и поставьте её в автозагрузку.