Сглаживание полилинии через жестко заданные точки

Felix_the_cat · 07.09.2009, 10:44

Здравствуйте уважаемые форумчане.
Однажды на каком-то сайте попался ЛИСП, который выполняет сглаживание полилинии через жестко заданные точки. Я его к сожалению не сохранил, адрес потерялся. Пытался найти его через поиск, но ничего не получилось. Скачал "Новые команды для работы с полилинией", там есть замена линейного сегмента дуговым, однако этот лисп требует чтобы каждый сегмент заменялся вручную. А хотелось бы что бы автоматической замены. Может у кого есть нужный ЛИСП?

Кулик Алексей aka kpblc · 07.09.2009, 11:23

Это часом не команда _pedit будет?

Felix_the_cat · 07.09.2009, 11:30

Нет. _pedit, потом spline - это немного не то.
она сглаживает полилинию, но она после этого не проходит через точки,
по которым нарисована.
На каком-то сайте видел ЛИСП, при выполнении которого линия сглажена,
но проходит через заданные точки при рисовании. К нему даже рисунки поясняющие были. Но, вот теперь, когда он очень нужен - найти не могу.

Кулик Алексей aka kpblc · 07.09.2009, 11:35

Теперь начинаю подозревать команду _.spline

Disney · 07.09.2009, 11:41

Цитата:

Сообщение от Felix_the_cat

Нет. _pedit, потом spline - это немного не то.

Вместо Spline попробуй Fit

Felix_the_cat · 07.09.2009, 11:48

К сожалению. Эта команда рисует сплайн, а ЛИСП правил нарисованную полилинию, наверное рисуя по его точкам сплайн. Я к сожалению тогда не уделил ему должного внимания, о чем теперь жалею.
Поясню ситуацию зачем он мне нужен.
В теме "Как в автокаде сделать триангуляцию?" по ссылке http://dorogi2.narod.ru/program/dtm.rar скачал ЛИСП который выполняет триангуляцию. Но после этого полученные полилинии необходимо сгладить, что бы они не были с углами, а такими как получаются после _pedit и сплайн. Вручную делать - монотонно и долго. А ЛИСПом поправить - намного быстрее, остается только просмотреть что бы изолинии на имели пересечений

Disney: "Вместо Spline попробуй Fit"
Спасибо, это то, что нужно. Но все-же ищется ЛИСП, для того что бы выполнить за раз комманду с множеством линий

Ладно, надоело искать, пойдем другим путем...

по образцу не помню чьего поста:

;|============= Команда fitpol ==================================
Назначение: Выполнение "fit" для групы полилиний.
Я попробую разобраться, поправьте если что:
pedit - вызывает редактирование полилиний;
"m" - выбирает режим Multiple для редактирования;
ssget- выбор объектов на чертеже;
(list (cons 0 "LWPOLYLINE")))- фильтрует выбор, позволяя добавить в набор только lightweightpolyline.
"f" - в режиме редактирования fit для выбранных объектов.
Особенности: Нет.
|;
(defun C:fitpol ()
(command "._pedit" "_m" (ssget (list (cons 0 "LWPOLYLINE"))) "" "_f" "")
)

Только вот хотелось бы что бы оригинальные полилинии остались, а к ним добавились бы редактированные

Кулик Алексей aka kpblc · 07.09.2009, 13:46

Код:

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

(defun test (/ adoc ent spline _kpblc-conv-ent-pline-vertex-to-wcs)

  (defun _kpblc-conv-ent-pline-vertex-to-wcs (ent / elevation normal)
                                             ;|
*    Функция получения координат легкой полилинии (LWPOLYLINE) в WCS. Возвращает
* список 3Д-точек
*    Автор: BOZ (http://www.autocad.ru/cgi-bin/f1/board.cgi?t=26461HC)
*    Оригинальный код:
(defun lwpoly_vert (lwpoly / plinee elev vnv)
  (setq	plinee (entget lwpoly)
	elev   (cdr (assoc 38 plinee))
	vnv    (cdr (assoc 210 plinee))
	) ;_ end of setq
  (mapcar
    (function (lambda (x) (trans (list (cadr x) (caddr x) elev) vnv 0)))
    (vl-remove-if-not (function (lambda (x) (= (car x) 10))) plinee)
    ) ;_ end of mapcar
  ) ;_ end of defun
*    Параметры вызова:
*	ent	ename-указатель на LWPOLYLINE (контроля не производится)
*    Примеры вызова:
(_kpblc-conv-ent-pline-vertex-to-wcs (car (entsel)))
|;
    (setq elevation (cdr (assoc 38 (entget ent)))
          normal    (cdr (assoc 210 (entget ent)))
          ) ;_ end of setq
    (if (not elevation)
      (setq elevation 0.)
      ) ;_ end of if
    (mapcar '(lambda (x) (trans (list (cadr x) (caddr x) elevation) normal 0))
            (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))
            ) ;_ end of mapcar
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type (setq ent (vl-catch-all-apply
                           (function
                             (lambda ()
                               (ssname (ssget "_+.:S:E:L" '((0 . "LWPOLYLINE"))) 0)
                               ) ;_ end of lambda
                             ) ;_ end of function
                           ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'ename
         ) ;_ end of =
    (progn
      (setq spline (vla-addspline
                     (vla-objectidtoobject adoc (vla-get-ownerid (vlax-ename->vla-object ent)))
                     ((lambda (/ lst)
                        (setq lst (apply 'append (_kpblc-conv-ent-pline-vertex-to-wcs ent)))
                        (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble
                                                                                     (cons 0 (1- (length lst)))
                                                                                     ) ;_ end of vlax-make-safearray
                                                                lst
                                                                ) ;_ end of vlax-safearray-fill
                                           ) ;_ end of vlax-make-variant
                        ) ;_ end of lambda
                      )
                     (vlax-3d-point '(0. 0. 0.))
                     (vlax-3d-point '(0. 0. 0.))
                     ) ;_ end of vla-addspline
            ent    (vlax-ename->vla-object ent)
            ) ;_ end of setq
      (foreach prop '("layer" "color" "lineweight" "linetype" "closed")
        (vl-catch-all-apply
          (function
            (lambda ()
              (vlax-put-property spline prop (vlax-get-property ent prop))
              ) ;_ end of lambda
            ) ;_ end of function
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of foreach
      (vla-erase ent) ; Если надо оставлять исходник, строку закомментировать
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

и вариант 2:

Код:

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

(defun test2 (/ adoc ent spline _kpblc-conv-ent-pline-vertex-to-wcs)

  (defun _kpblc-conv-ent-pline-vertex-to-wcs (ent / elevation normal)
                                             ;|
*    Функция получения координат легкой полилинии (LWPOLYLINE) в WCS. Возвращает
* список 3Д-точек
*    Автор: BOZ (http://www.autocad.ru/cgi-bin/f1/board.cgi?t=26461HC)
*    Оригинальный код:
(defun lwpoly_vert (lwpoly / plinee elev vnv)
  (setq	plinee (entget lwpoly)
	elev   (cdr (assoc 38 plinee))
	vnv    (cdr (assoc 210 plinee))
	) ;_ end of setq
  (mapcar
    (function (lambda (x) (trans (list (cadr x) (caddr x) elev) vnv 0)))
    (vl-remove-if-not (function (lambda (x) (= (car x) 10))) plinee)
    ) ;_ end of mapcar
  ) ;_ end of defun
*    Параметры вызова:
*	ent	ename-указатель на LWPOLYLINE (контроля не производится)
*    Примеры вызова:
(_kpblc-conv-ent-pline-vertex-to-wcs (car (entsel)))
|;
    (setq elevation (cdr (assoc 38 (entget ent)))
          normal    (cdr (assoc 210 (entget ent)))
          ) ;_ end of setq
    (if (not elevation)
      (setq elevation 0.)
      ) ;_ end of if
    (mapcar '(lambda (x) (trans (list (cadr x) (caddr x) elevation) normal 0))
            (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))
            ) ;_ end of mapcar
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type (setq selset (vl-catch-all-apply
                              (function
                                (lambda ()
                                  (ssget "_:L" '((0 . "LWPOLYLINE")))
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
    (progn
      (foreach ent ((lambda (/ tab item)
                      (repeat (setq tab  nil
                                    item (sslength selset)
                                    ) ;_ end setq
                        (setq tab (cons (ssname selset (setq item (1- item))) tab))
                        ) ;_ end repeat
                      ) ;_ end of lambda
                    )
        (setq spline (vla-addspline
                       (vla-objectidtoobject adoc (vla-get-ownerid (vlax-ename->vla-object ent)))
                       ((lambda (/ lst)
                          (setq lst (apply 'append (_kpblc-conv-ent-pline-vertex-to-wcs ent)))
                          (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble
                                                                                       (cons 0 (1- (length lst)))
                                                                                       ) ;_ end of vlax-make-safearray
                                                                  lst
                                                                  ) ;_ end of vlax-safearray-fill
                                             ) ;_ end of vlax-make-variant
                          ) ;_ end of lambda
                        )
                       (vlax-3d-point '(0. 0. 0.))
                       (vlax-3d-point '(0. 0. 0.))
                       ) ;_ end of vla-addspline
              ent    (vlax-ename->vla-object ent)
              ) ;_ end of setq
        (foreach prop '("layer" "color" "lineweight" "linetype" "closed")
          (vl-catch-all-apply
            (function
              (lambda ()
                (vlax-put-property spline prop (vlax-get-property ent prop))
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of foreach
      (vla-erase ent) ; Если надо оставлять исходник, строку закомментировать
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Felix_the_cat · 07.09.2009, 14:43

Спасибо огромное. Работает превосходно. Особенно на полилинии, где попадаются острые углы. Делает так, что лучше и не придумаешь. Еще раз - спасибо!

Sleekka · 15.09.2009, 18:08

Алексей подскажи пожалуйста, откуда ты берешь документацию по этим фильтрам, у меня такой нету.

Код:

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

(ssget "_:L" '((0 . "LWPOLYLINE")))

Код:

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

(ssname (ssget "_+.:S:E:L" '((0 . "LWPOLYLINE"))) 0)

А это я так подозреваю очень хитрый обход промаха в случае с

Код:

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

(ssget "_:S" '((0 . "LWPOLYLINE")))

чтобы ssget не писать свой как это ShaggyDoc делает, так ведь?

Александр Ривилис · 15.09.2009, 18:16

Из ObjectARX SDK:

Код:

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

For the str argument, use one of the strings listed in the following table. 

Value of str argument  Description  
NULL  Single-point selection (if pt1 is specified) or user selection (if pt1 is also NULL)
  
"I"  The PICKFIRST set  
"C"  Crossing selection  
"CL"  Object classification class  
"CP"  Crossing polygon selection  
"F"  Fence (open polygon) selection  
"L"  Last created entity  
"P"  Previous selection set  
"W"  Window selection  
"WP"  Window polygon selection  
"X"  Filter selection only  
"G"  Groups  
":$"  Prompts supplied  
":?"  "Other" callbacks  
":D"  Duplicates OK  
":E"  Everything in aperature  
":K"  Keyword callbacks  
":N"  Nested  
":S"  Force single object selection only  
":U"  Enables subentity selection  
":V"  Forces subentity selection  
":r"  Enables entities in long transactions to be selected  
"."  User pick  
"#"  Nongeometric (all, last, previous)  
"A"  All  
"B"  BOX  
"M"  Multiple

Sleekka · 15.09.2009, 18:18

Спасибо за ответ, но я не вижу здесь

Код:

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

":L"

.

Кулик Алексей aka kpblc · 15.09.2009, 18:21

Это обход блокированного слоя (выбрать примитив на блокированном слое невозможно). По-моему, в обычной справке было.

Трафарет · 21.05.2015, 14:05

Товарищи, кто-нибудь знает, как запустить LISP из поста #7?
Я, как человек не владеющий ЛИСПом, всегда ищу строку типа "defun c ЁПРСТ", но здесь её нет..
Видимо это только функция для построения точек?

Кулик Алексей aka kpblc · 21.05.2015, 14:17

http://dwg.ru/pub/9

Трафарет · 21.05.2015, 14:37

Всё заработало! Спасибо, Солнцеликий.

07.09.2009, 10:44		#1
Сглаживание полилинии через жестко заданные точки Felix_the_cat Регистрация: 20.08.2009 Сообщений: 9 Здравствуйте уважаемые форумчане. Однажды на каком-то сайте попался ЛИСП, который выполняет сглаживание полилинии через жестко заданные точки. Я его к сожалению не сохранил, адрес потерялся. Пытался найти его через поиск, но ничего не получилось. Скачал "Новые команды для работы с полилинией", там есть замена линейного сегмента дуговым, однако этот лисп требует чтобы каждый сегмент заменялся вручную. А хотелось бы что бы автоматической замены. Может у кого есть нужный ЛИСП?
Просмотров: 8833

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Расстояние от начала полилинии до опеделенной точки	bimari	AutoCAD	42	25.03.2021 13:57
lisp: Длина по полилинии до точки	vosh	LISP	19	15.07.2013 15:10
не отображается свойство точки (полилинии)	KAT_23	AutoCAD	10	14.04.2009 10:14
Задание начальной точки у замкнутой полилинии	Sky_cool	Программирование	2	23.01.2008 11:11
Координаты точки, лежащей на полилинии	Al_Taron	Программирование	1	27.11.2006 09:45