Как повернуть метки точек вдоль вытянутого объекта

FOXXX591, спасибо большое за помощь. Но я имел ввиду лисп программу, которая поворачивает метки вдоль указанной линии (полилинии, облегченной полилинии или трассы). Именно выбранные точки, или группы точек. Может есть какой-то альтернативный вариант?

 

sergtor, а geOnix, это твой клон что ли?
Немного не понятно. Надо повернуть группу точек COGO или подписи точек автокада?

 

Да, это один из них. (это ник "фирмы"). Мне нужно повернуть метки нескольких десятков точек, вдоль трассы. Лисп, автор которого TararykovDG, меня вполне устраивает. Но именно в Civil 2010 версии он не работает. А поскольку это не разовая необходимость, хотелось бы найти, по-возможности, обходной путь.

 

поворот mtext (раскрыть) поворот mtext (свернуть)

;***************************************************
; Поворот подписей на выделенной линии
;***************************************************

(defun c:povorot_mtext (/ old_echo sel l1 p0 crv1 s1 ver1 ver2 al len1 p1 p2 p3 p4 set_pset set_text n_pset n_text
obj_pset s_pset z_pset z_pset1 p_pset2d p_pset i j jj obj_text z_txt p_txt2d dist min_dist deriv1 al0 al1 al2
al3 p_txt2 pos vla_text h r1 r2 r3
)

(setq old_echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(vl-load-com)

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

(setq sel (entsel "Выберите линию для выравнивания"))
(setq l1 (car sel) ; имя объекта и точка выбора
p0 (cdr sel)
crv1 (vlax-ename->vla-object l1)
) ;_ конец setq
(initget 6)
(setq pos (getint "Выравнивание (1 - сверху, 2 - центр, 3 - снизу)"))
(if (null pos)
(setq pos 1)
) ;_ конец if

(command "_zoom" "все" "")

(setq s1 (get_vertex l1)) ; получаем вершины линии и сохраняем в виде списка в s1

(if (and (not (null s1)) (<= 1 pos 3))
(progn
(setq ver1 nil)
(foreach ver2 s1 ; перебираем все пары вершин полилинии ver1 ver2
(if (not (null ver1))
(progn
(setq al (angle ver1 ver2) ; записываем угол линии между вершинами
len1 (distance ver1 ver2)
r1 10
r2 20
p1 (polar ver1 (+ al (/ pi 2)) r1) ; полигон для выбора точек
p1 (polar p1 (+ al pi) r1)
p2 (polar ver2 (+ al (/ pi 2)) r1)
p2 (polar p2 al r1)
p3 (polar ver2 (- al (/ pi 2)) r1)
p3 (polar p3 al r1)
p4 (polar ver1 (- al (/ pi 2)) r1)
p4 (polar p4 (+ al pi) r1)
) ;_ конец setq

;(command "_pline" p1 p2 p3 p4 p1 "")
; выбираем точки вокруг линии между вершинами ver1 ver2
(setq set_pset (ssget "_wp"
(list p1 p2 p3 p4)
'((0 . "insert") (8 . "EG_ТОЧКИ"))


) ;_ конец ssget
p1 (polar ver1 (+ al (/ pi 2)) r2) ; полигон для выбора подписей
p1 (polar p1 (+ al pi) r2)
p2 (polar ver2 (+ al (/ pi 2)) r2)
p2 (polar p2 al r2)
p3 (polar ver2 (- al (/ pi 2)) r2)
p3 (polar p3 al r2)
p4 (polar ver1 (- al (/ pi 2)) r2)
p4 (polar p4 (+ al pi) r2)

; выбираем подписи вокруг линии между вершинами ver1 ver2
set_text (ssget "_wp"
(list p1 p2 p3 p4)
'((0 . "mtext") (8 . "EG_ТОЧКИ_ПОДПИСИ"))
) ;_ конец ssget
n_pset (if (null set_pset)
0
(sslength set_pset)
) ;_ конец if
n_text (if (null set_text)
0
(sslength set_text)
) ;_ конец if
) ;_ конец setq

; (command "_pline" p1 p2 p3 p4 p1 "")




(while (> al pi)
(setq al (- al pi))
) ;_ конец while


; перебираем точки и ищем ближайшую подпись
(if (> n_pset 0)
(progn
(setq i 0)
(repeat n_pset
(setq obj_pset (ssname set_pset i) ; извлечение объекта - точки из набора и получение списка
s_pset (entget obj_pset)
z_pset (cadddr (assoc 10 s_pset))
z_pset1 (atof (rtos z_pset 2 2)) ; округление z точки до 2 знака после запятой
p_pset2d (list (cadr (assoc 10 s_pset)) (caddr (assoc 10 s_pset)))
p_pset (cdr (assoc 10 s_pset))
) ;_ конец setq


(setq j 0
jj -1
min_dist 9999999
) ;_ конец setq

(repeat n_text ; перебор подписей для текущей точки
; извлечение объекта - текста из набора и получение списка
(setq obj_text (ssname set_text j)
s_text (entget obj_text)
txt (cdr (assoc 1 s_text))
z_txt (atof txt)
p_txt2d (list (cadr (assoc 10 s_text)) (caddr (assoc 10 s_text)))
dist (distance p_pset2d p_txt2d)
) ;_ конец setq

(if (or (= z_txt z_pset1) (equal (- z_pset z_txt) 0.005 0.001))
(if (< dist min_dist)
(setq min_dist dist
jj (if (< min_dist 3)
j
jj
) ;_ конец if
) ;_ конец setq
) ;_ конец if
) ;_ конец if

(setq j (1+ j))


) ;_ конец repeat



(if (>= jj 0)
(progn
(setq obj_text (ssname set_text jj)
s_text (entget obj_text)
p_txt (cdr (assoc 10 s_text))
vla_text (vlax-ename->vla-object obj_text)
h (vla-get-height vla_text)

; нахождение ближайшей точки на кривой к точке подписи и
; нахождение производной в этой точке
p_pset2 (vlax-curve-getClosestPointto crv1 p_pset2d)
dist_pset (distance p_pset2d p_pset2)
par (vlax-curve-getParamAtPoint crv1 p_pset2)
deriv1 (vlax-curve-getFirstDeriv crv1 par)
dist (vlax-curve-getDistAtParam crv1 par)
; угол определяем по производной
al0 (if (zerop (car deriv1)) ; если x равен нулю...
(if (< (cadr deriv1) 0) ; если y < 0
(- (/ pi 2))
(+ (/ pi 2))
) ;_ конец if
(atan (cadr deriv1) (car deriv1))
) ;_ конец if
) ;_ конец setq

(if (<= dist_pset 0.5)
(progn

(setq al00 al0)


; приводим угол al00 в границы от 0 до 2pi
(while (< al00 0)
(setq al00 (+ al00 (* 2 pi)))
) ;_ конец while

(while (> al00 (* 2 pi))
(setq al00 (- al00 (* 2 pi)))
) ;_ конец while




(while (< al0 0)
(setq al0 (+ al0 pi))
) ;_ конец while
(while (> al0 pi)
(setq al0 (- al0 pi))
) ;_ конец while

;(setq al1 (cdr (assoc 50 s_text)))
(cond
((= pos 1)
(setq al3 (* pi 0.3)
r3 0.75
) ;_ конец setq
)
((= pos 2)
(setq al3 (- (atan (* h 0.5) (* 0.75 (cos (* pi 0.3)))))
r3 (sqrt (+ (expt (* h 0.5) 2) (expt (* 0.75 (cos (* pi 0.3))) 2)))
) ;_ конец setq
)
((= pos 3)
(setq al3 (- (atan (+ h (* 0.75 (sin (* pi 0.3)))) (* 0.75 (cos (* pi 0.3)))))
r3 (sqrt (+ (expt (+ h (* 0.75 (sin (* pi 0.3)))) 2) (expt (* 0.75 (cos (* pi 0.3))) 2)))
) ;_ конец setq
)

;((= pos 3) (setq al3 ( - (* pi 0.4)) r3 1.1))
) ;_ конец cond


(setq al_base (getvar "ANGBASE"))
;(if (< al0 (/ pi 2))
(if (< (sin (- al0 al_base)) 0)
(setq al1 al0
;al2 (+ al1 al3)
) ;_ конец setq
(setq al1 (+ al0 pi)
;al2 (+ al1 al3)
) ;_ конец setq
) ;_ конец if

; придаем небольшое смещение по линии и определяем там параметр

(if (< (mod (- al0 al00)) 0.01)
(progn ; если углы al0 и al00 сонаправлены
;(if (< al0 (/ pi 2))
(if (< (sin (- al0 al_base)) 0)
(setq dist (+ dist 1.5))
(setq dist (- dist 1.5))
) ;_ конец if

) ;_ конец progn

(progn ; если углы al0 и al00 противоположно направленны
;(if (< al0 (/ pi 2))
(if (< (sin (- al0 al_base)) 0)
(setq dist (- dist 1.5))
(setq dist (+ dist 1.5))
) ;_ конец if
) ;_ конец progn
) ;_ конец if

(setq par (vlax-curve-getParamAtDist crv1 dist))
(if (not (null par)) ; если не выходит за линию делаем поправку к углу
(progn
(setq deriv1 (vlax-curve-getFirstDeriv crv1 par)
; угол по производной
al0 (if (zerop (car deriv1)) ; если x равен нулю...
(if (< (cadr deriv1) 0) ; если y < 0
(- (/ pi 2))
(+ (/ pi 2))
) ;_ конец if
(atan (cadr deriv1) (car deriv1))
) ;_ конец if
) ;_ конец setq

(while (< al0 0)
(setq al0 (+ al0 pi))
) ;_ конец while
(while (> al0 pi)
(setq al0 (- al0 pi))
) ;_ конец while

;(if (< al0 (/ pi 2))
(if (< (sin (- al0 al_base)) 0)
(setq al11 al0)
(setq al11 (+ al0 pi))
) ;_ конец if
(if (or
(and (< (* (cos al1) (cos al11)) 0)
(< (* (sin al1) (sin al11)) 0)
) ;_ конец and
(and (> (* (cos al1) (cos al11)) 0)
(> (* (sin al1) (sin al11)) 0)
) ;_ конец and
) ;_ конец or
(setq al1 al11)
) ;_ конец if

) ;_ конец progn
) ;_ конец if


(setq al2 (+ al1 al3))

;(setq s_text (subst (cons 71 virav) (assoc 71 s_text) s_text))
;(entmod s_text)
(setq s_text (subst (cons 50 al1) (assoc 50 s_text) s_text)
;p_txt (cdr (assoc 10 s_text))
p_txt2 (polar p_pset al2 r3)
s_text (subst (cons 10 p_txt2) (assoc 10 s_text) s_text)
) ;_ конец setq
(entmod s_text)
) ;_ конец progn
) ;_ конец if
) ;_ конец progn
) ;_ конец if
(setq i (1+ i))
) ;_ конец repeat
) ;_ конец progn
) ;_ конец if



) ;_ конец progn
) ;_ конец if

(setq ver1 ver2)

) ;_ конец foreach
) ;_ конец progn
) ;_ конец if

(command "_zoom" "предыдущий" "")
(command "_regenall" "")
(setvar "cmdecho" old_echo)
(princ n_pset)

) ;_ конец defun

ещё одна фукция по выделённому mtext (раскрыть) ещё одна фукция по выделённому mtext (свернуть)

(defun c:povorot_sel_mtext ()
(setq old_echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(vl-load-com)

; (setq set_text (ssget '((0 . "mtext") (8 . "EG_ТОЧКИ_ПОДПИСИ")))
(setq set_text (ssget)
n_text (if (null set_text)
0
(sslength set_text)
) ;_ конец if
) ;_ конец setq

(setq s_line 0)
(while (or (null s_line) (= s_line 0))
(setq s_line (entsel "\nУкажите участок линии для задания угла поворота"))

) ;_ конец while
(if (and (not (null set_text)) (not (null s_line)))
(progn
(initget 6)
(setq pos (getint "Выравнивание (1 - сверху, 2 - центр, 3 - снизу)"))
(if (null pos)
(setq pos 1)
) ;_ конец if
(setq l1 (car s_line)
crv1 (vlax-ename->vla-object l1)
p0 (cadr s_line)
p_pset2 (vlax-curve-getClosestPointto crv1 p0)
deriv1 (vlax-curve-getFirstDeriv crv1 (vlax-curve-getParamAtPoint crv1 p_pset2))
al0 (if (zerop (car deriv1))
(if (< (cadr deriv1) 0)
(- (/ pi 2))
(+ (/ pi 2))
) ;_ конец if
(atan (cadr deriv1) (car deriv1))
) ;_ конец if
i 0
) ;_ конец setq

(repeat n_text
; извлечение объекта - текста из набора и получение списка

(setq obj_text (ssname set_text i)
vla_text (vlax-ename->vla-object obj_text)
s_text (entget obj_text)
) ;_ конец setq
(if (or (= (cdr (assoc 0 s_text)) "MTEXT") (= (cdr (assoc 0 s_text)) "TEXT"))
(progn

(setq txt (cdr (assoc 1 s_text))
z_txt (atof txt)
p_txt (cdr (assoc 10 s_text))
p_txt2d (list (cadr (assoc 10 s_text)) (caddr (assoc 10 s_text)))
al (cdr (assoc 50 s_text))
h (vla-get-height vla_text)
w 8 ;(vla-get-width vla_text)
) ;_ конец setq




(setq p1 (polar p_txt (+ al (- (/ pi 2))) 2)
p1 (polar p1 (+ al pi) 2)
p2 (polar p1 al (+ w 2))
p3 (polar p2 (+ al (/ pi 2)) (+ h 4))
p4 (polar p3 (+ al pi) (+ w 2))
) ;_ конец setq

;;; (command "_pline" p1 p2 p3 p4 p1 "")
(setq set_pset (ssget "_wp"
(list p1 p2 p3 p4)
'((0 . "insert") (8 . "EG_ТОЧКИ"))
) ;_ конец ssget
) ;_ конец setq
;(if (and (not (null set_pset)) (= al 0))
(if (not (null set_pset))
(progn
(setq n_pset (sslength set_pset)
min_dist 999999
jj -1
j 0
) ;_ конец setq
(repeat n_pset
(setq obj_pset (ssname set_pset j) ; извлечение объекта - точки из набора и получение списка
s_pset (entget obj_pset)
z_pset (cadddr (assoc 10 s_pset))
z_pset1 (atof (rtos z_pset 2 2)) ; округление z точки до 2 знака после запятой
p_pset2d (list (cadr (assoc 10 s_pset)) (caddr (assoc 10 s_pset)))
p_pset (cdr (assoc 10 s_pset))
dist (distance p_txt2d p_pset2d)
) ;_ конец setq

(if (or (= z_txt z_pset1) (equal (- z_pset z_txt) 0.005 0.001))
(if (< dist min_dist)
(setq min_dist dist
jj (if (< min_dist 3)
j
jj
) ;_ конец if
) ;_ конец setq
) ;_ конец if
) ;_ конец if



(setq j (1+ j))

) ;_ конец repeat

(if (>= jj 0)
(progn
(setq obj_pset (ssname set_pset jj) ; извлечение объекта - точки из набора и получение списка
s_pset (entget obj_pset)
p_pset2d (list (cadr (assoc 10 s_pset)) (caddr (assoc 10 s_pset)))
p_pset (cdr (assoc 10 s_pset))
) ;_ конец setq
(while (< al0 0)
(setq al0 (+ al0 pi))
) ;_ конец while
(while (> al0 pi)
(setq al0 (- al0 pi))
) ;_ конец while

;(setq al1 (cdr (assoc 50 s_text)))

(setq al_base (getvar "ANGBASE"))
(if (< (sin (- al0 al_base)) 0)
;(if (< al0 (/ pi 2))
(setq al1 al0)
(setq al1 (+ al0 pi))
) ;_ конец if

(cond
((= pos 1)
(setq al3 (* pi 0.3)
r3 0.75
) ;_ конец setq
)
((= pos 2)
(setq al3 (- (atan (* h 0.5) (* 0.75 (cos (* pi 0.3)))))
r3 (sqrt (+ (expt (* h 0.5) 2) (expt (* 0.75 (cos (* pi 0.3))) 2)))
) ;_ конец setq
)
((= pos 3)
(setq al3 (- (atan (+ h (* 0.75 (sin (* pi 0.3)))) (* 0.75 (cos (* pi 0.3)))))
r3 (sqrt (+ (expt (+ h (* 0.75 (sin (* pi 0.3)))) 2) (expt (* 0.75 (cos (* pi 0.3))) 2)))
) ;_ конец setq
)
) ;_ конец cond
(setq al2 (+ al1 al3))

(setq s_text (subst (cons 50 al1) (assoc 50 s_text) s_text)
;p_txt (cdr (assoc 10 s_text))
p_txt2 (polar p_pset al2 r3)
s_text (subst (cons 10 p_txt2) (assoc 10 s_text) s_text)
) ;_ конец setq
(entmod s_text)
) ;_ конец progn
) ;_ конец if
) ;_ конец progn
) ;_ конец if
) ;_ конец progn
) ;_ конец if
(setq i (1+ i))

) ;_ конец repeat
) ;_ конец progn
) ;_ конец if





(command "_regenall" "")
(setvar "cmdecho" old_echo)
(princ al0)
) ;_ конец defun

Давным-давно это писалось. Попробуй....

--- Сообщения объединены, 9 апр 2015, Оригинальное время сообщения: 9 апр 2015 ---

Только подправь себе имя слоя. У меня с Робура всегда на EG точки подписи. Обязательно должен быть mtext

 

У Андрея в geo tools есть эта функция, во вкладке со шрифтами и подписями, применял в civil 2012-2015

 

В том-то и проблема. Немножко выше я указал, что у меня версия 2010г.

 

Всем, привет!!! Давно пользуюсь приложением, автор которого TararykovDG, но оно не всегда корректно работает при большом количестве узлов в полилинии. Может у кого-нибудь есть приложение, для поворота метки точки COGO по примеру команды Rotate text в Express Tools?

 

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