Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Можно ли создать программку для округления координат объектов (начальных и конечных точек линий, полилиний; центра и радиуса дуг и окружностей, точек вставки блоков до заданной величины? То есть, чтобы не было дробных координат. В качестве кратного значения можно было бы использовать значение для snap.
Ага. А поиск где оказывается?
https://www.caduser.ru/forum/topic22219.html
Замечательно! Восхитительно! Но есть два вопроса:
1. Примитивы - точки, а требуется (в принципе, все, но на крайний случай можно) отрезки, полилинии, дуги, окружности и блоки.
2. Можно ли округлять не только до целых, а до заданной величины: 5, 10, 100 мм?
Знающим LISP, вероятно, достаточно приведенного по ссылке образца, а простым-темным-деревянным? Спасибо, если откликнетесь, Ув. kpblc!
Как грится, тестируй:
(defun c:round-coord (/ _kpblc-eval-nearest
_kpblc-ent-modify-autoregen _kpblc-conv-list-to-2dpoints
lst
)
(defun _kpblc-conv-list-to-2dpoints (lst / res)
(cond
((not lst)
nil
)
(t
(setq res (cons (list (car lst)
(if (cadr lst)
(cadr lst)
0.
) ;_ end of if
) ;_ end of list
(_kpblc-conv-list-to-2dpoints (cddr lst))
) ;_ end of cons
) ;_ end of setq
)
) ;_ end of cond
res
) ;_ end of defun
(defun _kpblc-ent-modify-autoregen (ent bit value
ext_regen / ent_list
old_dxf new_dxf layer_dxf70
)
(if (not
(and
(or
(= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
(= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
(= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
) ;_ end of or
(= bit 100)
) ;_ end of and
) ;_ end of not
(progn
(setq ent_list (entget ent)
new_dxf (cons bit
(if (and (= bit 62) (= (type value) 'str))
(if (= (strcase value) "BYLAYER")
256
0
) ;_ end of if
value
) ;_ end of if
) ;_ end of cons
) ;_ end of setq
(if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
(progn
(entmod (if old_dxf
(subst new_dxf old_dxf ent_list)
(append ent_list (list new_dxf))
) ;_ end of if
) ;_ end of entmod
(if ent_regen
(entupd ent)
(redraw ent)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
ent
) ;_ end of defun
;;;* Получение "ближайшего" к указанному числу из списка
;;;* Параметры вызова:
;;;* value контрольное значение
;;;* lst список "проверяемых" значений
(defun _kpblc-eval-nearest (value lst / x base)
(if lst
(progn
(setq x (car lst)
base (abs (- value x))
) ;_ end of setq
(foreach item (cdr lst)
(if (> base (abs (- value item)))
(setq x item
base (abs (- value item))
) ;_ end of setq
) ;_ end of if
) ;_ end of foreach
) ;_ end of progn
(setq x value)
) ;_ end of if
x
) ;_ end of defun
(vl-load-com)
(if (not *kpblc-activedoc*)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of if
(vla-startundomark *kpblc-activedoc*)
(cond
((setq round
(getreal "\nЗначение округления координат <Приводить к целым> : ")
) ;_ end of setq
)
(t (setq round 0.))
) ;_ end of cond
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))
(cond
((member (cdr (assoc 0 (entget ent))) '("POINT" "ARC" "CIRCLE" "INSERT"))
(_kpblc-ent-modify-autoregen
ent
10
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(cdr (assoc 10 (entget ent)))
) ;_ end of mapcar
t
) ;_ end of _kpblc-ent-modify-autoregen
)
((= (cdr (assoc 0 (entget ent))) "LINE")
(mapcar '(lambda (y)
(_kpblc-ent-modify-autoregen
ent
y
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(cdr (assoc y (entget ent)))
) ;_ end of mapcar
t
) ;_ end of _kpblc-ent-modify-autoregen
) ;_ end of lambda
'(10 11)
) ;_ end of mapcar
)
((= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(vla-put-coordinates
(vlax-ename->vla-object ent)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbdouble
(cons 0
(1- (length (setq lst
(mapcar
'(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ; _ end of
; _kpblc-eval-nearest
) ;_ end of lambda
(vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates (vlax-ename->vla-object ent))
) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of LENGTH
) ;_ end of 1-
) ;_ end of cons
) ;_ end of vlax-make-safearray
lst
) ;_ end of vlax-safearray-fill
) ;_ end of vlax-make-variant
) ;_ end of vla-put-Coordinates
)
) ;_ end of cond
) ;_ end of foreach
(vla-endundomark *kpblc-activedoc*)
(princ)
) ;_ end of defunЧерт, что значит спешка. Замени в коде строки
(cond
((setq round
(getreal "\nЗначение округления координат <Приводить к целым> : ")
) ;_ end of setq
)
(t (setq round 0.))
) ;_ end of condна
(cond
((setq round
(getreal "\nЗначение округления координат <Приводить к целым> : ")
) ;_ end of setq
)
(t (setq round 1.))
) ;_ end of condТогда ошибки быть не должно.
Замечательно. Действительно, то что давно было надо. Огромное спасибо от МНОГИХ добрых людей. Все в Восхищении!
p.s. А можно еще округлить радиусы окружностей, дуг и эллипсов? :) И будет просто конфетка.
> Fill
Хм... В общем, так. На данный момент округление координат по всем 3 измерениям идет с одним единственным значением. Округлять радиусы надо с тем же значением?
На самом деле вопросов намного больше:
- обрабатывать или нет элементы, входящие в блоки (внешние ссылки, кстати, тоже еще могут прилично жизнь подпортить)?
- что делать с текстами?
- что делать с размерами, проставленными в файле?
- что делать с примитивами, имеющими не мировую систему координат?
- что делать с объектами, до описания точек которых не добраться (например, 3dsolid, или примитивы, которые лежат не в текущем пространстве, и при этом отрисованы не в мировой системе координат)?
Ну и так далее. В общем, пополнее задачу, а то у меня telepat mode неустойчиво работает.
Все правильно: округление по всем измерениям с одним значением. И радиусы привести к этой же величине. Элементы в блоках по условию задачи уже с точными координатами. Внешних ссылок, solid'ов, штриховок, размеров (уже) нет. Разве что, привести все к мировой системе координат. Кстати, вчерашних thanks было 4, сегодня добавилось еще 2. Будет больше! :)
Насчет приведения в мировую систему - можешь посмотреть на https://www.caduser.ru/forum/topic29528.html
Теперь о радиусах (я искренне надеюсь, что эллипсов нет) - спробуй (чтоб не править код, я сразу полный выложу):
(defun c:round-coord (/ _kpblc-eval-nearest
_kpblc-ent-modify-autoregen _kpblc-conv-list-to-2dpoints
lst
)
(defun _kpblc-conv-list-to-2dpoints (lst / res)
(cond
((not lst)
nil
)
(t
(setq res (cons (list (car lst)
(if (cadr lst)
(cadr lst)
0.
) ;_ end of if
) ;_ end of list
(_kpblc-conv-list-to-2dpoints (cddr lst))
) ;_ end of cons
) ;_ end of setq
)
) ;_ end of cond
res
) ;_ end of defun
(defun _kpblc-ent-modify-autoregen (ent bit value
ext_regen / ent_list
old_dxf new_dxf layer_dxf70
)
(if (not
(and
(or
(= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
(= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
(= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
) ;_ end of or
(= bit 100)
) ;_ end of and
) ;_ end of not
(progn
(setq ent_list (entget ent)
new_dxf (cons bit
(if (and (= bit 62) (= (type value) 'str))
(if (= (strcase value) "BYLAYER")
256
0
) ;_ end of if
value
) ;_ end of if
) ;_ end of cons
) ;_ end of setq
(if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
(progn
(entmod (if old_dxf
(subst new_dxf old_dxf ent_list)
(append ent_list (list new_dxf))
) ;_ end of if
) ;_ end of entmod
(if ent_regen
(entupd ent)
(redraw ent)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
ent
) ;_ end of defun
;;;* Получение "ближайшего" к указанному числу из списка
;;;* Параметры вызова:
;;;* value контрольное значение
;;;* lst список "проверяемых" значений
(defun _kpblc-eval-nearest (value lst / x base)
(if lst
(progn
(setq x (car lst)
base (abs (- value x))
) ;_ end of setq
(foreach item (cdr lst)
(if (> base (abs (- value item)))
(setq x item
base (abs (- value item))
) ;_ end of setq
) ;_ end of if
) ;_ end of foreach
) ;_ end of progn
(setq x value)
) ;_ end of if
x
) ;_ end of defun
(vl-load-com)
(if (not *kpblc-activedoc*)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of if
(vla-startundomark *kpblc-activedoc*)
(cond
((setq round
(getreal "\nЗначение округления координат <Приводить к целым> : ")
) ;_ end of setq
)
(t (setq round 1.))
) ;_ end of cond
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))
(cond
((member (cdr (assoc 0 (entget ent))) '("POINT" "INSERT"))
(_kpblc-ent-modify-autoregen
ent
10
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(cdr (assoc 10 (entget ent)))
) ;_ end of mapcar
t
) ;_ end of _kpblc-ent-modify-autoregen
)
((member (cdr (assoc 0 (entget ent))) '("ARC" "CIRCLE"))
(mapcar '(lambda (y)
(_kpblc-ent-modify-autoregen
ent
y
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(cdr (assoc y (entget ent)))
) ;_ end of mapcar
t
) ;_ end of _kpblc-ent-modify-autoregen
) ;_ end of lambda
'(10 40)
) ;_ end of mapcar
)
((= (cdr (assoc 0 (entget ent))) "LINE")
(mapcar '(lambda (y)
(_kpblc-ent-modify-autoregen
ent
y
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(cdr (assoc y (entget ent)))
) ;_ end of mapcar
t
) ;_ end of _kpblc-ent-modify-autoregen
) ;_ end of lambda
'(10 11)
) ;_ end of mapcar
)
((= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(vla-put-coordinates
(vlax-ename->vla-object ent)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbdouble
(cons 0
(1- (length (setq lst
(mapcar
'(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ; _ end of
; _kpblc-eval-nearest
) ;_ end of lambda
(vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates (vlax-ename->vla-object ent))
) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of length
) ;_ end of 1-
) ;_ end of cons
) ;_ end of vlax-make-safearray
lst
) ;_ end of vlax-safearray-fill
) ;_ end of vlax-make-variant
) ;_ end of vla-put-Coordinates
)
) ;_ end of cond
) ;_ end of foreach
(vla-endundomark *kpblc-activedoc*)
(princ)
) ;_ end of defunКстати, вчерашних thanks было 4, сегодня добавилось еще 2
Ты их что, считаешь?????
Странно... Вчерашний код работал, этот не хочет:
Command: ROUND-COORD
Значение округления координат <Приводить к целым> : 10
Select objects: Specify opposite corner: 4615 found
Select objects:
; error: An error has occurred inside the *error* functionAutoCAD variable
setting rejected: "OSMODE" nil
Посмотри, please...
Ессно, я ж упустил, что для радиусов немного по другому надо делать :)
Чтоб не переписывать вообще все, да заодно и ошибки возможные отловить, попробуй:
(defun c:round-coord (/ _kpblc-eval-nearest
_kpblc-ent-modify-autoregen _kpblc-conv-list-to-2dpoints
lst
)
(defun _kpblc-conv-list-to-2dpoints (lst / res)
(cond
((not lst)
nil
)
(t
(setq res (cons (list (car lst)
(if (cadr lst)
(cadr lst)
0.
) ;_ end of if
) ;_ end of list
(_kpblc-conv-list-to-2dpoints (cddr lst))
) ;_ end of cons
) ;_ end of setq
)
) ;_ end of cond
res
) ;_ end of defun
(defun _kpblc-ent-modify-autoregen (ent bit value
ext_regen / ent_list
old_dxf new_dxf layer_dxf70
)
(if (not
(and
(or
(= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
(= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
(= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
) ;_ end of or
(= bit 100)
) ;_ end of and
) ;_ end of not
(progn
(setq ent_list (entget ent)
new_dxf (cons bit
(if (and (= bit 62) (= (type value) 'str))
(if (= (strcase value) "BYLAYER")
256
0
) ;_ end of if
value
) ;_ end of if
) ;_ end of cons
) ;_ end of setq
(if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
(progn
(entmod (if old_dxf
(subst new_dxf old_dxf ent_list)
(append ent_list (list new_dxf))
) ;_ end of if
) ;_ end of entmod
(if ent_regen
(entupd ent)
(redraw ent)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
ent
) ;_ end of defun
;;;* Ïîëó÷åíèå "áëèæàéøåãî" ê óêàçàííîìó ÷èñëó èç ñïèñêà
;;;* Ïàðàìåòðû âûçîâà:
;;;* value êîíòðîëüíîå çíà÷åíèå
;;;* lst ñïèñîê "ïðîâåðÿåìûõ" çíà÷åíèé
(defun _kpblc-eval-nearest (value lst / x base)
(if lst
(progn
(setq x (car lst)
base (abs (- value x))
) ;_ end of setq
(foreach item (cdr lst)
(if (> base (abs (- value item)))
(setq x item
base (abs (- value item))
) ;_ end of setq
) ;_ end of if
) ;_ end of foreach
) ;_ end of progn
(setq x value)
) ;_ end of if
x
) ;_ end of defun
(vl-load-com)
(if (not *kpblc-activedoc*)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of if
(vla-startundomark *kpblc-activedoc*)
(cond
((setq round
(getreal "\nÇíà÷åíèå îêðóãëåíèÿ êîîðäèíàò <Ïðèâîäèòü ê öåëûì> : ")
) ;_ end of setq
)
(t (setq round 1.))
) ;_ end of cond
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))
(vl-catch-all-apply
'(lambda ()
(cond
((member (cdr (assoc 0 (entget ent))) '("POINT" "INSERT"))
(_kpblc-ent-modify-autoregen
ent
10
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(cdr (assoc 10 (entget ent)))
) ;_ end of mapcar
t
) ;_ end of _kpblc-ent-modify-autoregen
)
((member (cdr (assoc 0 (entget ent))) '("ARC" "CIRCLE"))
(mapcar
'(lambda (y)
(_kpblc-ent-modify-autoregen
ent
y
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(if (= (type (cdr (assoc y (entget ent)))) 'list)
(cdr (assoc y (entget ent)))
(list (cdr (assoc y (entget ent))))
) ;_ end of if
) ;_ end of mapcar
t
) ;_ end of _kpblc-ent-modify-autoregen
) ;_ end of lambda
'(10 40)
) ;_ end of mapcar
)
((= (cdr (assoc 0 (entget ent))) "LINE")
(mapcar '(lambda (y)
(_kpblc-ent-modify-autoregen
ent
y
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(cdr (assoc y (entget ent)))
) ;_ end of mapcar
t
) ;_ end of _kpblc-ent-modify-autoregen
) ;_ end of lambda
'(10 11)
) ;_ end of mapcar
)
((= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(vla-put-coordinates
(vlax-ename->vla-object ent)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbdouble
(cons 0
(1- (length (setq lst
(mapcar
'(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ; _ end of
; _kpblc-eval-nearest
) ;_ end of lambda
(vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates
(vlax-ename->vla-object ent)
) ;_ end of vla-get-coordinates
) ; _ end of
; vlax-variant-value
) ; _ end of
; vlax-safearray->list
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of length
) ;_ end of 1-
) ;_ end of cons
) ;_ end of vlax-make-safearray
lst
) ;_ end of vlax-safearray-fill
) ;_ end of vlax-make-variant
) ;_ end of vla-put-Coordinates
)
) ;_ end of cond
) ;_ end of LAMBDA
) ;_ end of VL-CATCH-ALL-APPLY
) ;_ end of foreach
(vla-endundomark *kpblc-activedoc*)
(princ)
) ;_ end of defunЯ тут попробовал на дуге с радиусом 40 сделать округление до 100. Ессно, вывалило ошибку :) Тепрь не должно
Увы! Округление по отрезкам и цетрам дуг и окружностей есть, а по радиусам нет :( А весь процесс выглядит так:
Command: ROUND-COORD
Çíà÷åíèå
îêðóãëåíèÿ
êîîðäèíàò
<Ïðèâîäèòü ê
öåëûì> :
Select objects: Specify opposite corner: 1151 found
Select objects:
Command:
Попробуй в любом файле сдвинуть все элементы по x и y на какую-нибудь ничтожную дробную величину, а потом запусти ROUND-COORD.
И форматирование, и логика - всему кранты настали... А если так?
(defun c:round-coord (/ _kpblc-eval-nearest
_kpblc-ent-modify-autoregen
_kpblc-conv-list-to-2dpoints
lst round
)
(defun _kpblc-conv-list-to-2dpoints (lst / res)
(cond
((not lst)
nil
)
(t
(setq res (cons (list (car lst)
(if (cadr lst)
(cadr lst)
0.
) ;_ end of if
) ;_ end of list
(_kpblc-conv-list-to-2dpoints (cddr lst))
) ;_ end of cons
) ;_ end of setq
)
) ;_ end of cond
res
) ;_ end of defun
(defun _kpblc-ent-modify-autoregen (ent bit value
ext_regen / ent_list
old_dxf new_dxf layer_dxf70
)
(if (not
(and
(or
(= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
(= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
(= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
) ;_ end of or
(= bit 100)
) ;_ end of and
) ;_ end of not
(progn
(setq ent_list (entget ent)
new_dxf (cons bit
(if (and (= bit 62) (= (type value) 'str))
(if (= (strcase value) "BYLAYER")
256
0
) ;_ end of if
value
) ;_ end of if
) ;_ end of cons
) ;_ end of setq
(if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
(progn
(entmod (if old_dxf
(subst new_dxf old_dxf ent_list)
(append ent_list (list new_dxf))
) ;_ end of if
) ;_ end of entmod
(if ent_regen
(entupd ent)
(redraw ent)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
ent
) ;_ end of defun
;;;* Получение "ближайшего" к указанному числу из списка
;;;* Параметры вызова:
;;;* value контрольное значение
;;; * lst список "проверяемых" значений
(defun _kpblc-eval-nearest (value lst / x base)
(if lst
(progn
(setq x (car lst)
base (abs (- value x))
) ;_ end of setq
(foreach item (cdr lst)
(if (> base (abs (- value item)))
(setq x item
base (abs (- value item))
) ;_ end of setq
) ;_ end of if
) ;_ end of foreach
) ;_ end of progn
(setq x value)
) ;_ end of if
x
) ;_ end of defun
(vl-load-com)
(if (not *kpblc-activedoc*)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of if
(vla-startundomark *kpblc-activedoc*)
(cond
((setq round
(getreal "\nЗначение округления координат <Приводить к целым> : ")
) ;_ end of setq
)
(t (setq round 1.))
) ;_ end of cond
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))
(vl-catch-all-apply
(function
(lambda ()
(cond
((member (cdr (assoc 0 (entget ent))) '("POINT" "INSERT"))
(_kpblc-ent-modify-autoregen
ent
10
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(cdr (assoc 10 (entget ent)))
) ;_ end of mapcar
t
) ;_ end of _kpblc-ent-modify-autoregen
)
((member (cdr (assoc 0 (entget ent))) '("ARC" "CIRCLE"))
(mapcar
'(lambda (y)
(_kpblc-ent-modify-autoregen
ent
y
((lambda (/ res)
(setq res
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(if (= (type (cdr (assoc y (entget ent)))) 'list)
(cdr (assoc y (entget ent)))
(list (cdr (assoc y (entget ent))))
) ;_ end of if
) ;_ end of mapcar
) ;_ end of setq
(if (/= (type (cdr (assoc y (entget ent)))) 'list)
(setq res (car res))
) ;_ end of if
res
) ;_ end of lambda
)
t
) ;_ end of _kpblc-ent-modify-autoregen
) ;_ end of lambda
'(10 40)
) ;_ end of mapcar
) ;_ end of cond
((= (cdr (assoc 0 (entget ent))) "LINE")
(mapcar '(lambda (y)
(_kpblc-ent-modify-autoregen
ent
y
(mapcar '(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ;_ end of _kpblc-eval-nearest
) ;_ end of lambda
(cdr (assoc y (entget ent)))
) ;_ end of mapcar
t
) ;_ end of _kpblc-ent-modify-autoregen
) ;_ end of lambda
'(10 11)
) ;_ end of mapcar
)
((= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(vla-put-coordinates
(vlax-ename->vla-object ent)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbdouble
(cons 0
(1- (length (setq lst
(mapcar
'(lambda (x)
(_kpblc-eval-nearest
x
(list (* round (fix (/ x round)))
(* round (1+ (fix (/ x round))))
) ;_ end of list
) ; _ end of
) ;_ end of lambda
(vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates
(vlax-ename->vla-object ent)
) ;_ end of vla-get-coordinates
) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of length
) ;_ end of 1-
) ;_ end of cons
) ;_ end of vlax-make-safearray
lst
) ;_ end of vlax-safearray-fill
) ;_ end of vlax-make-variant
) ;_ end of vla-put-Coordinates
)
) ;_ end of cond
) ;_ end of LAMBDA
) ;_ end of function
) ;_ end of VL-CATCH-ALL-APPLY
) ;_ end of foreach
(vla-endundomark *kpblc-activedoc*)
(princ)
) ;_ end of defunУра-ура!! Все работает как надо. В очередной раз оказал мне неоценимую услугу, дорогой kpblc !! (когда-то были Slone и Sline). Большое спасибо!
Всегда пжалста :)
(когда-то были Slone и Sline)
Опаньки. А ето чего такое? Я уж и не помню-то...
https://www.caduser.ru/forum/topic23061.html
Vladimir S - чУДАК, который застолбился на этом сайте и лез на него с сервера. А посты - мои.
Автору спасибо, только на 2012 и 2011 акаде не пашет.
Не будет ли не скромно, попросить автора, подправить скриптик под вышеуказанные версии...
Кулик Алексей aka kpblc, спасибо!
Ты СУПЕРПИЛОТ !!!
> Fill
обрабатывать или нет элементы, входящие в блоки
А можно попросить кусочек кода, чтобы элементы внутри блоков тоже обрабатывались?
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форум работает на PunBB, при поддержке Informer Technologies, Inc
