| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен LISP для разрыва линий в точках пересечений

Нужен LISP для разрыва линий в точках пересечений

Ответ
Поиск в этой теме
Непрочитано 28.04.2004, 09:56 #1
Нужен LISP для разрыва линий в точках пересечений
ilka_t
 
Москва
Регистрация: 20.01.2004
Сообщений: 154

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


Заранее спасибо.
Просмотров: 7881
 
Непрочитано 28.04.2004, 10:08
#2
Admin
Administrator


 
Регистрация: 21.08.2003
Ульяновск
Сообщений: 3,884


Это была бы неплохая примочка.
Как раз для создания болванки расчетной схемы
Admin вне форума  
 
Непрочитано 28.04.2004, 10:28
#3
Pilot

Проектировщик свиноводство
 
Регистрация: 21.08.2003
Сообщений: 2,210


Для этого я пользуюсь вот такой макрухой:

Код:
[Выделить все]
*^C^C_BREAK;\_first;_int;\@
Правда приходится указывать линии и точки разрыва по очереди, а не оптом.
А в тотальном разыве у меня пока не было надобности.
Pilot вне форума  
 
Автор темы   Непрочитано 28.04.2004, 11:48
#4
ilka_t


 
Регистрация: 20.01.2004
Москва
Сообщений: 154


Мне тут LordAlex прислал Lisp, но так как он здесь его еще не опубликовал, то я его решил опубликовать,
но в нем необходимо указывать точку разрыва, а я имел в виду выбрать все линии, и чтобы разрывы были во всех местах пересечения, и не указывать каждое место разрыва как ниже



Код:
[Выделить все]
;;;  LordAlex
;;;
;;;  Разрыв всех элементов в выбранной точке
;;;

(defun C:BREAKLL ( / MARKER NAB NABMAR NAME TX)
  (setvar "CMDECHO" 0)
  (setq old (getvar "OSMODE"))

;  (setq marker (getstring "\nМаркеры ставить ? Y/N [N] :"))
;  (setq marker (if (or (= marker "N")(= marker nil)) nil T))
  (setq nabmar (ssadd))
  (setvar "OSMODE" 32)
  (setq tx (getpoint "\nВыберите точку разрыва"))
  (setvar "OSMODE" 0)
  (while tx
;    (if marker
;      (progn
        (command "_DONUT" 0 2 tx "")
        (setq nabmar (ssadd (entlast) nabmar))
;      )
;    )
    (setq nab (ssget "_C" (polar tx 4.0 0.1)(polar tx 0.8 0.1)))
    (repeat (sslength nab)
      (setq name (ssname nab 0))
      (setq nab (ssdel name nab))
      (command "_BREAK" name tx tx)
    )
    (setvar "OSMODE" 32)
    (setq tx (getpoint "\nВыберите точку разрыва"))
    (setvar "OSMODE" 0)
  )  
;  (if marker
   (command "_ERASE" nabmar "")        ; удаляем маркеры
;  )

  (setvar "OSMODE" old)
  (print)
)

(print)
ilka_t вне форума  
 
Непрочитано 28.04.2004, 19:07
#5
Лентяй


 
Сообщений: n/a


Пользуйтесь, люди плодами моих тяжких трудов и долгих раздумий.

;;Inttr.lsp ©2001 Alexey Sheinkman
;;Single line trimming at intersection point
;;
;
(defun *error* (msg)
(if (= msg "Function cancelled")
(princ msg)
(progn (setvar "OSMODE" sn)
(setvar "CMDECHO" cm)
(redraw ln 4)
(princ)
);progn
);if
);*error*
;
(defun VxGetInters (Fst Nxt Mde / IntLst PntLst)
(setq IntLst (vlax-invoke Fst "IntersectWith" Nxt Mde))
(cond (IntLst (repeat (/ (length IntLst) 3)
(setq PntLst (cons (list (car IntLst) (cadr IntLst) (caddr IntLst)) PntLst)
IntLst (cdddr IntLst));setq
);repeat
(reverse PntLst)
);IntLst
(T nil)
);cond
);defun
;
(defun C:INTTR ( / *error* c cp m vp r sn sm)
(setvar "CMDECHO" 0)
(setq cm (getvar "CMDECHO")
sn (getvar "OSMODE")
adoc (vla-get-activedocument (vlax-get-acad-object))
ms (vla-get-modelspace adoc)
ps (vla-get-paperspace adoc)
ln (car (entsel "\nSelect line above: "))
ln0 (vlax-ename->vla-object ln)
csp (vlax-invoke adoc "objectidtoobject" (vla-get-ownerID ln0))
);setq
(redraw ln 3)
(terpri)
(prompt "\nSelect line(s) below: ")
(setq ssln (ssget))
(setq m (1- (sslength ssln)))
(princ (strcat "\nSelected " (itoa (sslength ssln)) " lines"))
(while (<= 0 m)
(setq ln1 (vlax-ename->vla-object (ssname ssln m))
cc (VxGetInters ln0 ln1 1))
(while cc
(setq c (car cc))
(if (= (vla-get-ActiveSpace adoc) 0)
(setq vp (vla-get-ActivePViewport adoc)
r (if (= (vla-get-name csp) "*Model_Space") (/ 0.0625 (vla-get-CustomScale vp)) 0.0625)
);setq
(vlax-for vp ps
(if (= "AcDbViewport" (vla-get-objectname vp))
(progn
(setq cp (cdr (assoc 12 (entget (vlax-vla-object->ename vp))))
sc (vla-get-CustomScale vp)
hwd (/ (vla-get-Width vp) sc 2)
hht (/ (vla-get-Height vp) sc 2)
x0 (- (car cp) hwd)
x1 (+ (car cp) hwd)
y0 (- (cadr cp) hht)
y1 (+ (cadr cp) hht)
);setq VP dimensions in MS
(if (and (<= x0 (car c) x1) (<= y0 (cadr c) y1))(setq r (/ 0.0625 sc)))
);progn
);if
(if null r (setq r (getdist c (strcat "\nEnter break distance <" (rtos (if (= r nil) 0 r)) "> :"))))
);vlax-for
);if
(setq tc (vla-addcircle csp (vlax-3d-point c) r)
tp1 (car (VxGetInters ln1 tc 1))
tp2 (cadr (VxGetInters ln1 tc 1))
);setq
(setvar "OSMODE" 0)
(command "BREAK" (vlax-vla-object->ename ln1) tp1 tp2)
(vla-delete tc)
(setq cc (cdr cc))
);while
(setq m (1- m))
);while
(redraw ln 4)
(setvar "OSMODE" sn)
(setvar "CMDECHO" cm)
(princ)
);end
 
 
Автор темы   Непрочитано 29.04.2004, 10:04
#6
ilka_t


 
Регистрация: 20.01.2004
Москва
Сообщений: 154


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

А было бы замечательно если бы все выбранные линии (и полилинии тоже) разрывались в местах пересечния друг с другом.

Но все равно спасибо, этот вариант тоже прегадится.....
ilka_t вне форума  
 
Непрочитано 29.04.2004, 20:29
#7
Эдуард

строительство
 
Регистрация: 16.01.2004
Петербург
Сообщений: 164
Отправить сообщение для Эдуард с помощью ICQ


Программа брикает все выбранные объекты на кусочки во
всех точках пересечения (правда и полилинии в вертексах- лень
было дорабатывать).
Код:
[Выделить все]
(defun C:break-total(/ pt-list)
  
  (vl-load-com)
  (setvar "cmdecho" 0)
  (command "_undo" "_be")
  (setq osm(getvar "osmode"))
  (setvar "osmode" 0)
  
  (if
  (setq nbl(ssget   '((0 . "line,spline,lwpolyline,arc")
		      )
		    )
	)
  (progn
    (setq nbl (mapcar 'vlax-ename->vla-object
	   (vl-remove-if 'listp
		(mapcar 'cadr (ssnamex nbl))
		)
	  )
	  );setq
    (foreach i nbl
      (foreach j nbl
	(setq pt(vla-intersectwith i j acextendnone)
	      pt-list(cons pt pt-list)
	      );setq
	);foreach
      );foreach
    (setq pt-list (mapcar 'vlax-variant-value pt-list)
	  pt-list (vl-remove-if '(lambda(x)
				   (minusp
				     (vlax-safearray-get-u-bound x 1)
				     )
				   )
		    pt-list)
	  pt-list (mapcar 'vlax-safearray->list pt-list )
	  pt-list (apply 'append pt-list)
	  pt-list (nlist pt-list vozvrat)
	  );setq
    (foreach r pt-list
      (setq pnb(vl-remove-if 'listp
		 (mapcar 'cadr (ssnamex(ssget "c" r r)
				       )
			 )
		 )
	    )
	    (foreach k pnb
	      (command "_break" k r "@")
	      );foreach
	     (setq pnb nil)
      );foreach
	    
	    
	    
    
    );progn
  );if
  (setvar "osmode" osm)
  (princ)
  );defun

(defun nlist(sp vozvrat)
  (if sp
    (nlist
      (cdddr sp)
      (cons
	(list
	  (car sp)
	  (cadr sp)
	  (caddr sp)
	  )vozvrat)
      )
    
  (reverse vozvrat)
    )
  )
Эдуард вне форума  
 
Непрочитано 29.04.2004, 20:50
#8


 
Сообщений: n/a


Цитата:
Сообщение от ilka_t
А было бы замечательно если бы все выбранные линии (и полилинии тоже) разрывались в местах пересечния друг с другом....
Мона-то оно мона, да вот нуна ли? Целью порграммы являлось разрывать линии "под", оставляя илинии "над" нетронутыми, причем видимый в пространстве листа зазор - всегда 3/8". Это нужно для планов трубопроводов, например. Если же такая дифференциация не требуется, и вам нужна просто дырка постоянного размера, то программа значительно упрощается. Пойду посижу, подумаю.
 
 
Непрочитано 29.04.2004, 23:24
#9
vk

сисадмин
 
Регистрация: 26.08.2003
Самара
Сообщений: 1,022
Отправить сообщение для vk с помощью ICQ


Недавно писал похожую прогу. Если интересно, смотрите http://vkle.bazarov.net/mbr.zip
Немного сыровата правда.
vk вне форума  
 
Непрочитано 30.04.2004, 08:24
#10
Admin
Administrator


 
Регистрация: 21.08.2003
Ульяновск
Сообщений: 3,884


>>Эдуард

То что надо!
Может в даунлоад выложить?
Admin вне форума  
 
Непрочитано 30.04.2004, 09:29
#11
Эдуард

строительство
 
Регистрация: 16.01.2004
Петербург
Сообщений: 164
Отправить сообщение для Эдуард с помощью ICQ


>>Admin
Я не против.Можно и выложить.

Однако обнаружил парочку глюков
1.Замкнутые сплайны не разбиваются-программа ругается , но
не вылетает.(Cannot break a closed, periodic curve at only one point.)
2.Широкие полилинии разбиваются не во всех точках.
Эдуард вне форума  
 
Непрочитано 30.09.2009, 14:41
#12
Djur


 
Регистрация: 07.06.2008
ЗвезДонецк
Сообщений: 131


Благодарю за Lisp!
Подскажите пожалуйста какой командой запускать этот Lisp?
через "appload" я его загрузил, а дальше?
Djur вне форума  
 
Непрочитано 30.09.2009, 15:05
#13
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,776
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


Djur,
1. Читать
2. Смотреть и пробовать
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 30.09.2009, 15:17
#14
Djur


 
Регистрация: 07.06.2008
ЗвезДонецк
Сообщений: 131


О... низкий поклон Думаю где-то я видел эту тему, но так и не нашел )))))))))))))))))))
Благодарствую
Djur вне форума  
 
Непрочитано 18.11.2010, 13:21
#15
rain_day


 
Регистрация: 02.10.2008
Сообщений: 197


А мне в 2011 каде выдаёт ошибку "; ошибка: неверная строка режима ssget". Как мона поправить?
rain_day вне форума  
 
Непрочитано 18.11.2010, 14:26
1 | #16
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,776
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


rain_day, Что именно грузишь?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.11.2010, 19:19
#17
rain_day


 
Регистрация: 02.10.2008
Сообщений: 197


VVA, пост #7, который Эдуард предложил.

А если грузить из поста #5, то выдаёт "; ошибка: no function definition: VLAX-GET-ACAD-OBJECT"

позже: Извини, VVA. Не сразу открыл твою ссылку под пунктом 2. Прочитал первый пункт и упустил, что во втором рабочий, отличный лисп. Спасибо тебе за инструкцию и новые очень полезные для меня возможности

Последний раз редактировалось rain_day, 18.11.2010 в 19:29.
rain_day вне форума  
 
Непрочитано 15.03.2013, 16:13
#18
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,762


СТранно ни один из кодов в автокаде 2010 не работает...
Может у кого есть подходящий код...
PS. Не надо...
Нашел...
__________________
Шаг 12й......
Мои публикации
DEM вне форума  
 
Непрочитано 15.03.2013, 16:35
#19
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,232


LISP. Разорвать объекты в точках пересечения. BreakObjects.
skkkk на форуме  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен LISP для разрыва линий в точках пересечений

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск