[77chester77]

Необходимо создать точечные объекты на пересечении линий, в серединах и в конце отрезков.кто что может подсказать???

[Дима_]

Я могу - отправляйтесь в поиск

[Олег (jr.)]

Можешь попробовать из старых запасов, но вроде код рабочий

[Хмурый]

LISP. Разорвать объекты в точках пересечения. BreakObjects.

[Олег (jr.)]

Их есть у меня

Код:

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

;; bml.lsp
;----------------- BREAK LINES ---------------;
;; by Fatty T.O.H. () 2006 * all rights removed

(defun C:BML (/ *error* acsp adoc delobj_list line_obj
ln lineset main_line obj_list multset tmp)

(defun *error* (msg)
(if
(not
(member
msg
'("console break"
"Function cancelled"
"quit / exit abort"
"")
)
)
(princ (strcat "\nError: " msg))
)
(vla-endundomark adoc)
(princ)
)

(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
acsp (vla-get-block
(vla-get-activelayout adoc)
)
)

(vla-startundomark adoc)

(alert "Select all lines include main line")

(if (not multset)
(setq multset (ssget '((0 . "LINE"))))
)

(alert "Select main line only")

(if (not lineset)
(setq lineset (ssget "+.:S:E" '((0 . "LINE"))))
)
(setq ln (ssname lineset 0)
main_line (vlax-ename->vla-object ln)
)
(ssdel ln multset)

(setq obj_list (mapcar 'vlax-ename->vla-object
(vl-remove-if
'listp
(mapcar 'cadr (ssnamex multset)))
)
)
(setq line_obj (car obj_list))

(foreach line_obj obj_list
(setq tmp
(vlax-invoke
line_obj
'Intersectwith
main_line
acextendnone
)
)
(if tmp
(progn
(setq tmp (cons tmp
(list
(vlax-get line_obj 'StartPoint)
(vlax-get line_obj 'EndPoint)
))
)
(setq tmp (vl-sort tmp
(function (lambda (q p)
( (vlax-curve-getparamatpoint line_obj q)
(vlax-curve-getparamatpoint line_obj p)))))
)
(mapcar (function
(lambda (x y)
(vla-addline acsp (vlax-3d-point x) (vlax-3d-point y))
)
)
tmp
(cdr tmp)
)
(setq delobj_list (cons line_obj delobj_list))
)
)

)
(mapcar 'vla-delete delobj_list)
(vla-regen adoc acactiveviewport)
(vla-endundomark adoc)
(princ)
)
(prompt "\ntype BML to break many lines...")
(prin1)
(vl-load-com)
;;;Tested: 8/24/06 (A2005);2/21/08 (A2008);