[Макс_Кунгур]

Добрый день. Подскажите, пожалуйста. Есть чертеж со множеством полилиний. Как при помощи lisp выбрать 2 из них и построить между ними перпендикуляры? При этом 1 полилинию надо разбить на одинаковые отрезки (например 5 ед), и из каждых этих точек, начиная с начала полилинии, будут построены перпендикуляры на 2 полилинию.

[Profan]

Перпендикуляр одновременно к двум линиям возможен только в том случае, если эти линии параллельны или подобны.

[Макс_Кунгур]

Profan, они практически параллельны. А можно сделать перпендикуляры не именно ко 2 линии, а чтобы они ее пересекали и лишнее обрезать, чтобы они заканчивались на ней?

[Profan]

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

[Макс_Кунгур]

Profan, мне надо lisp-приложение написать под этот чертеж, а не чертить в AutoCad-е.

Кто-нибудь, подскажите, пожалуйста как это осуществить или, может быть, у кого-то есть уже готовый lisp на этот вопрос?

[Кулик Алексей aka kpblc]

Макс_Кунгур, "практически" параллельные и параллельные есть вещи разные принципиально. Вплоть до невозможности решения задачи.
P.S. У меня ощущение, что надо сделать нечто типа alx-dike (кажется, так). То бишь строить изображения откосов.

[LSN]

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

[Profan]

Я это и предложил проверить Макс_Кунгур'у, чтобы убедиться в неоднозначности задачи, а он, вишь, выкобенивается.

[Макс_Кунгур]

Кулик Алексей aka kpblc, 1-я линия - это кривая горизонта, 2-я линия - это подошва горизонта. Они могут быть и параллельными, и не параллельными. Как я понимаю, нужно рассматривать два случая по отдельности. Если параллельны, то так строятся перпендикуляры, если нет - то по другому.

[Кулик Алексей aka kpblc]

Макс_Кунгур, так дело-то в том, что сначала надо поставить задачу. Полностью. Предусмотрев все варианты. И только после этого задумываться о решении (которое, скорее всего, сведется к применению команды _.divide с опцией _block).

[Макс_Кунгур]

Кулик Алексей aka kpblc, задача состоит в следующем:
1. Выбираем первую полилинию
2. Выбираем вторую полилинию
3. Первая полилиния делится на отрезки одинаковой длины начиная с начала.
4. Строятся перпендикуляры по этим отрезкам, начиная с начала первой полилинии, пересекающие вторую полилинию. (перпендикуляры должны отсекаться 2-й полилинией)
6. Если вторая полилиния длиннее 1-й (что слева, что справа), обрезаем ее до первого и последнего перпендикуляра.

Полилинии могут быть как параллельными так и не параллельными.

[ытя]

Осталось изменить название темы на: "Построение перпендикуляров к первой линии и их обрезка по второй".

[ShaggyDoc]

Для размышления о "перпендикулярах" - технология рисования

http://cad.kurganobl.ru/risovanie_otkosov.html

и еще две заметки внутри. В качестве постановки задачи.

А реализация простая: (ru-draw-topo-slope T T 3.0 0.5)

[Макс_Кунгур]

Сообщение от Кулик Алексей aka kpblc Макс_Кунгур, P.S. У меня ощущение, что надо сделать нечто типа alx-dike (кажется, так). То бишь строить изображения откосов.

Все правильно, что мне и нужно (строить изображения откосов). Только это нужно реализовать через LISP, а у ShaggyDoc - там через ruCAD.

Потестировал я программы dike и otkos, все хорошо, все красиво, то, что нужно, но они не реализуют:

1. Не обрезают полилинии до первого перпендикуляра и после последнего.
2. Рисуют только простой откос, а мне нужно еще чтобы еще рисовался добычной откос (чтобы был выбор, какой откос рисовать).

Подскажите, пожалуйста, кто-нибудь знает, как это реализовать?

[zamtmn]

ShaggyDoc
а чем вызвана неправильная работа при сглаживании дугами?

[ShaggyDoc]

Сообщение от zamtmn ShaggyDoc а чем вызвана неправильная работа при сглаживании дугами?

А вот как раз неоднозначностью расчет геометрии. Опорных точек-то у полилинии, сглаженной дугами, не добавляется. Вот и целевые высчитываются неправильно. Это внутренние недостатки штатных функций.

а мне нужно еще чтобы еще рисовался добычной откос (чтобы был выбор, какой откос рисовать)

Это уже детали. Сначала делается базовая функция, а для неё уже в виде аргументов разные варианты рисования. Я же не зря пример привел (ru-draw-topo-slope T T 3.0 0.5)
Здесь 4 аргумента определяют варианты рисования бровок и штрихов. Можно сделать сколько угодно вариантов.

Тут важно забыть про "обрезают", "удлиняют". И особенно - слово "перпендикуляр". Всё только на геометрических вычислениях должно быть. Можно ведь и координаты концов бровок изменить, если надо.

Только это нужно реализовать через LISP, а у ShaggyDoc - там через ruCAD.

А там LISP и есть. И ничего более.

[zamtmn]

>>Это внутренние недостатки штатных функций
т.е. не учитываются скругления, обрабатываются как прямые?

>>Тут важно забыть про "обрезают", "удлиняют".
>>И особенно - слово "перпендикуляр"
Я бы заменил "перпендикуляр" на "ближайшая"
тогда получится:
1 measurим линию от которой строим с нужным шагом
2 measurим линию к которой строим с более мелким (в пределах разумного, с учетом нужной точности) шагом
3 перебераем токи из (1) ишем ближайшие им точки из(2) и их соединяем.

шаг 3 легко оптимизируется, поиск прекращается как только растояние начинает увеличиваться, с каждлой итерацией поиск начинается в месте где закончился предидущий раз
edit: забыл что нужно учесть направление полилиний и искать или с начала или с конца второго списка

[Макс_Кунгур]

ShaggyDoc, а ты не можешь выложить готовый lisp на мой вопрос, а то я сам не смогу его сделать?

[ShaggyDoc]

Сообщение от Макс_Кунгур ShaggyDoc, а ты не можешь выложить готовый lisp на мой вопрос, а то я сам не смогу его сделать?

Легко. Самое главное - остальное сам сделаешь.

Код:

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

(defun ru-draw-topo-slope (is_draw_short
                           is_dot
                           dist_berg
                           length_berg_rel
                          )
;; (ru-draw-topo-slope T nil 3.0 0.5)
;; (RU-DRAW-TOPO-SLOPE T nil 2.0 1.0)
;; (ru-draw-topo-slope T 2.0 1.0) - откос
;; (ru-draw-topo-slope T 3.0 0.5) - откос
;; (ru-draw-topo-slope T 3.0 2.0) - откос
;; (ru-draw-topo-slope 2.0 1.0) - обрыв
  (_ru-draw-some-slope
    is_draw_short
    is_dot
    dist_berg
    length_berg_rel
    'ru-topo-draw-slope-one
  ) ;_ end of _ru-draw-some-slope

) ;_ end of defun




(defun _ru-draw-some-slope (is_draw_short
                           is_dot
                           dist_berg
                           length_berg_rel
                           func
                           /

                           bottom_point
                           dist
                           dist_dot
                           dist_short
                           end_dot
                           end_short
                           ent_bottom
                           long
                           start_dot
                           len_dot
                          )
  (ru-app-begin)
  ;|
Откос или обрыв
(RU-DRAW-TOPO-SLOPE T nil 2.0 1.0)
(ru-draw-topo-slope T 2.0 1.0) - откос
(ru-draw-topo-slope T 3.0 0.5) - откос
(ru-draw-topo-slope T 3.0 2.0) - откос
(ru-draw-topo-slope 2.0 1.0) - обрыв
Новые аргументы 
dist_berg - расстояние между бергштрихами, мм (2 было)
length_berg_rel - длина бергштрихов в долях от расстояния между кромками
(меньше 1, иначе - в долях от расстояния между бергштрихами)
Опция - укрепленный
Сглаженную полилинию разглаживать и в сплайн?

|;

  (setq
    dist_berg (ru-conv-millimeter-in-paper-to-unit dist_berg)
    dist_dot  (ru-conv-millimeter-in-paper-to-unit 2.0)
    len_dot   (* dist_dot 0.5)
  ) ;_ end of setq
  (while (setq ent_top
                (ru-get-entsel-by-type
                  "Выбери линию бровки"
                  "Это нельзя использовать в качестве бровки"
                  (list "LINE" "LWPOLYLINE" "POLYLINE" "ARC" "CIRCLE" "SPLINE")
                  t
                ) ;_ end of ru-get-entsel-by-type
         ) ;_ end of setq
    (progn
      (ru-obj-undo-begin)
      (setq
        ent_top (car ent_top)
      ) ;_ end of setq
      (ru-pline-decurve ent_top "Бровка")
      (if (setq ent_bottom
                 (ru-get-entsel-by-type
                   "Выбери линию подошвы"
                   "Это нельзя использовать в качестве подошвы"
                   (list "LINE" "POLYLINE" "LWPOLYLINE" "ARC" "CIRCLE" "SPLINE")
                   t
                 ) ;_ end of ru-get-entsel-by-type
          ) ;_ end of setq
        (progn
          (setq
            ent_bottom
             (car ent_bottom)
          ) ;_ end of setq
          (ru-pline-decurve ent_bottom "Подошва")
          (setq
            top_points_list
             (ru-geom-list-measured-points-on-curve
               ent_top
               dist_berg
             ) ;_ end of ru-geom-list-measured-points-on-curve
          ) ;_ end of setq
          (mapcar
            (function
              (lambda (top_point)
                (setq bottom_point (vlax-curve-getclosestpointto
                                     ent_bottom
                                     top_point
                                     T
                                   ) ;_ end of vlax-curve-getclosestpointto
                      dist         (distance top_point bottom_point)
                      long         (if is_draw_short
                                     (not long)
                                     t
                                   ) ;_ end of if
                                   ;; - было для откоса с короткими штрихами
                ) ;_ end of setq
                ((eval func)
                  top_point
                  bottom_point
                  dist_berg
                  (list dist dist_dot len_dot long length_berg_rel is_dot)
                )

              ) ;_ end of lambda
            ) ;_ end of function
            top_points_list
          ) ;_ end of mapcar

        ) ;_ end of progn
      ) ;_ end of if
      (ru-obj-undo-end)
    ) ;_ end of progn
  ) ;_ end of if
  (ru-app-end)
  (princ)
) ;_ end of defun

[Макс_Кунгур]

Попробовал, выдает ошибку:

Command: (ru-draw-topo-slope)
; error: too few arguments

[ShaggyDoc]

Сообщение от Макс_Кунгур Попробовал, выдает ошибку: Command: (ru-draw-topo-slope) ; error: too few arguments

Естественно. Потому что вызываешь функцию вообще без аргументов. Уже третий раз привожу пример вызова
(ru-draw-topo-slope T nil 3.0 0.5)

[FONT=Arial]Но пытаться запускать бесполезно - это же только маленькая часть необходимого, самый верхний уровень.
Общий алгоритм. А для работы требуется ещё десятка три маленьких функций. Выискивать их и выкладывать у меня нет никакого желания.
[/FONT] Я же писал - "Самое главное - остальное сам сделаешь"

[Макс_Кунгур]

ShaggyDoc, объясни, пожалуйста, как этот алгоритм работает, и какие функции мне дальше реализовать, чтобы заработало все приложение.
И у тебя в лиспе вызывается еще функция ru-app-begin, которая не описана. В ней что должно быть?

[ShaggyDoc]

Выискивать их и выкладывать у меня нет никакого желания

Тем более объяснять. Можешь прочитать книгу "САПР на базе AutoCAD - как это делается". Там всё расписано.

[Макс_Кунгур]

Все-таки кто-нибудь мне может помочь в моем вопросе? Задачу можно теперь обозначить следующим образом:

1. Выбираем первую полилинию
2. Выбираем вторую полилинию
3. Задаем шаг чередования линий откосов.
4. Выбираем вид откоса (простой или добычной).
5. Откосы рисуются.

[Disney]

На самом деле алгоритм построения откосов не сложен:
хоть по перпендикуляром, хоть по "равномерно",
хоть обычный, хоть укреплённый,
хоть с фиксированной длинной коротких штрихов, хоть в % от длинного.
Программа
Самое неприятное, что на сложных контурах, откус получается не корректным, и приходиться руками разгонять штрихи, приводя к "красивому" виду, над этим я сейчас работаю - редактирование откосов после построения...
В кратце:
есть 3 списка
список1 – координаты по бровке с заданным шагом
список2- координаты по подошве с (* 50 заданным) шагом
список3 – пары порядковых номеров координат из список1 и список2 ((0 0)(1 50)(2 100)(3 150)(4 200)(5 250)(6 300)(7 350)(8 400)…)
по списку3 строю лини.
Псле указания штриха и его нового положения получаю, например (7 567),
Вопрос:
Как плавно разогнать в списке3 порядковые номера координат из списка2

[zamtmn]

>>Псле указания штриха и его нового положения получаю, например (7 567)

Руками чтоли указывать? [17] не то?

[Disney]

Сообщение от zamtmn Руками чтоли указывать?

Да.
Принцип такой:
1) Нарисовали мы наши штрихи, на каком-то временном слое - Temp435
2) Выдаём запрос на редактирование
3) Просим указать штрих entsel (запрещая любой выбор кроме линии на слое Temp435.
4) Получаем координату начала указанного штриха vlax-curve-getStartPoint
5) Находим порядковый номер координаты в списке1 vl-position (например 7)
6) По 7 в списке3 находим, пару порядковых номеров assoc (получаем (7 350))
7) Просим указать новое положение штриха на подошве getpoint, (запрещая любой ввод кроме координат содержащихся в списке2) включена привязка только узел, на подошве до окончания работы программы остаются точки от _divide
8) Находим порядковый номер координаты в списке2 vl-position (например 567)
9) Теперь нужно из списка3 ((0 0)(1 50)(2 100)(3 150)(4 200)(5 250)(6 300)(7 350)(8 400)…) получить новый список3, что-то типа: ((0 0)(1 53)(2 107)(3 163)(4 225)(5 299)(6 400)(7 567)(8 580)...)
10) Удалить старые штрихи и построить новые, по новому списку3
11) Запрос на редактирование...
Вот с 8 пунктом и загвостка, что-то наколякол, но работает не совсем корректно, и не всегда адекватно, даже выкладывать своё безобразие не стану, т.к. стыдно за использование простых циклов, при работе со списками, а не рекурсии и apply-и с mapcar-ами

[Victor]

В самом примитивном варианте кажется работает.
dis расстояние между штрихами
berg длина короткого штриха
nah_dlina это начальная длина линии которая должна пересекать обе линии верхнюю и нижнюю.
Как это сделать лучше пока не знаю

Код:

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

(vl-load-com) 
(defun c:ber ( / pl_1 pl_2 name_p1 name_p2 pnt_1 test_p1 
                 pnt_2 test_p2 test_ugol proiz ugol_pl flag 
                 delta dis_pl dis_run krd krdXY prm_pnt iks vai)
(setq dis 1.0)
(setq berg 1.0)
(setq nah_dlina 10.0)
(setq snp (getvar "Osmode"))
(setvar "Osmode" 0) 
(setq pl_1(entsel "\nFirst poliline?"))
(setq pl_2(entsel "\nSecond poliline?"))
(setq name_p1 (car pl_1))
(setq name_p2 (car pl_2))
(setq pnt_1 (vlax-curve-getPointAtParam name_p1 0.1))
(setq test_p1 (reverse(cdr(reverse pnt_1))))
(setq pnt_2 (vlax-curve-getClosestPointToProjection name_p2 test_p1 '(0 0 1)))
(setq test_p2 (reverse(cdr(reverse pnt_2))))
(setq test_ugol (angle test_p1 test_p2))
(setq proiz (vlax-curve-getFirstDeriv name_p1 0.1))
(setq ugol_pl (+ 1.570796326 (angle '(0 0 0) proiz)))
(setq delta (abs(- test_ugol ugol_pl)))
(if (> delta pi)(setq delta (- (* 2 pi) delta)))
(if (> delta 1.57079)(setq flag 1)(setq flag 0))
(setq dis_pl (vlax-curve-getDistAtParam name_p1 (vlax-curve-getEndParam name_p1)))
(setq dis_run (- 0.0 dis) i -1)
(while(< (+ dis_run dis) dis_pl)
 (progn
  (setq i (+ i 1))
  (setq dis_run (+ dis_run dis))
  (setq krd (vlax-curve-getPointAtDist name_p1 dis_run))
  (setq krdXY (reverse(cdr(reverse krd))))
  (setq prm_pnt  (vlax-curve-getParamAtPoint name_p1 krd))
  (setq proiz (vlax-curve-getFirstDeriv name_p1 prm_pnt))
  (setq ugol_pl (+ 1.570796326 (angle '(0 0 0) proiz)))
  (if (= flag 1)(setq ugol_pl (+ pi ugol_pl)) ) ;;;;; 
  (if (= (/ i 2.0)(fix(/ i 2.0)))
   (progn
    (setq iks (+ (car  krd) (* nah_dlina (cos ugol_pl))))
    (setq vai (+ (cadr krd) (* nah_dlina (sin ugol_pl))))
    (command "_line" krd (list iks vai) "")
    (setq my_line (entlast)) 
    (repeat 5
     (setq npnt (vlax-curve-getClosestPointToProjection name_p2 krdXY '(0 0 1) T))
     (setq npntXY (reverse(cdr(reverse npnt))))
     (setq npnt (vlax-curve-getClosestPointToProjection my_line npntXY '(0 0 1) T))
     (setq krdXY (reverse(cdr(reverse npnt))))  
     )
    (entdel my_line)
    (command "_line" krd krdXY "")
    ) ;progn
   (progn
    (setq iks (+ (car  krd) (* berg (cos ugol_pl))))
    (setq vai (+ (cadr krd) (* berg (sin ugol_pl))))
    (command "_line" krd (list iks vai) "")
   ) ;progn
  ) ;if
 ) ;progn
) ;while
) ;

[Макс_Кунгур]

Victor, потестировал твой лисп. Ты правильно говоришь, что "В самом примитивном варианте кажется работает". Спасибо за помощь! Но программы otkos и dike рисуют правильнее, а мне все таки нужно, чтобы перед рисованиями откосов программа спрашивала, какой откос рисовать (простой или добычной).

[Disney]

Сообщение от Макс_Кунгур (простой или добычной).

Добычный - это как?
Вот мой код (пока без редактирования)
Длина короткого штриха по запросу либо фиксированно в метрах (вводиться положительное), либо в % от длинного (вволдиться со знаком "-")

Код:

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

 
(defun c:test (/
     dmz     osm     cla     ves     siz     mod
     brovka  podoshva shag_shtrihov shag_shtrihov_vvod dlina_korotkogo dlina_korotkogo_vvod
     dlinna dlinna_podoshva colvo vsego nabor i spis_brovka spis_podoshva koord para a
     flag slovo start_shtrih end_shtrih change_shtrih
    )
  (vl-load-com)
  (setq dmz     (getvar "dimzin")
 osm     (getvar "OSMODE")
 cla     (getvar "CLAYER")
 ves     (getvar "LWDISPLAY")
 siz     (getvar "PDSIZE")
 mod     (getvar "PDMODE")
 brovka     (geo_vibor "\nУкажите бровку:" "*LINE" "*")
 podoshva    (geo_vibor "\nУкажите подошву:" "*LINE" "*")
 shag_shtrihov
      (if shag_shtrihov
        shag_shtrihov
        1
      )
 shag_shtrihov_vvod
      (getreal (strcat "Шаг штрихов <"
         (rtos shag_shtrihov 2 3)
         ">:"
        )
      )
 shag_shtrihov
      (if shag_shtrihov_vvod
        shag_shtrihov_vvod
        shag_shtrihov
      )
 dlina_korotkogo
      (if dlina_korotkogo
        dlina_korotkogo
        2
      )
  )
  (setvar "OSMODE" 8)
  (setvar "PDMODE" 35)
  (VL-CMDF "_-LAYER" "_M" "временный_для_откосов" "")
  (initget "Метры Проценты + -" 2)
  (setq
    dlina_korotkogo_vvod
     (getreal
       (strcat
  "Длинна короткого [Метры (+) / Проценты (-)] <"
  (rtos dlina_korotkogo 2 3)
  ">:"
       )
     )
    dlina_korotkogo
     (cond
       ((or (= dlina_korotkogo_vvod "Метры")
     (= dlina_korotkogo_vvod "+")
 )
 (initget 7)
 (getdist "Длина короткого (метры):")
       )
       ((or (= dlina_korotkogo_vvod "Проценты")
     (= dlina_korotkogo_vvod "-")
 )
 (initget 7)
 (* -1 (getreal "Длина короткого (проценты):"))
       )
       ((null dlina_korotkogo_vvod) dlina_korotkogo)
       (t dlina_korotkogo_vvod)
     )
    dlinna (vla-get-length (vlax-ename->vla-object brovka))
    dlinna_podoshva
     (vla-get-length (vlax-ename->vla-object podoshva))
    colvo (atoi (rtos (/ dlinna shag_shtrihov) 2 0))
    vsego (* colvo 10)
  )
  (setvar "PDSIZE" (/ dlinna vsego 2))
  (if (< 2 vsego 32767)
    (progn
      (vl-cmdf "_divide" brovka colvo)
      (setq
 nabor     (ssget "_X"
      '((0 . "POINT") (8 . "временный_для_откосов"))
      )
 i     0
 spis_brovka '()
      )
      (repeat (sslength nabor)
 (setq
   koord       (cdr (assoc 10 (entget (ssname nabor i))))
   spis_brovka (cons koord spis_brovka)
   i       (1+ i)
 )
      )
      (vl-cmdf "_.erase" nabor "")
      (setq
 spis_brovka
  (cons
    (vlax-curve-getEndPoint brovka)
    (reverse
      (cons
        (vlax-curve-getStartPoint brovka)
        spis_brovka
      )
    )
  )
      )
      (vl-cmdf "_divide" podoshva vsego)
      (setq
 nabor       (ssget "_X"
        '((0 . "POINT") (8 . "временный_для_откосов"))
        )
 i       0
 spis_podoshva '()
      )
      (repeat (sslength nabor)
 (setq
   koord  (cdr (assoc 10 (entget (ssname nabor i))))
   spis_podoshva (cons koord spis_podoshva)
   i  (1+ i)
 )
      )
      (setq
 spis_podoshva
  (cons (vlax-curve-getEndPoint podoshva)
        (reverse
   (cons (vlax-curve-getStartPoint podoshva)
         spis_podoshva
   )
        )
  )
 spis_podoshva
  (if (inters
        (vlax-curve-getEndPoint podoshva)
        (vlax-curve-getEndPoint brovka)
        (vlax-curve-getStartPoint podoshva)
        (vlax-curve-getStartPoint brovka)
      )
    (reverse spis_podoshva)
    spis_podoshva
  )
 para '((0 0))
 a 1
      )
      (repeat colvo
 (setq para (cons (list a (* a 10)) para)
       a    (1+ a)
 )
      )
      (setq
 para (vl-sort para
        (function (lambda (x y) (< (car x) (car y))))
      )
 flag t
      )
      (sozd)
      (while flag
;;; (initget "Да Нет Lf Ytn _ Y N Y N" 128)
;;; (setq
;;;   slovo (getint "\nРедактировать откос [Да / Нет] <Нет>:")
;;; )
;;; (if (/= slovo "Y")
;;;   (setq flag nil)
;;;   (progn
;;;     (setq start_shtrih (geo_vibor "\nНачальный ограничивающий штрих:"
;;;        "POLYLINE"
;;;        "временный_для_откосов"
;;;    )
;;;    end_shtrih (geo_vibor "\nКонечный ограничивающий штрих:"
;;;        "POLYLINE"
;;;        "временный_для_откосов"
;;;    )
;;;    change_shtrih (geo_vibor "\nРедактируемый штрих:"
;;;        "POLYLINE"
;;;        "временный_для_откосов"
;;;    )
;;;     )
;;;   )
;;; )
;;;      )
    )
    (alert "Длина бровки или подошвы слишком велика ")
  )
  (vl-cmdf "_.erase" nabor "")
  (setvar "OSMODE" osm)
  (setvar "CLAYER" cla)
  (setvar "DIMZIN" dmz)
  (setvar "LWDISPLAY" ves)
  (setvar "PDSIZE" siz)
  (setvar "PDMODE" mod)
)
 ;|
Функция geo_vibor
|;
(defun geo_vibor (zap tip sloy / flag name)
  (setq Flag t)
  (setvar "ERRNO" 0)
  (while Flag
    (cond
      ((and
  (setq name
  (car (entsel zap))
  )
  (wcmatch (cdr (assoc 0 (entget name))) tip)
  (wcmatch (cdr (assoc 8 (entget name))) sloy)
       )
       (setq Flag nil
      name name
       )
      )
      ((= (getvar "ERRNO") 52)
       (setq Flag nil)
      )
      (t
       (princ (strcat "\n\nМимо или тип не "
        tip
        (if (/= sloy "*")
   (strcat " или слой не " sloy)
   ""
        )
       )
       )
      )
    )
  )
)
 ;|
Функция sozd
|;
(defun sozd (/ t1 t2)
  (mapcar (function (lambda (x)
        (setq t1 (nth (car x) spis_brovka)
       t2 (nth (cadr x) spis_podoshva)
        )
        (IF (/= (rem (car x) 2.0) 0)
   (setq
     dlin_dl (distance t1 t2)
     dist   (cond
        ((minusp dlina_korotkogo)
         (* dlin_dl (/ (abs dlina_korotkogo) 100))
        )
        (t (/ dlina_korotkogo 2))
      )
     t2   (polar t1 (angle t1 t2) dist)
   )
        )
        (ru-pline-entmake
   (list t1 t2)
   nil
   t
   0
   0
        )
      )
   )
   para
  )
)
 ;|
Функция ru-pline-entmake
|;
(defun ru-pline-entmake
       (points is_closed is_3d width lineweight / elst ENTL)
;;; (ru-pline-entmake (список_вершин) флаг_замкнутости
;;; флаг_делать_3М_ПЛИНИЮ)
;;; возвращает имя примитива - полилинии или NIL, если что-то не
;;; вышло.
  ;|
Пример:
(ru-pline-entmake
(list
(list 220.65 345.001)
(list 332.622 546.525)
(list 846.376 320.906)
(list 719.035 121.572)
) T nil 0 50)
|;
  (if is_3d
    (progn
      (setq entl
      (list
        '(0 . "POLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDb3dPolyline")
        '(66 . 1)
        '(10 0.0 0.0 0.0)
        (cons 70
       (logior 8
        (if is_closed
          1
          0
        ) ;_ end of if
        (if (= 1 (getvar "PLINEGEN"))
          128
          0
        ) ;_ end of if
       ) ;_ end of logior
        ) ;_ end of cons
      ) ;_ end of list
      ) ;_ end of setq
      (if (entmake entl)
 (progn
   (foreach v points
     (progn
       (setq entl
       (list
         '(0 . "VERTEX")
         '(100 . "AcDbEntity")
         '(100 . "AcDbVertex")
         '(100 . "AcDb3dPolylineVertex")
         (append '(10) v)
         '(70 . 32)
       ) ;_ end of list
       ) ;_ end of setq
       (entmake entl)
     ) ;_ end of progn
   ) ;_ end of foreach
   (if (entmake '((0 . "SEQEND") (100 . "AcDbEntity")))
     (entupd (entlast))
     nil
   ) ;_ end of if
 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (progn
      (setq elst (append
     (list
       '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbPolyline")
     ;(cons 8 (getvar "CLAYER"))
       (cons 90 (length points))
       (cons 43 width)
       (cons 370 lineweight)
       (cons 70
      (logior (if is_closed
         1
         0
       ) ;_ end of if
       (if (= 1 (getvar "PLINEGEN"))
         128
         0
       ) ;_ end of if
      ) ;_ end of logand
       )   ; _ end of cons;;;
     ) ;_ end of list
     (mapcar '(lambda (p)
         (list 10 (car p) (cadr p))
       ) ;_ end of lambda
      points
     ) ;_ end of mapcar
   ) ;_ end of append
      ) ;_ end of setq
      (if (entmake elst)
 (entupd (entlast))
 nil
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

[Макс_Кунгур]

Disney, добычной - это с двумя штрихами. Выкладываю рисунок

[Disney]

Вот, коротких, сколько захочешь...

Код:

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

 
(defun c:test2 (/
     dmz     osm     cla     ves     siz     mod
     brovka  podoshva  shag_shtrihov_vvod dlina_korotkogo_vvod
     dlinna dlinna_podoshva colvo vsego nabor i spis_brovka spis_podoshva koord para a
     flag slovo start_shtrih end_shtrih change_shtrih kolvo_korot_shtrihov_vvod
     )
  (vl-load-com)
  (setq dmz (getvar "dimzin")
 osm (getvar "OSMODE")
 cla (getvar "CLAYER")
 ves (getvar "LWDISPLAY")
 siz (getvar "PDSIZE")
 mod (getvar "PDMODE")
 brovka (geo_vibor "\nУкажите бровку:" "*LINE" "*")
 podoshva (geo_vibor "\nУкажите подошву:" "*LINE" "*")
 shag_shtrihov
  (if shag_shtrihov
    shag_shtrihov
    1
  )
 shag_shtrihov_vvod
  (getreal (strcat "Шаг штрихов <"
     (rtos shag_shtrihov 2 3)
     ">:"
    )
  )
 shag_shtrihov
  (if shag_shtrihov_vvod
    shag_shtrihov_vvod
    shag_shtrihov
  )
 kolvo_korot_shtrihov
  (if kolvo_korot_shtrihov
    kolvo_korot_shtrihov
    1
  )
 kolvo_korot_shtrihov_vvod
  (getint(strcat "Количество коротких штрихов подряд <"
     (rtos kolvo_korot_shtrihov 2 3)
     ">:"
    )
  )
 kolvo_korot_shtrihov
  (if kolvo_korot_shtrihov_vvod
    kolvo_korot_shtrihov_vvod
    kolvo_korot_shtrihov)
 dlina_korotkogo
  (if dlina_korotkogo
    dlina_korotkogo
    2
  )
  )
  (setvar "OSMODE" 8)
  (setvar "PDMODE" 35)
  (VL-CMDF "_-LAYER" "_M" "временный_для_откосов" "")
  (initget "Метры Проценты + -" 2)
  (setq
    dlina_korotkogo_vvod
     (getreal
       (strcat
  "Длинна короткого [Метры (+) / Проценты (-)] <"
  (rtos dlina_korotkogo 2 3)
  ">:"
       )
     )
    dlina_korotkogo
     (cond
       ((or (= dlina_korotkogo_vvod "Метры")
     (= dlina_korotkogo_vvod "+")
 )
 (initget 7)
 (getdist "Длина короткого (метры):")
       )
       ((or (= dlina_korotkogo_vvod "Проценты")
     (= dlina_korotkogo_vvod "-")
 )
 (initget 7)
 (* -1 (getreal "Длина короткого (проценты):"))
       )
       ((null dlina_korotkogo_vvod) dlina_korotkogo)
       (t dlina_korotkogo_vvod)
     )
    dlinna (vla-get-length (vlax-ename->vla-object brovka))
    dlinna_podoshva
     (vla-get-length (vlax-ename->vla-object podoshva))
    colvo (atoi (rtos (/ dlinna shag_shtrihov) 2 0))
    vsego (* colvo 10)
  )
  (setvar "PDSIZE" (/ dlinna vsego 2))
  (if (< 2 vsego 32767)
    (progn
      (vl-cmdf "_divide" brovka colvo)
      (setq
 nabor     (ssget "_X"
      '((0 . "POINT") (8 . "временный_для_откосов"))
      )
 i     0
 spis_brovka '()
      )
      (repeat (sslength nabor)
 (setq
   koord       (cdr (assoc 10 (entget (ssname nabor i))))
   spis_brovka (cons koord spis_brovka)
   i       (1+ i)
 )
      )
      (vl-cmdf "_.erase" nabor "")
      (setq
 spis_brovka
  (cons
    (vlax-curve-getEndPoint brovka)
    (reverse
      (cons
        (vlax-curve-getStartPoint brovka)
        spis_brovka
      )
    )
  )
      )
      (vl-cmdf "_divide" podoshva vsego)
      (setq
 nabor       (ssget "_X"
        '((0 . "POINT") (8 . "временный_для_откосов"))
        )
 i       0
 spis_podoshva '()
      )
      (repeat (sslength nabor)
 (setq
   koord  (cdr (assoc 10 (entget (ssname nabor i))))
   spis_podoshva (cons koord spis_podoshva)
   i  (1+ i)
 )
      )
      (setq
 spis_podoshva
  (cons (vlax-curve-getEndPoint podoshva)
        (reverse
   (cons (vlax-curve-getStartPoint podoshva)
         spis_podoshva
   )
        )
  )
 spis_podoshva
  (if (inters
        (vlax-curve-getEndPoint podoshva)
        (vlax-curve-getEndPoint brovka)
        (vlax-curve-getStartPoint podoshva)
        (vlax-curve-getStartPoint brovka)
      )
    (reverse spis_podoshva)
    spis_podoshva
  )
 para '((0 0))
 a 1
      )
      (repeat colvo
 (setq para (cons (list a (* a 10)) para)
       a    (1+ a)
 )
      )
      (setq
 para (vl-sort para
        (function (lambda (x y) (< (car x) (car y))))
      )
 flag t
      )
      (sozd)
;;;      (while flag
;;; (initget "Да Нет Lf Ytn _ Y N Y N" 128)
;;; (setq
;;;   slovo (getint "\nРедактировать откос [Да / Нет] <Нет>:")
;;; )
;;; (if (/= slovo "Y")
;;;   (setq flag nil)
;;;   (progn
;;;     (setq start_shtrih (geo_vibor "\nНачальный ограничивающий штрих:"
;;;        "POLYLINE"
;;;        "временный_для_откосов"
;;;    )
;;;    end_shtrih (geo_vibor "\nКонечный ограничивающий штрих:"
;;;        "POLYLINE"
;;;        "временный_для_откосов"
;;;    )
;;;    change_shtrih (geo_vibor "\nРедактируемый штрих:"
;;;        "POLYLINE"
;;;        "временный_для_откосов"
;;;    )
;;;     )
;;;   )
;;; )
;;;      )
    )
    (alert "Длина бровки или подошвы слишком велика ")
  )
  (vl-cmdf "_.erase" nabor "")
  (setvar "OSMODE" osm)
  (setvar "CLAYER" cla)
  (setvar "DIMZIN" dmz)
  (setvar "LWDISPLAY" ves)
  (setvar "PDSIZE" siz)
  (setvar "PDMODE" mod)
)
 ;|
Функция geo_vibor
|;
(defun geo_vibor (zap tip sloy / flag name)
  (setq Flag t)
  (setvar "ERRNO" 0)
  (while Flag
    (cond
      ((and
  (setq name
  (car (entsel zap))
  )
  (wcmatch (cdr (assoc 0 (entget name))) tip)
  (wcmatch (cdr (assoc 8 (entget name))) sloy)
       )
       (setq Flag nil
      name name
       )
      )
      ((= (getvar "ERRNO") 52)
       (setq Flag nil)
      )
      (t
       (princ (strcat "\n\nМимо или тип не "
        tip
        (if (/= sloy "*")
   (strcat " или слой не " sloy)
   ""
        )
       )
       )
      )
    )
  )
)
 ;|
Функция sozd
|;
(defun sozd (/ t1 t2 a)
  (setq a 0)
  (mapcar (function (lambda (x)
        (setq t1 (nth (car x) spis_brovka)
       t2 (nth (cadr x) spis_podoshva)
        )
        (cond
   ((= a 0) (setq a 1))
   (t
    (setq a       (if (<= (1+ a) kolvo_korot_shtrihov)
      (1+ a)
      0
           )
          dlin_dl (distance t1 t2)
          dist    (cond
      ((minusp dlina_korotkogo)
       (* dlin_dl (/ (abs dlina_korotkogo) 100))
      )
      (t (/ dlina_korotkogo 2))
           )
          t2      (polar t1 (angle t1 t2) dist)
    )
   )
        )
        (ru-pline-entmake
   (list t1 t2)
   nil
   t
   0
   0
        )
      )
   )
   para
  )
)
 ;|
Функция ru-pline-entmake
|;
(defun ru-pline-entmake
       (points is_closed is_3d width lineweight / elst ENTL)
;;; (ru-pline-entmake (список_вершин) флаг_замкнутости
;;; флаг_делать_3М_ПЛИНИЮ)
;;; возвращает имя примитива - полилинии или NIL, если что-то не
;;; вышло.
  ;|
Пример:
(ru-pline-entmake
(list
(list 220.65 345.001)
(list 332.622 546.525)
(list 846.376 320.906)
(list 719.035 121.572)
) T nil 0 50)
|;
  (if is_3d
    (progn
      (setq entl
      (list
        '(0 . "POLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDb3dPolyline")
        '(66 . 1)
        '(10 0.0 0.0 0.0)
        (cons 70
       (logior 8
        (if is_closed
          1
          0
        ) ;_ end of if
        (if (= 1 (getvar "PLINEGEN"))
          128
          0
        ) ;_ end of if
       ) ;_ end of logior
        ) ;_ end of cons
      ) ;_ end of list
      ) ;_ end of setq
      (if (entmake entl)
 (progn
   (foreach v points
     (progn
       (setq entl
       (list
         '(0 . "VERTEX")
         '(100 . "AcDbEntity")
         '(100 . "AcDbVertex")
         '(100 . "AcDb3dPolylineVertex")
         (append '(10) v)
         '(70 . 32)
       ) ;_ end of list
       ) ;_ end of setq
       (entmake entl)
     ) ;_ end of progn
   ) ;_ end of foreach
   (if (entmake '((0 . "SEQEND") (100 . "AcDbEntity")))
     (entupd (entlast))
     nil
   ) ;_ end of if
 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (progn
      (setq elst (append
     (list
       '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbPolyline")
     ;(cons 8 (getvar "CLAYER"))
       (cons 90 (length points))
       (cons 43 width)
       (cons 370 lineweight)
       (cons 70
      (logior (if is_closed
         1
         0
       ) ;_ end of if
       (if (= 1 (getvar "PLINEGEN"))
         128
         0
       ) ;_ end of if
      ) ;_ end of logand
       )   ; _ end of cons;;;
     ) ;_ end of list
     (mapcar '(lambda (p)
         (list 10 (car p) (cadr p))
       ) ;_ end of lambda
      points
     ) ;_ end of mapcar
   ) ;_ end of append
      ) ;_ end of setq
      (if (entmake elst)
 (entupd (entlast))
 nil
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

[Макс_Кунгур]

Disney, в твоем lisp-е есть некоторые недочеты:
1. "Длина короткого штриха по запросу либо фиксированно в метрах (вводиться положительное), либо в % от длинного (вволдиться со знаком "-")" - это нужно убрать, короткие штрихи при рисовании откосов должны рисоваться на 1/2 длины между полилиниями.
2. При рисовании откосов в замкнутом контуре они рисуются наклонно, а не перпендикулярно.
Потестируй свой lisp на этом примере Otkos.dwg и если сможешь, исправь, пожалуйста, неточности.

[Disney]

Сообщение от Макс_Кунгур Disney, в твоем lisp-е есть некоторые недочеты:

Это не недочеты!

Сообщение от Макс_Кунгур 1. "Длина короткого штриха по запросу либо фиксированно в метрах (вводиться положительное), либо в % от длинного (вволдиться со знаком "-")" - это нужно убрать, короткие штрихи при рисовании откосов должны рисоваться на 1/2 длины между полилиниями.

Нельзя убирать, вариантов короткого штриха очень много, для этого так и сделал.
Я будучи геодезистом знал два, фиксированно 2 м и 2\3 длинного, см рисунок и выписка из условных знаков для топографических планов масштабов 1:5000 1:2000 1:1000 1:500

131 (84, 85). Условные знаки неукрепленных и укрепленных откосов применяют для изображения на планах соответствующих откосов независимо от того, были ли они дополнительно спланированы или нет. Вместе с тем данными знаками не должны показываться подпорные стенки Укрепление откосов осуществляют преимущественно путем их дернования. Кроме того, для укрепления используют каменную наброску, железобетонные плиты или мощение, что при наличии графических возможностей отображается надлежащими пояснитель­ными надписями дерн., ком. набр. и т. д., причем на планах масштабов 1:2000 и 1:5000 - по дополнительным требованиям. Если на откосах имеется древесно-кустарниковая растительность, то для размещения ее условных знаков на своих местах штриховку обозначений откосов дают с разрывами. 132 (84. 85). При больших площадях изображений откосов на то­пографических планах целесообразно разрежать штриховку их услов­ных знаков в 1,5-2 или 3 раза. Если проекции откосов достигают по ширине 3 см и более, то для наглядности короткие штрихи их обозна­чений следует удлинять, причем так, чтобы они по длине равнялись примерно трети длинных штрихов. Переход от внемасштабного изображения откосов к выражающемуся в масштабе данного плана должен быть показан в соответствии с натурой (преимущественно плавным). 133 (84, 85). Высотную характеристику откосов осуществляют двояким путем: у изображения их верхнего края и линии подножия размещают отметки абсолютной высоты избранных точек (наивысших. наинизших, ориентирного значения - не реже чем через 10 см); в порядке дополнения отметок или при недостатке места для них.. наносят показатели относительной высоты (превышения) данной точки откоса над прилегающей местностью. 134 (86). Условным обозначением отвалов при топографических съемках показывают насыпные сооружения (на участках разработки недр, у некоторых заводов, электростанций и предприятий комму­нального хозяйства), образовавшиеся при складировании пустой породы, некондиционных полезных ископаемых или промышленных отходов. Отвалы у шахт называют терриконами или террикониками. Разли­чают одно- и многоярусные, плоские, конусные, хребтовые и секторные терриконы, что должно найти отражение при передаче их формы и структуры на топографических планах (выделением вершинок, уступов - зн. № 87). При воспроизведении отвалов имеющиеся на них транспортеры, дороги, трубопроводы, а на стабилизировавшихся отвалах - растительность (включая травяную) показывают в обычном порядке. В отношении нанесения горизонталей в пределах терриконов следует руководствоваться п. 447. 135 (86). Когда на отвал продолжает поступать пустая порода, промышленные отходы и т. п., что обусловливает изменение его очертаний, обозначение отвала может быть ограничено общим конту­ром его. основания, особым знаком выделяющихся вершинок (если они имеются) и несколькими высотными отметками (с указанием даты их определения). Нанесение последних регламентируется в том же порядке, что и для откосов (п. 133). Соответственно следует показывать и отвалы, которые находятся на стадии рекультивации, т. е. разравнивания, планировки под спортивные сооружения, озеленение и т. д. При изображении тех и других отвалов целесообразно давать пояснительные надписи: в первом случае - растущ отвал, раст. тер. и т. п., во втором - рекульт. отвал, рк. тер. У обозначений отвалов, созданных с применением гидромехани­зации, следует наносить надпись гидроотвал, сложенных из спрессовавшейся золы - отвал золы и т. д. 136 (87). Открытые разработки твердых полезных ископаемых в зависимости от их мощности и характера залегания, а также от условий местности производят как с помощью карьеров (преимущественно по добыче угля, рудных и нерудных ископаемых), так и различными поверхностными способами. К числу последних относятся, например открытые соляные разработки по берегам морей и дражные полигоны на разрабатываемых россыпных месторождениях. Все данные разработки наносят на топографические планы по контурам фактически освоенных площадей. При интенсивном харак­тере работ, обусловливающем быстрое изменение этих. контуров. штриховку условного знака целесообразно давать с существенной разрядкой (как и у откосов - п. 132). У изображения разработок указывают наименование полезного ископаемого, а не содержащей его породы, если она называется иначе. Для недействующих разработок предусматривается сокращенная пояснительная надпись нед помещаемая в скобках после названия добываемого материала или после названия типа разработки (напри­мер, полигона). 137 (87). При передаче карьеров дополнительно указывают их глубину до десятых долей метра, а для значительных по размерам - отметки дна, основных ярусов и верхнего края в точках, имеющих ориентирное значение. В среднем отметка абсолютной высоты должна быть показана на каждые 3-4 см 2 изображения карьера. Здания, сооружения и дороги в карьерах, предназначенные для длительного использования, воспроизводят при топографических съемках в обычном порядке. Объекты кратковременного назначения, а также подготовленные к транспортировке материал добычи, навалы вскрышной породы и остатки растительного покрова показу на топографических планах не подлежат. При съемках действующих карьеров наносить горизонтали не требуется (в отличие от недействующих).

от тебя узнал ещё третий 1\2, и не факт, что не появяться ещё 4-ый и 5-ый.

Сообщение от Макс_Кунгур 2. При рисовании откосов в замкнутом контуре они рисуются наклонно, а не перпендикулярно.

Как я уже ранее писал:
Тут либо перпендикулярно, как Victor предлагал, либо "равномерно", как у меня, над третьим вариантом, чтоб и перпендикулярно, и плавно, и красиво, и не пересекались, бился долго, но увы...
Поэтому, остаёться ждать, когда добавлю опцию редактирования (потянул за один штрих в нужное место, и остальные сами плавненько так... за ним...)

[Макс_Кунгур]

Disney, мне именно и надо, чтобы короткий штрих был всегда 1/2 от длинного, без выбора вариантов. Можно lisp исправить под данный параметр?

[Disney]

Хорошо, Макс
Вот, задаём только шаг штрихов (или он у вас тоже строго постоянный), и выбираем Добычный \ Обычный.

Код:

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

 
(defun c:test3(/
  dmz     osm     cla     ves     siz     mod
   brovka  podoshva  shag_shtrihov_vvod 
   dlinna dlinna_podoshva colvo vsego nabor i spis_brovka spis_podoshva koord para a
   flag slovo start_shtrih end_shtrih change_shtrih
     )
  (vl-load-com)
  (setq dmz       (getvar "dimzin")
 osm       (getvar "OSMODE")
 cla       (getvar "CLAYER")
 ves       (getvar "LWDISPLAY")
 siz       (getvar "PDSIZE")
 mod       (getvar "PDMODE")
 brovka       (geo_vibor "\nУкажите бровку:" "*LINE" "*")
 podoshva      (geo_vibor "\nУкажите подошву:" "*LINE" "*")
  shag_shtrihov
      (if shag_shtrihov
        shag_shtrihov
        1
      )
 shag_shtrihov_vvod
      (getreal (strcat "Шаг штрихов <"
         (rtos shag_shtrihov 2 3)
         ">:"
        )
      )
 shag_shtrihov
      (if shag_shtrihov_vvod
        shag_shtrihov_vvod
        shag_shtrihov
      )
  kolvo_korot_shtrihov
     (if kolvo_korot_shtrihov
       kolvo_korot_shtrihov
       1
     )
  )
 
  (initget "Добычный Обычный")
  (setq
    kolvo_korot_shtrihov_vvod
     (getreal (strcat "Тип откоса [Добычный / Обычный]<"
        (cond
   ((= kolvo_korot_shtrihov 1) "Обычный")
   (t "Добычный")
        )
        ">:"
       )
     )
   kolvo_korot_shtrihov
     (if kolvo_korot_shtrihov_vvod
       (cond
  ((= kolvo_korot_shtrihov_vvod"Обычный") 1)
  ((= kolvo_korot_shtrihov_vvod "Добычный") 2)
       )
      kolvo_korot_shtrihov
     )  
  )
  (setvar "OSMODE" 8)
  (setvar "PDMODE" 35)
  (VL-CMDF "_-LAYER" "_M" "временный_для_откосов" "")
  (setq
    dlinna     (vla-get-length (vlax-ename->vla-object brovka))
    dlinna_podoshva
      (vla-get-length (vlax-ename->vla-object podoshva))
    colvo     (atoi (rtos (/ dlinna shag_shtrihov) 2 0))
    vsego     (* colvo 10)
  )
  (setvar "PDSIZE" (/ dlinna vsego 2))
  (if (< 2 vsego 32767)
    (progn
      (vl-cmdf "_divide" brovka colvo)
      (setq
 nabor     (ssget "_X"
      '((0 . "POINT") (8 . "временный_для_откосов"))
      )
 i     0
 spis_brovka '()
      )
      (repeat (sslength nabor)
 (setq
   koord       (cdr (assoc 10 (entget (ssname nabor i))))
   spis_brovka (cons koord spis_brovka)
   i       (1+ i)
 )
      )
      (vl-cmdf "_.erase" nabor "")
      (setq
 spis_brovka
  (cons
    (vlax-curve-getEndPoint brovka)
    (reverse
      (cons
        (vlax-curve-getStartPoint brovka)
        spis_brovka
      )
    )
  )
      )
      (vl-cmdf "_divide" podoshva vsego)
      (setq
 nabor       (ssget "_X"
        '((0 . "POINT") (8 . "временный_для_откосов"))
        )
 i       0
 spis_podoshva '()
      )
      (repeat (sslength nabor)
 (setq
   koord  (cdr (assoc 10 (entget (ssname nabor i))))
   spis_podoshva (cons koord spis_podoshva)
   i  (1+ i)
 )
      )
      (setq
 spis_podoshva
  (cons (vlax-curve-getEndPoint podoshva)
        (reverse
   (cons (vlax-curve-getStartPoint podoshva)
         spis_podoshva
   )
        )
  )
 spis_podoshva
  (if (inters
        (vlax-curve-getEndPoint podoshva)
        (vlax-curve-getEndPoint brovka)
        (vlax-curve-getStartPoint podoshva)
        (vlax-curve-getStartPoint brovka)
      )
    (reverse spis_podoshva)
    spis_podoshva
  )
 para '((0 0))
 a 1
      )
      (repeat colvo
 (setq para (cons (list a (* a 10)) para)
       a    (1+ a)
 )
      )
      (setq
 para (vl-sort para
        (function (lambda (x y) (< (car x) (car y))))
      )
 flag t
      )
      (sozd)
;;;      (while flag
;;; (initget "Да Нет Lf Ytn _ Y N Y N" 128)
;;; (setq
;;;   slovo (getint "\nРедактировать откос [Да / Нет] <Нет>:")
;;; )
;;; (if (/= slovo "Y")
;;;   (setq flag nil)
;;;   (progn
;;;     (setq start_shtrih (geo_vibor "\nНачальный ограничивающий штрих:"
;;;        "POLYLINE"
;;;        "временный_для_откосов"
;;;    )
;;;    end_shtrih (geo_vibor "\nКонечный ограничивающий штрих:"
;;;        "POLYLINE"
;;;        "временный_для_откосов"
;;;    )
;;;    change_shtrih (geo_vibor "\nРедактируемый штрих:"
;;;        "POLYLINE"
;;;        "временный_для_откосов"
;;;    )
;;;     )
;;;   )
;;; )
;;;      )
    )
    (alert "Длина бровки или подошвы слишком велика ")
  )
  (vl-cmdf "_.erase" nabor "")
  (setvar "OSMODE" osm)
  (setvar "CLAYER" cla)
  (setvar "DIMZIN" dmz)
  (setvar "LWDISPLAY" ves)
  (setvar "PDSIZE" siz)
  (setvar "PDMODE" mod)
)
 ;|
Функция geo_vibor
|;
(defun geo_vibor (zap tip sloy / flag name)
  (setq Flag t)
  (setvar "ERRNO" 0)
  (while Flag
    (cond
      ((and
  (setq name
  (car (entsel zap))
  )
  (wcmatch (cdr (assoc 0 (entget name))) tip)
  (wcmatch (cdr (assoc 8 (entget name))) sloy)
       )
       (setq Flag nil
      name name
       )
      )
      ((= (getvar "ERRNO") 52)
       (setq Flag nil)
      )
      (t
       (princ (strcat "\n\nМимо или тип не "
        tip
        (if (/= sloy "*")
   (strcat " или слой не " sloy)
   ""
        )
       )
       )
      )
    )
  )
)
 ;|
Функция sozd
|;
(defun sozd (/ t1 t2 a)
  (setq a 0)
  (mapcar (function (lambda (x)
        (setq t1 (nth (car x) spis_brovka)
       t2 (nth (cadr x) spis_podoshva)
        )
        (cond
   ((= a 0) (setq a 1))
   (t
    (setq a       (if (<= (1+ a) kolvo_korot_shtrihov)
      (1+ a)
      0
           )
          dlin_dl (distance t1 t2)
          dist    (* dlin_dl 0.5)
          t2      (polar t1 (angle t1 t2) dist)
    )
   )
        )
        (ru-pline-entmake
   (list t1 t2)
   nil
   t
   0
   0
        )
      )
   )
   para
  )
)
 ;|
Функция ru-pline-entmake
|;
(defun ru-pline-entmake
       (points is_closed is_3d width lineweight / elst ENTL)
;;; (ru-pline-entmake (список_вершин) флаг_замкнутости
;;; флаг_делать_3М_ПЛИНИЮ)
;;; возвращает имя примитива - полилинии или NIL, если что-то не
;;; вышло.
  ;|
Пример:
(ru-pline-entmake
(list
(list 220.65 345.001)
(list 332.622 546.525)
(list 846.376 320.906)
(list 719.035 121.572)
) T nil 0 50)
|;
  (if is_3d
    (progn
      (setq entl
      (list
        '(0 . "POLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDb3dPolyline")
        '(66 . 1)
        '(10 0.0 0.0 0.0)
        (cons 70
       (logior 8
        (if is_closed
          1
          0
        ) ;_ end of if
        (if (= 1 (getvar "PLINEGEN"))
          128
          0
        ) ;_ end of if
       ) ;_ end of logior
        ) ;_ end of cons
      ) ;_ end of list
      ) ;_ end of setq
      (if (entmake entl)
 (progn
   (foreach v points
     (progn
       (setq entl
       (list
         '(0 . "VERTEX")
         '(100 . "AcDbEntity")
         '(100 . "AcDbVertex")
         '(100 . "AcDb3dPolylineVertex")
         (append '(10) v)
         '(70 . 32)
       ) ;_ end of list
       ) ;_ end of setq
       (entmake entl)
     ) ;_ end of progn
   ) ;_ end of foreach
   (if (entmake '((0 . "SEQEND") (100 . "AcDbEntity")))
     (entupd (entlast))
     nil
   ) ;_ end of if
 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (progn
      (setq elst (append
     (list
       '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbPolyline")
     ;(cons 8 (getvar "CLAYER"))
       (cons 90 (length points))
       (cons 43 width)
       (cons 370 lineweight)
       (cons 70
      (logior (if is_closed
         1
         0
       ) ;_ end of if
       (if (= 1 (getvar "PLINEGEN"))
         128
         0
       ) ;_ end of if
      ) ;_ end of logand
       )   ; _ end of cons;;;
     ) ;_ end of list
     (mapcar '(lambda (p)
         (list 10 (car p) (cadr p))
       ) ;_ end of lambda
      points
     ) ;_ end of mapcar
   ) ;_ end of append
      ) ;_ end of setq
      (if (entmake elst)
 (entupd (entlast))
 nil
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

[Макс_Кунгур]

Disney, спасибо. Но самый последний вопрос остается, чтобы линии были перпендикулярные.