| Правила | Регистрация | Пользователи | Сообщения за день | | Поиск | | Справка по форуму | Файлообменник | |
|
Поиск в этой теме |
28.04.2004, 09:56 | #1 | |
Нужен LISP для разрыва линий в точках пересечений
Москва
Регистрация: 20.01.2004
Сообщений: 154
|
||
Просмотров: 10520
|
|
||||
Регистрация: 20.01.2004
Москва
Сообщений: 154
|
Мне тут LordAlex прислал Lisp, но так как он здесь его еще не опубликовал, то я его решил опубликовать,
но в нем необходимо указывать точку разрыва, а я имел в виду выбрать все линии, и чтобы разрывы были во всех местах пересечения, и не указывать каждое место разрыва как ниже Код:
|
|||
|
||||
Сообщений: 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 |
|||
|
||||
Регистрация: 20.01.2004
Москва
Сообщений: 154
|
А можно попросить дороботать ваш вариант, вариант не плохой но в вашем варианте надо сперва выбрать линию, а потом линии которые будут разрыватся в точках пересечения с выбранной линией.
А было бы замечательно если бы все выбранные линии (и полилинии тоже) разрывались в местах пересечния друг с другом. Но все равно спасибо, этот вариант тоже прегадится..... |
|||
|
||||
Сообщений: n/a
|
Цитата:
|
|||
|
||||
сисадмин Регистрация: 26.08.2003
Самара
Сообщений: 1,022
|
Недавно писал похожую прогу. Если интересно, смотрите http://vkle.bazarov.net/mbr.zip
Немного сыровата правда. |
|||
|
||||
строительство Регистрация: 16.01.2004
Петербург
Сообщений: 165
|
>>Admin
Я не против.Можно и выложить. Однако обнаружил парочку глюков 1.Замкнутые сплайны не разбиваются-программа ругается , но не вылетает.(Cannot break a closed, periodic curve at only one point.) 2.Широкие полилинии разбиваются не во всех точках. |
|||
|
||||
Инженер LISP Регистрация: 11.05.2005
Минск
Сообщений: 6,992
|
__________________
Как использовать код на Лиспе читаем здесь |
|||
|
||||
Инженер LISP Регистрация: 11.05.2005
Минск
Сообщений: 6,992
|
rain_day, Что именно грузишь?
__________________
Как использовать код на Лиспе читаем здесь |
|||
|
||||
Регистрация: 02.10.2008
Сообщений: 198
|
VVA, пост #7, который Эдуард предложил.
А если грузить из поста #5, то выдаёт "; ошибка: no function definition: VLAX-GET-ACAD-OBJECT" позже: Извини, VVA. Не сразу открыл твою ссылку под пунктом 2. Прочитал первый пункт и упустил, что во втором рабочий, отличный лисп. Спасибо тебе за инструкцию и новые очень полезные для меня возможности Последний раз редактировалось rain_day, 18.11.2010 в 19:29. |
|||
|
||||
YngIngKllr Регистрация: 29.03.2005
СПб
Сообщений: 12,968
|
СТранно ни один из кодов в автокаде 2010 не работает...
Может у кого есть подходящий код... PS. Не надо... Нашел...
__________________
Работаю за еду. Working for food. Für Essen arbeiten. العمل من أجل الغذاء Працую за їжу. |
|||
|
||||
Регистрация: 20.03.2008
Сообщений: 2,653
|
|
|||