Variant of the function developed at
a forum dwg.ru. ElpanovEvgeniy there too took part
Attributes RevClode
1. It LW a polyline
2. All segments of a polyline is arc
3. Coordinates of the centers of these segments do not coincide
4. Curvature of arc segments is identical as on a sign, and numerically;| ====== IsRevClode ==========
* EN
* Function defines, whether draw a polyline a command _Revcloud
* the Polyline is considered Revcloud if:
1. It LW a polyline
2. All segments of a polyline arc
3. Coordinates of the centers of these segments do not coincide
4. Curvature of arc segments is identical as on a sign, and numerically
Arguments:
pl - a name (ENAME) or object (VLA-OBJECT) polylines
Return:
T - if a polyline satisfies to the listed conditions
nil - in all other cases
Example of use
(IsRevcloud (car (entsel)))
* RUS
* Функция определяет, отрисована ли полилиния командой _Revcloud
* Полилиния считается отрисованной командой _Revcloud если:
1. это LW полилиния
2. все сегменты полилинии дуговые
3. координаты центров этих сегментов не совпадают
4. кривизна дуговых сегментов одинакова как по знаку, так и численно
Аргументы:
pl - имя (ENAME) или объект (VLA-OBJECT) полилинии
Возврат:
T - если полилиния удовдетворяет перечисленным условиям
nil - во всех других случаях
Пример использования
(IsRevcloud (car(entsel)))
|;
(defun IsRevcloud ( pl / st-en-bulge->center ed crs bulge_list bulge_log center)
;| EN
Helper function st-en-bulge-> center
* the Author the Pastuh
* It is published: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=37164rO
* Purpose
* Receives coordinates of the center of the arch set by points of the beginning, the end and size bulge.
* thus, position of a point of the center is defined so that detour of initial, final points of an arch and
* the received point of the center occured in a direction counter-clockwise.
Arguments:
Point [list] - a point of the beginning of a segment
p2 = Point [list] - a point of the end of a segment
st - Point [list] - a bidimentional point of the beginning of an arch,
en - Point [list] - a bidimentional point of the end of an arch,
bulg - a tangent 1/4 central corners of an arch (bulge).
Return:
Bidimentional coordinates of a point of the center.
nil if points of the beginning and the end of an arch coincide.
nil if camber is set equal to zero.
|;
;| RUS
Вспомогательня ф-ция st-en-bulge->center
* Автор Пастух
* Опубликована: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=37164rO
* Назначение
* Получает координаты центра дуги, заданной точками начала, конца и величиной выпуктости (bulge).
* При этом, положение точки центра определяется так, чтобы обход начальной, конечной точек дуги и
* полученной точки центра происходил в направлении против часовой стрелки.
Аргументы:
Point[list] - точка начала сегмента
p2 = Point[list] - точка конца сегмента
st - Point[list] - двумерная точка начала дуги,
en - Point[list] - двумерная точка конца дуги,
bulg - тангенс 1/4 центрального угла дуги (bulge).
Возврат:
двумерные координаты точки центра.
nil, если совпадают точки начала и конца дуги.
nil, если выпуклость задана равной нулю.
|;
(defun st-en-bulge->center (st
en
bulg
/
a sina cosa 1-cosa
b1 b2
d d1 d2
)
(setq a (* (atan bulg) 4.0) sina (sin a) cosa (cos a) 1-cosa (- 1 cosa))
(cond
((equal st en 1e-12) nil);
((equal 1-cosa 0.0 1e-12) nil);
(T
(setq b1 (+ (- (car en) (* (car st) cosa)) (* (cadr st) sina))
b2 (- (cadr en) (* (car st) sina) (* (cadr st) cosa))
d (* 2 1-cosa)
d1 (- (* b1 1-cosa) (* b2 sina))
d2 (+ (* b2 1-cosa) (* b1 sina))
);
(list (/ d1 d) (/ d2 d));
);
); end cond.
); end defun.
(and
(if (eq (type pl) 'VLA-OBJECT)
(setq pl (vlax-vla-object->ename pl))
pl
)
(wcmatch (cdr(assoc 0 (setq ed (entget pl)))) "LWPOLYLINE")
(setq ed (entget pl))
(setq crs (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) ed)))
(setq bulge_list (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= (car x) 42)) ed)))
(if (= (logand (cdr(assoc 70 ed)) 1) 1)
(setq crs (append crs (list (car crs))))
(setq bulge_list (reverse(cdr(reverse bulge_list)))) ;_Если не замкнутая плиния, удаляем последний bulge
;_If not closed PLINE, we delete last bulge
)
(setq bulge_log (mapcar 'zerop bulge_list))
(not(apply 'or bulge_log)) ;_Все дуговые сегменты
;_All arc segments
(apply 'and (mapcar '(lambda(x)(equal x (car bulge_list) 1e-6)) bulge_list)) ;_Равна кривизна дуг (Тангенс 1/4 угла)
;_ Equal curvature of arches (the Tangent 1/4 corners)
(setq center (mapcar '(lambda(st pl blg)(st-en-bulge->center st pl blg)) crs (cdr crs) bulge_list))
(not (apply 'and (mapcar '(lambda(x)(equal x (car center) 1e-6)) center))) ;_Центры дуг. сегментов не совпадают
;_ The centers of arc segments do not coincide
)
)
