Yuriy, с корректным получением координат разобраться удалось:
(defun bdgsection-get-vertex (ent / pt_lst loc rot)
;; Получение координат вершин AecDbBdgSectionLine
;; Параметры вызова:
;; ent -> указатель на вхождение примитива AecDbBdgSectionLine
;; Примеры вызова:
;|
(setq lst (bdgsection-get-vertex(car(entsel))))
(mapcar '(lambda(x) (entmakex (list '(0 . "POINT")(cons 10 x) '(62 . 1)))) lst)
|;
(if (and (setq ent (cond
((= (type ent) 'vla-object) ent)
((= (type ent) 'ename) (vlax-ename->vla-object ent))
) ;_ end of cond
) ;_ end of setq
(= (vla-get-objectname ent) "AecDbBdgSectionLine")
) ;_ end of and
(setq loc (vlax-safearray->list (vlax-variant-value (vlax-get-property ent 'location)))
rot (vlax-get-property ent 'rotation)
pt-lst (mapcar
(function
(lambda (x /)
(polar loc (+ rot (angle '(0. 0. 0.) x)) (distance x '(0. 0. 0.)))
) ;_ end of lambda
) ;_ end of function
(mapcar
(function cdr)
(vl-remove-if-not
(function
(lambda (x)
(and (= (car x) 10)
(not (equal (cdr x) loc 1e-9))
) ;_ end of and
) ;_ end of lambda
) ;_ end of function
(entget (vlax-vla-object->ename ent))
) ;_ end of vl-remove-if-not
) ;_ end of mapcar
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of if
pt-lst
) ;_ end of defunВариант удаления вершины:
(defun bdgsection-erase-vertex (ent vertex / pt-lst near loc rot)
;; Удаление вершины AecDbBdgSectionLine
;; Параметры вызова:
;; ent указатель на вхождение линии сечения
;; vertex координаты удаляемой вершины. Вычисляется ближайшая к указанной координате
;; Примеры вызова:
;|
(bdgsection-erase-vertex (car (entsel "\nSelect section line: ")) (getpoint "\nSelect nearest vertex : "))
|;
(if (setq pt-lst (bdgsection-get-vertex ent))
(progn
(setq near (car
(vl-sort pt-lst
(function
(lambda (a b)
(< (distance a vertex) (distance b vertex))
) ;_ end of lambda
) ;_ end of function
) ;_ end of vl-sort
) ;_ end of car
ent (cond
((= (type ent) 'vla-object) ent)
((= (type ent) 'ename) (vlax-ename->vla-object ent))
) ;_ end of cond
loc (vlax-safearray->list (vlax-variant-value (vlax-get-property ent 'location)))
rot (vlax-get-property ent 'rotation)
near (polar '(0. 0. 0.) (- rot (angle loc near)) (distance near loc))
ent (vlax-vla-object->ename ent)
) ;_ end of setq
(entmod (vl-remove-if
(function (lambda (x)
(and (= (car x) 10) (equal (cdr x) near 1e-6))
) ;_ end of lambda
) ;_ end of function
(entget ent)
) ;_ end of vl-remove-if
) ;_ end of entmod
(entupd ent)
) ;_ end of progn
) ;_ end of if
) ;_ end of defunС добавлением в принципе все аналогично, но у меня что-то сейчас мозгов не хватило на вычисление ближайших координат вершин (имею в виду левую и правую координаты). Попробую завтра погонять, но ничего, к сожалению, гарантировать не могу :(
---
P.S. Важно! Код тестировался только в мировой системе координат! Попытка удаления первой вершины может привести к непредсказуемому результату!
