[Astartes]

Приветствую.
Я знаю что есть два лиспа для решения подобной задачи. Это bi_line Александра Ривилиса, и Middle PolyLine (MPL) от VVA.
Оба лиспа работаю хорошо. Спасибо авторам.
Единственная "проблема", для того чтобы построить линию между двумя другими нужно первую и вторую линию выделять по отдельности.
Вопрос можно подработать лисп так, чтобы выделить две линии рамкой, затем Ентер, и средняя линия (биссектриса) готова? Или это невозможно?

[lastloch]

Сообщение от Astartes Или это невозможно?

Наверное возможно. Осталось найти эти лиспы.

[ciril]

Выделяй сколько угодно линий, средняя линия строится по первой и последней. Предполагается, что они сонаправлены.

Код:

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

 (defun c:bissa    (/ x00 x01 x02 x03)
  (princ "\nВыберите линии...")
  (while (not (setq x00 (ssget '((0 . "line"))))) (princ "\nНичего не выбрано!\nВыберите линии..."))
  (setq x01 (list))
  (foreach auxi     (list 0 (1- (sslength x00)))
    (setq x01 (append x01 (list (cdr (assoc 10 (setq x02 (entget (ssname x00 auxi))))) (cdr (assoc 11 x02))))))
  (setq x00 nil)
  (entmake
    (list '(0 . "LINE")
      '(100 . "AcDbLine")
      (cons 10 (setq x03 (polar (setq x00 (car x01)) (angle x00 (setq x02 (caddr x01))) (/ (distance x00 x02) 2))))
      (cons 11 (polar x03
               (/ (+ (angle x00 (setq x00 (cadr x01))) (angle x02 (setq x02 (cadddr x01)))) 2)
               (/ (distance x00 x02) 2)))))
  (princ))

[Astartes]

lastloch, Я почему-то думал, что эти лиспы популярны и все ими пользуются. ))
Выкладываю.

Есть еще один лист Axis_Den, от Дениса Флюстикова. Он делает осевые линии и для окружностей и для линий. Причем окружности можно выбрать рамкой и осевые отрисуются на всех окружностях разом, а линии так же приходится выделять по одной.

Cirik
Спасибо. Только непонятно, средняя линия отрисовывается определенной величины. В указанных мной лиспах, линия отрисовывается той же величины что основные линии.
И ваш лисп работает только для параллельных линий, для линий идущих под углом друг к другу он не работает.

[ciril]

добавь после (setq x00 nil)

Код:

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

 (and (> (distance (car x01) (caddr x01)) (distance (cadr x01) (cadddr x01))) (setq x01 (reverse x01)))

если две линии разной длины, то какова должна быть длина итоговой линии?
и чего надо-то - биссектрису угла или среднюю линию между двумя отрезками?

[Astartes]

ciril, Добавил, ничего не поменялось.

Сообщение от ciril и чего надо-то - биссектрису угла или среднюю линию между двумя отрезками?

Лиспы открывали что я в архиве приложил?
Лисп bi_line отрисовывает все как нужно (и паралельные и под углом). Единственное что хотелось бы, это добавить возможность выбирать обе линии рамкой, как это сделано в вашем лиспе. Объединить, так сказать.

[ciril]

не люблю я править чужой код объединил

Код:

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

 (defun C:BI_LINE  (/ x00 en1 en2 e1 e2 p1 p2 p11 p12 p21 p22 tmp d1 d2 _bm)
  (setvar "CMDECHO" 0)
  (princ "\nВыберите отрезки...")
  (while (not (setq x00 (ssget '((0 . "line"))))) (princ "\nНичечго не выбрано!\nВыберите отрезки..."))
  (redraw (setq en1 (ssname x00 0)) 3)
  (redraw (setq en2 (ssname x00 (1- (sslength x00)))) 3)
  (setq x00 nil)
  (setq _bm (getvar "BLIPMODE"))
  (setvar "BLIPMODE" 0)
  (setq	p11 (cdr (assoc 10 (setq e1 (entget en1))))
	p12 (cdr (assoc 11 e1))
	p21 (cdr (assoc 10 (setq e2 (entget en2))))
	p22 (cdr (assoc 11 e2)))
  (if (> (+ (distance p11 p21) (distance p12 p22)) (+ (distance p11 p22) (distance p12 p21)))
    (progn				; меняем местами начало и конец второго отрезка
      (setq tmp	(list p21 p22)
	    p21	(cadr tmp)
	    p22	(car tmp))))
  (cond	;;отрезки пересекаются
	((setq p1 (inters p11 p12 p21 p22 T))
	 (setq d1 (max (distance p1 p11) (distance p1 p21)))
	 (setq d2 (max (distance p1 p12) (distance p1 p22)))
	 (setq p11 (polar p1 (angle p1 p11) d1))
	 (setq p12 (polar p1 (angle p1 p12) d2))
	 (setq p21 (polar p1 (angle p1 p21) d1))
	 (setq p22 (polar p1 (angle p1 p22) d2)))
	;; пересекаются прямые, на которых лежат отрезки
	((setq p1 (inters p11 p12 p21 p22 nil))
	 (if (> (distance p1 p11) (distance p1 p12))
	   (progn (setq	tmp (list p11 p12)
			p11 (cadr tmp)
			p12 (car tmp))
		  (setq	tmp (list p21 p22)
			p21 (cadr tmp)
			p22 (car tmp))))
	 ;; (if (progn
	 (setq d1 (min (distance p1 p11) (distance p1 p21)))
	 (setq d2 (max (distance p1 p12) (distance p1 p22)))
	 (setq p11 (polar p1 (angle p1 p11) d1))
	 (setq p12 (polar p1 (angle p1 p12) d2))
	 (setq p21 (polar p1 (angle p1 p21) d1))
	 (setq p22 (polar p1 (angle p1 p22) d2))))
  ;; (cond
  (setq p1 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p11 p21)))
  (setq p2 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p12 p22)))
  (command "_.LINE" "_none" (trans p1 0 1) "_none" (trans p2 0 1) "")
  (setvar "BLIPMODE" _bm)
  (redraw en1 4)
  (redraw en2 4)
  (princ))

[Astartes]

ciril, Вот! Спасибо большое, теперь как надо.
Ну и раз уж так. Как сделать, чтобы полученная линия автоматом переходила на определенный слой. Как это сделать я знаю, нужно добавить такую строчку (vl-cmdf "_-LAYER" "_M" "Осевая" ""). Тогда у этой линии будет параметры присвоенные слою "Осевая". А хотелось бы чтобы линия получалась в текущем слое, цвет - по слою, тип линии - ACAD_ISO04W100, вес линии - 0,2мм.

[ciril]

замени строку (command... на

Код:

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

 (or (entmake (list '(0 . "LINE")
		     '(6 . "ACAD_ISO04W100")
		     '(370 . 20)
		     (cons 10 (trans p1 0 1))
		     (cons 11 (trans p2 0 1))))
      (prompt "\nОтрезок не создан!")
      (exit))

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

[gomer]

Сообщение от ciril Код: [Выделить все] (or (entmake (list '(0 . "LINE") '(6 . "ACAD_ISO04W100") '(370 . 20) (cons 10 (trans p1 0 1)) (cons 11 (trans p2 0 1)))) (prompt "\nОтрезок не создан!") (exit))

нафига такое счастье?

[Astartes]

ciril, Спасибо, отлично все работает.

gomer, Что не так?

[ciril]

Сообщение от gomer нафига такое счастье?

ну а вдруг отрезок не будет создан, а вот и оповещение

[gomer]

Сообщение от ciril ну а вдруг отрезок не будет создан, а вот и оповещение

А чего он не создан?
рисование отрезка - заключительный этап программы... (exit) тут не особо-то и нужен
но больше всего я не могу понять почему происходит таки прерывание по (exit)

[Astartes]

ciril, Еще пара вопросов.
Можно ли среднюю линию(дугу) между дугами сделать? Лиспы которые я выкладывал не могут этого сделать. Разве что Плтулс может, если дуги в полилинии конвертировать. Есть какая-то сложность с дугами, не знаете?
Можно ли еще немного модернизировать лисп, чтобы после отрисовки средней линии, команда не прерывалась, а предлагала выбрать следующие две линии? Это конечно больше блажь, вызов предыдущей команды правым кликом сделать несложно, но всеже. ))

[ciril]

gomer, вообще, конечно, согласен, перестраховался, хотя с другой стороны... у меня при отсутствии в чертеже заданного типа линии отрезок создается не всегда (Civil2012)
Astartes, вот так запрашивает продолжение и немного переписал код, так мне больше нравится

Код:

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

 (defun C:BI_LINE  (/ x00 en1 en2 e1 e2 p1 p2 p11 p12 p21 p22 tmp d1 d2 _bm _cm)
  (setq _cm (getvar "CMDECHO")
        _bm (getvar "BLIPMODE"))
  (setvar "BLIPMODE" (setvar "CMDECHO" 0))
  (while (not (eq "Нет" (progn (initget "Да Нет") (getkword "\nПродожить? [Да/Нет] <Да>: "))))
    (princ "\nВыберите отрезки...")
    (while (not (setq x00 (ssget '((0 . "line"))))) (princ "\nНичего не выбрано!\nВыберите отрезки..."))
    (redraw (setq en1 (ssname x00 0)) 3)
    (redraw (setq en2 (ssname x00 (1- (sslength x00)))) 3)
    (setq x00 nil)
    (setq p11 (cdr (assoc 10 (setq e1 (entget en1))))
          p12 (cdr (assoc 11 e1))
          p21 (cdr (assoc 10 (setq e2 (entget en2))))
          p22 (cdr (assoc 11 e2)))
    (if (> (+ (distance p11 p21) (distance p12 p22)) (+ (distance p11 p22) (distance p12 p21)))
      (setq tmp p21
            p21 p22
            p22 tmp))
    (cond ;;отрезки пересекаются
          ((setq p1 (inters p11 p12 p21 p22 T))
           (setq d1  (max (distance p1 p11) (distance p1 p21))
                 d2  (max (distance p1 p12) (distance p1 p22))
                 p11 (polar p1 (angle p1 p11) d1)
                 p12 (polar p1 (angle p1 p12) d2)
                 p21 (polar p1 (angle p1 p21) d1)
                 p22 (polar p1 (angle p1 p22) d2)))
          ;; пересекаются прямые, на которых лежат отрезки
          ((setq p1 (inters p11 p12 p21 p22 nil))
           (if (> (distance p1 p11) (distance p1 p12))
             (setq tmp p11
                   p11 p12
                   p12 tmp
                   tmp p21
                   p21 p22
                   p22 tmp))
           (setq d1  (min (distance p1 p11) (distance p1 p21))
                 d2  (max (distance p1 p12) (distance p1 p22))
                 p11 (polar p1 (angle p1 p11) d1)
                 p12 (polar p1 (angle p1 p12) d2)
                 p21 (polar p1 (angle p1 p21) d1)
                 p22 (polar p1 (angle p1 p22) d2))))
    (or (entmake (list '(0 . "LINE")
                       '(6 . "ACAD_ISO04W100")
                       '(370 . 20)
                       (cons 10 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p11 p21)) 0 1))
                       (cons 11 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p12 p22)) 0 1))))
        (princ "\nОтрезок не создан!"))
    (redraw en1 4)
    (redraw en2 4))
  (setvar "BLIPMODE" _bm)
  (setvar "CMDECHO" _cm)
  (princ))

с дугами - подумаю, слабо представляю себе среднюю между двух дуг
навскидку, вот так для сонаправленных, одинаково выпуклых дуг:

Код:

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

 (defun c:bi_arc  (/ x00 x01 x02)
  (princ "\nВыберите дуги...")
  (while (not (setq x00 (ssget '((0 . "arc"))))) (princ "\nДуги не выбраны!\nВыберите дуги..."))
  (setq x01 (entget (ssname x00 0))
        x02 (entget (ssname x00 (1- (sslength x00))))
        x00 nil)
   (or (entmake
        (list '(0 . "ARC")              
              '(6 . "ACAD_ISO04W100")
              '(370 . 20)
              (cons 10
                    (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (cdr (assoc 10 x01)) (cdr (assoc 10 x02)))) 0 1))
              (cons 40 (/ (+ (cdr (assoc 40 x01)) (cdr (assoc 40 x02))) 2))
              (cons 50 (/ (+ (cdr (assoc 50 x01)) (cdr (assoc 50 x02))) 2))
              (cons 51 (/ (+ (cdr (assoc 51 x01)) (cdr (assoc 51 x02))) 2))))
      (princ "\nДуга не создана!"))
  (princ))

[Елпанов Евгений]

Если дуги имеют разные радиусы, то средняя линия уже не дуга...

[ciril]

Astartes, я за такое не возьмусь

[Astartes]

ciril, Спасибо за проделанную работу.
Есть пара вопросов. По поводу первого лиспа. Там появляется запрос "продолжать или нет", причем он появляется даже перед тем как я выбрал первые линии. Без запроса не обойтись?
Просто тогда пропадает смысл в модернизации лиспа.
Попробую объяснить. Вот я вызвал лисп, выделил 2 линии, получил среднюю линию, команда закончилась. Правая кнопка мыши (повтор предыдущей команды у меня) и все по новой.
Если воспользоваться модернизированным лиспом, то получается даже на один клик мышки больше. Вызов команды, ответ на запрос "продолжить или нет" (правый клик, получается лишний) выбор отрезков и опять ответ на запрос (правый клик, в данном случае на продолжение команды, а в первом случае на повтор команды, что в моем понимании одинаково).
Я представлял себе так. Для примера команда оффсет(подобие). Там после создания подобия, команда не прервется и можно выбрать следующий объект для подобия, без лишних запросов.

По поводу дуг, да вы правильно поняли, лисп работает хорошо. Теперь вопрос, можно ли его объеденить с лиспом для линий?

Для чего мне это нужно. Я черчу трехмерку, потом снимаю проекции флат шотом, получается что то вроде (см. приложение). Потом мне нужно поставить осевые. Для этого я использую лисп, который прошу модернизировать.


Странно, как вы прочитали мой комментарий, я же его еще не отправлял. ))
Понял, спасибо еще раз за проделанную работу.

[ciril]

Не, это был комментарий к посту #16 Посмотрел чертеж, понял, наконец, что нужно Объединю чуть позже.

[ciril]

Вот так

Код:

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

(defun C:BI_LINE  (/ x00 en1 en2 e1 e2 p1 p2 p11 p12 p21 p22 tmp d1 d2 _bm _cm)
  (setq _cm (getvar "CMDECHO")
        _bm (getvar "BLIPMODE"))
  (setvar "CMDECHO" 1)
  (setvar "BLIPMODE" 0)
  (while (progn (princ "\nВыберите дуги или отрезки...")
                (setq x00 (ssget '((-4 . "<or") (0 . "line") (0 . "arc") (-4 . "or>")))))
    (redraw (setq en1 (ssname x00 0)) 3)
    (redraw (setq en2 (ssname x00 (1- (sslength x00)))) 3)
    (setq x00 nil
          e1  (entget en1)
          e2  (entget en2))
    (if (and (eq "LINE" (cdr (assoc 0 e1))) (eq "LINE" (cdr (assoc 0 e2))))
      (progn (setq p11 (cdr (assoc 10 e1))
                   p12 (cdr (assoc 11 e1))
                   p21 (cdr (assoc 10 e2))
                   p22 (cdr (assoc 11 e2)))
             (if (> (+ (distance p11 p21) (distance p12 p22)) (+ (distance p11 p22) (distance p12 p21)))
               (setq tmp p21
                     p21 p22
                     p22 tmp))
             (cond ;;отрезки пересекаются
                   ((setq p1 (inters p11 p12 p21 p22 T))
                    (setq d1  (max (distance p1 p11) (distance p1 p21))
                          d2  (max (distance p1 p12) (distance p1 p22))
                          p11 (polar p1 (angle p1 p11) d1)
                          p12 (polar p1 (angle p1 p12) d2)
                          p21 (polar p1 (angle p1 p21) d1)
                          p22 (polar p1 (angle p1 p22) d2)))
                   ;; пересекаются прямые, на которых лежат отрезки
                   ((setq p1 (inters p11 p12 p21 p22 nil))
                    (if (> (distance p1 p11) (distance p1 p12))
                      (setq tmp p11
                            p11 p12
                            p12 tmp
                            tmp p21
                            p21 p22
                            p22 tmp))
                    (setq d1  (min (distance p1 p11) (distance p1 p21))
                          d2  (max (distance p1 p12) (distance p1 p22))
                          p11 (polar p1 (angle p1 p11) d1)
                          p12 (polar p1 (angle p1 p12) d2)
                          p21 (polar p1 (angle p1 p21) d1)
                          p22 (polar p1 (angle p1 p22) d2))))
             (or (entmake (list '(0 . "LINE")
                                '(6 . "ACAD_ISO04W100")
                                '(370 . 20)
                                (cons 10 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p11 p21)) 0 1))
                                (cons 11 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p12 p22)) 0 1))))
                 (princ "\nОтрезок не создан!")))
      (or (entmake
            (list '(0 . "ARC")
                  '(6 . "ACAD_ISO04W100")
                  '(370 . 20)
                  (cons 10
                        (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (cdr (assoc 10 e1)) (cdr (assoc 10 e2)))) 0 1))
                  (cons 40 (/ (+ (cdr (assoc 40 e1)) (cdr (assoc 40 e2))) 2))
                  (cons 50 (/ (+ (cdr (assoc 50 e1)) (cdr (assoc 50 e2))) 2))
                  (cons 51 (/ (+ (cdr (assoc 51 e1)) (cdr (assoc 51 e2))) 2))))
          (princ "\nДуга не создана!")))
    (redraw en1 4)
    (redraw en2 4))
  (setvar "BLIPMODE" _bm)
  (setvar "CMDECHO" _cm)
  (princ))

[Astartes]

ciril, Все работает. Спасибо. Ну будете у нас на колыме... )) С меня стакан чаю. ))

ЗЫ: Может еще придумаю какую-нибудь задачу. ))

[ciril]

Да, не за что

[Astartes]

ciril, У меня еще возник вопрос. ))
А спланы таким же образом как и дуги можно обработать, для получения среднего сплайна?

[Олег (jr.)]

Пробуй

Код:

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

(defun C:demo(/ osm p1 p2 sp1)
(setq osm (getvar "osmode" ))
(setvar "osmode" 512)
(setq p1 (getpoint "\nFirst curve: "))
(setvar "osmode" 128)
(setq p2 (getpoint p1 "\nSecond curve: "))
(setq sp1 (ssget "_F"
		 (list
		   (trans (mapcar '+ p1 (list 1 1 0))1 0)
		   (trans (mapcar '+ p1 (list -1 -1 0))1 0))
		 '((0 . "*line,arc,circle")))
      )
(command "_.offset" "T" sp1
	 (trans (mapcar '(lambda (a b )(/ (+ a b) 2.))p1 p2)1 0) "")
  (setvar "osmode" osm)
  (princ)
  )

[Astartes]

Олег (jr.), Спасибо. Только вот я наверное непониаю чегото. Ваш лисп работает точно также как обычный оффсет. Указываю величину смещения, и сторону для смещения. Смысл?
Если со сплайнами нельзя работать по такому же принципу как с линиями и дугами как в модернизированном bi_line.lsp и соответственно эту работу нельзя интегрировать туда же, то тогда не актуально.

На всякий случай. Лисп работает с ошибкой.

Команда: demo
First curve:
Second curve: _.offset
Текущие настройки: Удалить исходные=Нет Слой=Источник OFFSETGAPTYPE=0
Укажите расстояние смещения или [Через/Удалить/Слой] <0.0000>: T
Требуется численное значение расстояния, две точки или ключевое слово.
; ошибка: Функция прервана.

(Мой комментарий: После этого работает как обычный оффсет. Зачем нужно было указывать первую кривую и вторую кривую, непонятно)

Укажите расстояние смещения или [Через/Удалить/Слой] <0.0000>: 14
Выберите объект для смещения или [Выход/Отменить] <Выход>:
Укажите точку, определяющую сторону смещения, или [Выход/Несколько/Отменить]
<Выход>:
Выберите объект для смещения или [Выход/Отменить] <Выход>:

Плюс ко всему, сбиваются настроки привязок. Их потом заново приходится ставить.

[ciril]

Astartes, скажите, ваши сплайны попарно всегда имеют одинаковое количество узлов?

[Astartes]

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

[ciril]

блин! я решал похожую для полилиний - построение оси дороги по обочинам, которые полилинии, она не всегда корректно работает: не всегда правильно выбирает узлы, между которыми строится средняя точка. ошибка получается графически незначительной, поэтому тогда подошло я переделаю ее под сплайны, а там будет ясно, подойдет или нет.

[Astartes]

ciril, Выше я выкладывал лисп от VVA, там у него тоже работа с полилиниями. Может пригодится. Если сплайн превратить в полилинию, то лисп работает корректно. Только вот полилиния с ее узлами не подходить для осевой линии. Линия отображается как сплошная. А вот узлы сплайна этому не помеха, линия отображается осевой.

[ciril]

если включить генерацию типа линии, то узлы полилинии тоже не будут помехой

Код:

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

 (setvar 'plinegen 1)

[Astartes]

ciril, Не понятно. Попробовал вне лиспа, просто plinegen =1, ничего не поменялось. Линия осталось сплошной. Да и конвертить сплайн в полилинию, лишнее действие, если конечно же со сплайном получится нормально.

ЗЫ: Тоже вот с полилиниями странность. Если конвертить спалайн в полилинию с помощью pl-join от VVA, то переменная не помогает. Линия остается сплошной. Если конвертить с помощью Total Purge, то тогда осевая линия отображается нормально. Интересно, раньше на замечал такой разницы.

[ciril]

системная переменная влияет на генерацию типа линий для вновь создаваемых полилиний. для уже созданных: выбери полилинию, на панели свойств (вызывается ctrl+1) найди одноименную строку (она в самом низу панели в разделе "разное") и включи ее. может придется регенерировать чертеж, не знаю тебя устраивает, как строит среднюю MPL, просто, она не всегда средняя?
приложил файл, какая линия правильней: синяя или красная?

[Astartes]

Ага, с регенерацией разобрался. Спасибо, не знал о такой фишке полилиний.
Касательно средней линии. Если была возможность среднюю линию ставил MPL. Если не конвертил сплайны в полилинию то ставил оффсетом. А вот только после вашей наколки, увидел что линии ставятся немного по разному. На самом деле мне без разницы. Большая точность не нужна, т.к. в основном это для монтажного чертежа. А там масштабы соответствующие. На рабочих чертежах все выполнено линиями и дугами, так что для рабочки вполне достаточно модернизированного вами лиспа.
Синия линия я так понял получилась с помощью MPL. А красная с помощью чего? Потому что обычный оффсет дает вообще третий результат. ))

[ciril]

красная с помощью того, что я написал. немного позже выложу для сплайнов

[ciril]

Ну вот как-то так. Криво работает на сплайнах, которые разнонаправлены, не могу разобраться с весом узла, как он его пересчитывать.

Код:

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

 (defun C:BI_LINE  (/ x00 x01 x01 x02 x03 x04 x05 x06 x07 x08 x09 x0a x0b x0c x0d x0e _bm _cm)
  (setq _cm (getvar "CMDECHO")
        _bm (getvar "BLIPMODE"))
  (setvar "CMDECHO" 1)
  (setvar "BLIPMODE" 0)
  (while (progn (princ "\nВыберите отрезки или дуги, или сплайны...")
                (setq x00 (ssget '((-4 . "<or") (0 . "line") (0 . "arc") (0 . "spline") (-4 . "or>")))))
    (redraw (setq x01 (ssname x00 0)) 3)
    (redraw (setq x02 (ssname x00 (1- (sslength x00)))) 3)
    (setq x00 nil
          x05 (cdr (assoc 0 (setq x03 (entget x01))))
          x06 (cdr (assoc 0 (setq x04 (entget x02)))))
    (cond ((and (eq "LINE" x05) (eq "LINE" x06))
           (if (> (+ (distance (setq x05 (cdr (assoc 10 x03))) (setq x06 (cdr (assoc 10 x04))))
                     (distance (setq x03 (cdr (assoc 11 x03))) (setq x04 (cdr (assoc 11 x04)))))
                  (+ (distance x05 x04) (distance x03 x06)))
             (setq x00 x06
                   x06 x04
                   x04 x00))
           (cond ;;оотерзки пересекаются
                 ((setq x07 (inters x05 x03 x06 x04 t))
                  (setq x08 (max (distance x07 x05) (distance x07 x06))
                        x09 (max (distance x07 x03) (distance x07 x04))
                        x05 (polar x07 (angle x07 x05) x08)
                        x03 (polar x07 (angle x07 x03) x09)
                        x06 (polar x07 (angle x07 x06) x08)
                        x04 (polar x07 (angle x07 x04) x09)))
                 ;; пересекаются прямые, на которых лежат отрезки
                 ((setq x07 (inters x05 x03 x06 x04 nil))
                  (if (> (distance x07 x05) (distance x07 x03))
                    (setq x00 x05
                          x05 x03
                          x03 x00
                          x00 x06
                          x06 x04
                          x04 x00))
                  (setq x08 (min (distance x07 x05) (distance x07 x06))
                        x09 (max (distance x07 x03) (distance x07 x04))
                        x05 (polar x07 (angle x07 x05) x08)
                        x03 (polar x07 (angle x07 x03) x09)
                        x06 (polar x07 (angle x07 x06) x08)
                        x04 (polar x07 (angle x07 x04) x09))))
           (or (entmake (list '(0 . "LINE")
                              '(6 . "ACAD_ISO04W100")
                              '(370 . 20)
                              (cons 10 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ x05 x06)) 0 1))
                              (cons 11 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ x03 x04)) 0 1))))
               (princ "\nОтрезок не создан!")))
          ((and (eq "ARC" x05) (eq "ARC" x06))
           (or (entmake
                 (list '(0 . "ARC")
                       '(6 . "ACAD_ISO04W100")
                       '(370 . 20)
                       (cons 10
                             (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (cdr (assoc 10 x03)) (cdr (assoc 10 x04)))) 0 1))
                       (cons 40 (/ (+ (cdr (assoc 40 x03)) (cdr (assoc 40 x04))) 2))
                       (cons 50 (/ (+ (cdr (assoc 50 x03)) (cdr (assoc 50 x04))) 2))
                       (cons 51 (/ (+ (cdr (assoc 51 x03)) (cdr (assoc 51 x04))) 2))))
               (princ "\nДуга не создана!")))
          ((and (eq "SPLINE" x05) (eq "SPLINE" x06))
           (setq x00 (list (quote (setq x0b (append x0b (list (cons 40 (/ (+ (cdar (setq x03 (cdr x03))) (cdar (setq x04 (cdr x04)))) 2))))
                                        x0c (append x0c (list (cons 10 (polar x09 (angle x09 x0a) (/ x0e 2)))))
                                        x07 (cdr x07)
                                        x08 (cdr x08)
                                        x05 x09
                                        x06 x0a))
                           (quote (setq x0b (append x0b (list (cons 40 (/ (+ (cdar (setq x03 (cdr x03))) (cdar x04)) 2))))
                                        x0c (append x0c (list (cons 10 (polar x09 (angle x09 x06) (/ x0e 2)))))
                                        x07 (cdr x07)
                                        x05 x09))
                           (quote (setq x0b (append x0b (list (cons 40 (/ (+ (cdar x03) (cdar (setq x04 (cdr x04)))) 2))))
                                        x0c (append x0c (list (cons 10 (polar x05 (angle x05 x0a) (/ x0e 2)))))
                                        x08 (cdr x08)
                                        x06 x0a)))
                 x07 (member (setq x05 (assoc 10 x03)) x03)
                 x08 (member (setq x06 (assoc 10 x04)) x04)
                 x0b (list)
                 x03 (member (assoc 40 (setq x03 (reverse (member (assoc 40 (setq x03 (reverse x03))) x03)))) x03)
                 x04 (member (assoc 40 (setq x04 (reverse (member (assoc 40 (setq x04 (reverse x04))) x04)))) x04)
                 x05 (cdr x05)
                 x06 (cdr x06))
           (repeat 4
             (setq x0b (append x0b (list (cons 40 (/ (+ (cdar x03) (cdar x04)) 2))))
                   x03 (cdr x03)
                   x04 (cdr x04)))
           (and (> (distance x05 x06) (distance x05 (cdr (last x08))))
                (> (distance x05 x06) (distance (cdr (last x07)) x06))
                (setq x08 (reverse (cons (cons 10 x06) x08))
                      x06 (cdar x08)
                      x08 (cdr x08))) ;x04 (reverse x04)
           (setq x0b (append x0b (list (cons 40 (/ (+ (cdar x03) (cdar x04)) 2)))))
           (setq x0c (list (cons 10 (polar x05 (angle x05 x06) (/ (distance x05 x06) 2)))))
           (while (and (setq x09 (cdadr x07)) (setq x0a (cdadr x08)))
             (eval
               (nth (1-
                      (length
                        (member (setq x0e (apply 'min (setq x0d (list (distance x05 x0a) (distance x06 x09) (distance x09 x0a)))))
                                x0d)))
                    x00)))
           (setq x00 (cdar x03))
           (or x0a
               (setq x08 x07
                     x00 (cdar x04)
                     x04 x03
                     x0a x09
                     x05 x06))
           (repeat (length x08)
             (setq x0b (append x0b (list (cons 40 (/ (+ x00 (cdar x04)) 2))))
                   x0c (append x0c (list (cons 10 (polar x05 (angle x05 x0a) (/ (distance x05 x0a) 2)))))
                   x04 (cdr x04)
                   x08 (cdr x08)
                   x0a (cdar x08)))
           (or (entmake (append (quote ((0 . "SPLINE") (100 . "AcDbEntity")
                                                       (100 . "AcDbSpline") 
                                                       (6 . "ACAD_ISO04W100")
                                                       (370 . 20)
                                                       (70 . 8)
                                                       (71 . 3)))
                                (list (cons 72 (length x0b)) (cons 73 (length x0c)))
                                (quote ((74 . 0) (42 . 1.0e-10) (43 . 1.0e-10)))
                                x0b
                                x0c))
               (princ "\nСплайн не созданн!")))
          (t (princ "\nВыбраны примитивы разных типов!")))
    (redraw x01 4)
    (redraw x02 4))
  (setvar "BLIPMODE" _bm)
  (setvar "CMDECHO" _cm)
  (princ))

Со сплайнами на некоторых участках лишние перегибы.

[Astartes]

Спасибо работает. Хоть иногда и странно (см. приложение). Слева средний сплайн построисля криво если выделять рамкой. А справа сплайн нормально построился если выделять по отдельности. Объекты то одни и теже.
Ну это так чисто к сведению.

[ciril]

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

[Astartes]

Обратно благодарю. )) Пока все нормально.

[bboysyndrom]

В AutoCAD 2012 (2009 тоже) последний лисп пишет "Отрезок не создан". В чем проблема может быть?

[VVA]

(or (entmake (list '(0 . "LINE") '(6 . "ACAD_ISO04W100") '(370 . 20) (cons 10 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ x05 x06)) 0 1)) (cons 11 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ x03 x04)) 0 1)))) (princ "\nОтрезок не создан!")))

Сообщение от bboysyndrom В чем проблема может быть?

Скорее всего в выделенным красным. Подгрузи предварительно тип линии ACAD_ISO04W100

[bboysyndrom]

Спасибо, работает. Как изменить цвет средней линии (на 11, например), оставив слой и толщину исходных линий (послою)?

[Astartes]

У меня тоже такая проблема возникала. Редко правда.Я все немог понять, из-за чего. А теперь понятно.

[VVA]

Добавил в код #35 функцию _kpblc-linetype-load
Без проверки, но должно работать

Код:

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

  (defun C:BI_LINE  (/ x00 x01 x01 x02 x03 x04 x05 x06 x07 x08 x09 x0a x0b x0c x0d x0e _bm _cm)
   ;;; http://forum.dwg.ru/showthread.php?t=83128&page=2
   ;;; ADD VVA 2012-10-13 START
   (if (null (tblsearch "LTYPE" "ACAD_ISO04W100"))
   (_kpblc-linetype-load "ACAD_ISO04W100" nil)
     )
   ;;; ADD VVA 2012-10-13 END
  (setq _cm (getvar "CMDECHO")
        _bm (getvar "BLIPMODE"))
  (setvar "CMDECHO" 1)
  (setvar "BLIPMODE" 0)
  (while (progn (princ "\nВыберите отрезки или дуги, или сплайны...")
                (setq x00 (ssget '((-4 . "<or") (0 . "line") (0 . "arc") (0 . "spline") (-4 . "or>")))))
    (redraw (setq x01 (ssname x00 0)) 3)
    (redraw (setq x02 (ssname x00 (1- (sslength x00)))) 3)
    (setq x00 nil
          x05 (cdr (assoc 0 (setq x03 (entget x01))))
          x06 (cdr (assoc 0 (setq x04 (entget x02)))))
    (cond ((and (eq "LINE" x05) (eq "LINE" x06))
           (if (> (+ (distance (setq x05 (cdr (assoc 10 x03))) (setq x06 (cdr (assoc 10 x04))))
                     (distance (setq x03 (cdr (assoc 11 x03))) (setq x04 (cdr (assoc 11 x04)))))
                  (+ (distance x05 x04) (distance x03 x06)))
             (setq x00 x06
                   x06 x04
                   x04 x00))
           (cond ;;оотерзки пересекаются
                 ((setq x07 (inters x05 x03 x06 x04 t))
                  (setq x08 (max (distance x07 x05) (distance x07 x06))
                        x09 (max (distance x07 x03) (distance x07 x04))
                        x05 (polar x07 (angle x07 x05) x08)
                        x03 (polar x07 (angle x07 x03) x09)
                        x06 (polar x07 (angle x07 x06) x08)
                        x04 (polar x07 (angle x07 x04) x09)))
                 ;; пересекаются прямые, на которых лежат отрезки
                 ((setq x07 (inters x05 x03 x06 x04 nil))
                  (if (> (distance x07 x05) (distance x07 x03))
                    (setq x00 x05
                          x05 x03
                          x03 x00
                          x00 x06
                          x06 x04
                          x04 x00))
                  (setq x08 (min (distance x07 x05) (distance x07 x06))
                        x09 (max (distance x07 x03) (distance x07 x04))
                        x05 (polar x07 (angle x07 x05) x08)
                        x03 (polar x07 (angle x07 x03) x09)
                        x06 (polar x07 (angle x07 x06) x08)
                        x04 (polar x07 (angle x07 x04) x09))))
           (or (entmake (list '(0 . "LINE")
                              '(6 . "ACAD_ISO04W100")
                              '(370 . 20)
                              (cons 10 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ x05 x06)) 0 1))
                              (cons 11 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ x03 x04)) 0 1))))
               (princ "\nОтрезок не создан!")))
          ((and (eq "ARC" x05) (eq "ARC" x06))
           (or (entmake
                 (list '(0 . "ARC")
                       '(6 . "ACAD_ISO04W100")
                       '(370 . 20)
                       (cons 10
                             (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (cdr (assoc 10 x03)) (cdr (assoc 10 x04)))) 0 1))
                       (cons 40 (/ (+ (cdr (assoc 40 x03)) (cdr (assoc 40 x04))) 2))
                       (cons 50 (/ (+ (cdr (assoc 50 x03)) (cdr (assoc 50 x04))) 2))
                       (cons 51 (/ (+ (cdr (assoc 51 x03)) (cdr (assoc 51 x04))) 2))))
               (princ "\nДуга не создана!")))
          ((and (eq "SPLINE" x05) (eq "SPLINE" x06))
           (setq x00 (list (quote (setq x0b (append x0b (list (cons 40 (/ (+ (cdar (setq x03 (cdr x03))) (cdar (setq x04 (cdr x04)))) 2))))
                                        x0c (append x0c (list (cons 10 (polar x09 (angle x09 x0a) (/ x0e 2)))))
                                        x07 (cdr x07)
                                        x08 (cdr x08)
                                        x05 x09
                                        x06 x0a))
                           (quote (setq x0b (append x0b (list (cons 40 (/ (+ (cdar (setq x03 (cdr x03))) (cdar x04)) 2))))
                                        x0c (append x0c (list (cons 10 (polar x09 (angle x09 x06) (/ x0e 2)))))
                                        x07 (cdr x07)
                                        x05 x09))
                           (quote (setq x0b (append x0b (list (cons 40 (/ (+ (cdar x03) (cdar (setq x04 (cdr x04)))) 2))))
                                        x0c (append x0c (list (cons 10 (polar x05 (angle x05 x0a) (/ x0e 2)))))
                                        x08 (cdr x08)
                                        x06 x0a)))
                 x07 (member (setq x05 (assoc 10 x03)) x03)
                 x08 (member (setq x06 (assoc 10 x04)) x04)
                 x0b (list)
                 x03 (member (assoc 40 (setq x03 (reverse (member (assoc 40 (setq x03 (reverse x03))) x03)))) x03)
                 x04 (member (assoc 40 (setq x04 (reverse (member (assoc 40 (setq x04 (reverse x04))) x04)))) x04)
                 x05 (cdr x05)
                 x06 (cdr x06))
           (repeat 4
             (setq x0b (append x0b (list (cons 40 (/ (+ (cdar x03) (cdar x04)) 2))))
                   x03 (cdr x03)
                   x04 (cdr x04)))
           (and (> (distance x05 x06) (distance x05 (cdr (last x08))))
                (> (distance x05 x06) (distance (cdr (last x07)) x06))
                (setq x08 (reverse (cons (cons 10 x06) x08))
                      x06 (cdar x08)
                      x08 (cdr x08))) ;x04 (reverse x04)
           (setq x0b (append x0b (list (cons 40 (/ (+ (cdar x03) (cdar x04)) 2)))))
           (setq x0c (list (cons 10 (polar x05 (angle x05 x06) (/ (distance x05 x06) 2)))))
           (while (and (setq x09 (cdadr x07)) (setq x0a (cdadr x08)))
             (eval
               (nth (1-
                      (length
                        (member (setq x0e (apply 'min (setq x0d (list (distance x05 x0a) (distance x06 x09) (distance x09 x0a)))))
                                x0d)))
                    x00)))
           (setq x00 (cdar x03))
           (or x0a
               (setq x08 x07
                     x00 (cdar x04)
                     x04 x03
                     x0a x09
                     x05 x06))
           (repeat (length x08)
             (setq x0b (append x0b (list (cons 40 (/ (+ x00 (cdar x04)) 2))))
                   x0c (append x0c (list (cons 10 (polar x05 (angle x05 x0a) (/ (distance x05 x0a) 2)))))
                   x04 (cdr x04)
                   x08 (cdr x08)
                   x0a (cdar x08)))
           (or (entmake (append (quote ((0 . "SPLINE") (100 . "AcDbEntity")
                                                       (100 . "AcDbSpline") 
                                                       (6 . "ACAD_ISO04W100")
                                                       (370 . 20)
                                                       (70 . 8)
                                                       (71 . 3)))
                                (list (cons 72 (length x0b)) (cons 73 (length x0c)))
                                (quote ((74 . 0) (42 . 1.0e-10) (43 . 1.0e-10)))
                                x0b
                                x0c))
               (princ "\nСплайн не созданн!")))
          (t (princ "\nВыбраны примитивы разных типов!")))
    (redraw x01 4)
    (redraw x02 4))
  (setvar "BLIPMODE" _bm)
  (setvar "CMDECHO" _cm)
  (princ))
;|==================================================*===========================
*  LISP. Загрузка типа линии. Универсальная.
*  Кулик Алексей aka kpblc
*  URL: http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=44&TID=22816
*    Функция подгрузки типа линии в текущий файл. Учитывает возможную
* локализацию системы.
*    Параметры вызова:
*  ltype-name  имя типа линии для английской версии
*  ltype-file  имя файла описания типа линии. nil -> "acadiso.lin"ю
*      Если файл с описанием типа линии не лежит по путям
*      поддержки када, надо указывать полный путь к нему.
*    Примеры вызова:
(_kpblc-linetype-load "center" nil)  ; для русской версии подгружает Осевая и возвращает
                                     ; t при успехе
***  Соответствие наименований линий обеспечивается огромным списком ltype_list
*** который можно и нужно дополнять :) Только надо либо все делать мелкими
*** буквами, либо жестко соблюдать регистр в моменты вызовов.
***  Тип линии "Continuous" обработке не подвергается - он есть во всех версиях
==================================================*===========================|;
    (defun _kpblc-linetype-load (ltype-name ltype-file / ltype_list)
      (vl-load-com)
      (or
        *kpblc-activedoc*
        (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
        )
      (if (not (member (strcase ltype-name t)
                       '("continuous" "byblock" "bylayer")
               ) ;_ end of member
          ) ;_ end of not
        (progn
          (setq ltype_list '(("border" . "рант")
                             ("border2" . "рант2")
                             ("borderX2" . "рантX2")
                             ("center" . "осевая")
                             ("center2" . "осевая2")
                             ("centerX2" . "осеваяX2")
                             ("dashdot" . "штрихпунктирная")
                             ("dashdot2" . "штрихпунктирная2")
                             ("dashdotX2" . "штрихпунктирнаяX2")
                             ("dashed" . "штриховая")
                             ("dashed2" . "штриховая2")
                             ("dashedX2" . "штриховаяX2")
                             ("divide" . "линия_сгиба")
                             ("divide2" . "линия_сгиба2")
                             ("divideX2" . "линия_сгибаX2")
                             ("dot" . "пунктирная")
                             ("dot2" . "пунктирная2")
                             ("dotX2" . "пунктирнаяX2")
                             ("hidden" . "невидимая")
                             ("hidden2" . "невидимая2")
                             ("hiddenX2" . "невидимаяX2")
                             ("phantom" . "фантом")
                             ("phantom2" . "фантом2")
                             ("phantomX2" . "фантомX2")
                             ("fenceline1" . "ограждение1")
                             ("fenceline2" . "ограждение2")
                             ("tracks" . "пути")
                             ("batting" . "изоляция")
                             ("hot_water_supply" . "горячая_вода")
                             ("gas_line" . "газопровод")
                             ("zigzag" . "зигзаг")
                             ("byblock" . "byblock")
                             ("bylayer" . "bylayer")

                            )
                ltype-name (strcase ltype-name t)
          ) ;_ end of setq 
          (if (not ltype-file)
            (setq ltype-file "acadiso.lin")
          ) ;_ end of if 
          (if (assoc ltype-name ltype_list)
            (setq ltype-name
                   (if (vl-string-search "419" (vlax-product-key))
                     (cdr (assoc ltype-name ltype_list))
                     (car (assoc ltype-name ltype_list))
                   ) ;_ end of if 
            ) ;_ end of setq 
          ) ;_ end of if 
          (if (not (tblsearch "ltype" ltype-name))
            ;; тип линии не найден, надо его загрузить. Тип линии должен быть 
            ;; описан в файле 
            (vl-catch-all-error-p
              (vl-catch-all-apply
                'vla-load
                (list
                  (vlax-get-property
                    *kpblc-activedoc*
                    'linetypes
                  ) ;_ end of vlax-get-property 
                  ltype-name
                  ltype-file
                ) ;_ end of list 
              ) ;_ end of vl-catch-all-apply 
            ) ;_ end of vl-catch-all-error-p 
          ) ;_ end of if 
        ) ;_ end of progn 
      ) ;_ end of if
      (if (tblsearch "ltype" ltype-name)
        (vla-item (vla-get-linetypes *kpblc-activedoc*) ltype-name)
        (vla-item (vla-get-linetypes *kpblc-activedoc*)
                  "continuous"
        ) ;_ end of vla-item
      ) ;_ end of if
    ) ;_ end of defun
(princ "\nType BI_LINE in command line")(princ)

[Astartes]

VVA, Ничего не поменялось. Если линия не загружена изначально, то лисп не работает.
При загрузке:
Команда: _appload
bi_line5.lsp успешно загружено.
Команда: ; ошибка: неверный тип аргумента: stringp nil

[VVA]

Astartes, Я же честно написал

Сообщение от VVA Без проверки, но должно работать

Так что соврал наполовину
Исправил #43 Пробуй снова

[Astartes]

VVA, Ну так я же без претензий.
Завтра проверю.

[bboysyndrom]

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

[VVA]

Сообщение от bboysyndrom что средняя линия будет обладать свойствами родительскими изменив лишь цвет, например на 11

Код:

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

  (defun C:BI_LINE2  (/ x00 x01 x01 x02 x03 x04 x05 x06 x07 x08 x09 x0a x0b x0c x0d x0e _bm _cm)
   ;;; http://forum.dwg.ru/showthread.php?t=83128&page=2
    (vl-load-com)
  (setq _cm (getvar "CMDECHO")
        _bm (getvar "BLIPMODE"))
  (setvar "CMDECHO" 1)
  (setvar "BLIPMODE" 0)
  (while (progn (princ "\nВыберите отрезки или дуги, или сплайны...")
                (setq x00 (ssget '((-4 . "<or") (0 . "line") (0 . "arc") (0 . "spline") (-4 . "or>")))))
    (redraw (setq x01 (ssname x00 0)) 3)
    (redraw (setq x02 (ssname x00 (1- (sslength x00)))) 3)
    (setq x00 nil
          x05 (cdr (assoc 0 (setq x03 (entget x01))))
          x06 (cdr (assoc 0 (setq x04 (entget x02)))))
    (cond ((and (eq "LINE" x05) (eq "LINE" x06))
           (if (> (+ (distance (setq x05 (cdr (assoc 10 x03))) (setq x06 (cdr (assoc 10 x04))))
                     (distance (setq x03 (cdr (assoc 11 x03))) (setq x04 (cdr (assoc 11 x04)))))
                  (+ (distance x05 x04) (distance x03 x06)))
             (setq x00 x06
                   x06 x04
                   x04 x00))
           (cond ;;оотерзки пересекаются
                 ((setq x07 (inters x05 x03 x06 x04 t))
                  (setq x08 (max (distance x07 x05) (distance x07 x06))
                        x09 (max (distance x07 x03) (distance x07 x04))
                        x05 (polar x07 (angle x07 x05) x08)
                        x03 (polar x07 (angle x07 x03) x09)
                        x06 (polar x07 (angle x07 x06) x08)
                        x04 (polar x07 (angle x07 x04) x09)))
                 ;; пересекаются прямые, на которых лежат отрезки
                 ((setq x07 (inters x05 x03 x06 x04 nil))
                  (if (> (distance x07 x05) (distance x07 x03))
                    (setq x00 x05
                          x05 x03
                          x03 x00
                          x00 x06
                          x06 x04
                          x04 x00))
                  (setq x08 (min (distance x07 x05) (distance x07 x06))
                        x09 (max (distance x07 x03) (distance x07 x04))
                        x05 (polar x07 (angle x07 x05) x08)
                        x03 (polar x07 (angle x07 x03) x09)
                        x06 (polar x07 (angle x07 x06) x08)
                        x04 (polar x07 (angle x07 x04) x09))))
           (or (if(entmake (list '(0 . "LINE")
                             ; '(6 . "ACAD_ISO04W100")
                             ; '(370 . 20)
                              (cons 10 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ x05 x06)) 0 1))
                              (cons 11 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ x03 x04)) 0 1))))
                 (progn
             (mapcar
               '(lambda (x y) (vlax-put-property (vlax-ename->vla-object(entlast)) x y))
               '(Linetype LineWeight Color Layer)
               (mapcar
                 '(lambda (x)
                    (vlax-get-property (vlax-ename->vla-object x01) x))
                 '(Linetype LineWeight Color Layer)))
             (vla-put-Color (vlax-ename->vla-object(entlast)) 11) ;_Цвет номер 13
             )
                 )
               (princ "\nОтрезок не создан!")))
          ((and (eq "ARC" x05) (eq "ARC" x06))
           (or
              (if(entmake
                 (list '(0 . "ARC")
                    ;   '(6 . "ACAD_ISO04W100")
                    ;   '(370 . 20)
                       (cons 10
                             (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (cdr (assoc 10 x03)) (cdr (assoc 10 x04)))) 0 1))
                       (cons 40 (/ (+ (cdr (assoc 40 x03)) (cdr (assoc 40 x04))) 2))
                       (cons 50 (/ (+ (cdr (assoc 50 x03)) (cdr (assoc 50 x04))) 2))
                       (cons 51 (/ (+ (cdr (assoc 51 x03)) (cdr (assoc 51 x04))) 2))))
                (progn
             (mapcar
               '(lambda (x y) (vlax-put-property (vlax-ename->vla-object(entlast)) x y))
               '(Linetype LineWeight Color Layer)
               (mapcar
                 '(lambda (x)
                    (vlax-get-property (vlax-ename->vla-object x01) x))
                 '(Linetype LineWeight Color Layer)))
             (vla-put-Color (vlax-ename->vla-object(entlast)) 11) ;_Цвет номер 13
             )
                )
               (princ "\nДуга не создана!")))
          ((and (eq "SPLINE" x05) (eq "SPLINE" x06))
           (setq x00 (list (quote (setq x0b (append x0b (list (cons 40 (/ (+ (cdar (setq x03 (cdr x03))) (cdar (setq x04 (cdr x04)))) 2))))
                                        x0c (append x0c (list (cons 10 (polar x09 (angle x09 x0a) (/ x0e 2)))))
                                        x07 (cdr x07)
                                        x08 (cdr x08)
                                        x05 x09
                                        x06 x0a))
                           (quote (setq x0b (append x0b (list (cons 40 (/ (+ (cdar (setq x03 (cdr x03))) (cdar x04)) 2))))
                                        x0c (append x0c (list (cons 10 (polar x09 (angle x09 x06) (/ x0e 2)))))
                                        x07 (cdr x07)
                                        x05 x09))
                           (quote (setq x0b (append x0b (list (cons 40 (/ (+ (cdar x03) (cdar (setq x04 (cdr x04)))) 2))))
                                        x0c (append x0c (list (cons 10 (polar x05 (angle x05 x0a) (/ x0e 2)))))
                                        x08 (cdr x08)
                                        x06 x0a)))
                 x07 (member (setq x05 (assoc 10 x03)) x03)
                 x08 (member (setq x06 (assoc 10 x04)) x04)
                 x0b (list)
                 x03 (member (assoc 40 (setq x03 (reverse (member (assoc 40 (setq x03 (reverse x03))) x03)))) x03)
                 x04 (member (assoc 40 (setq x04 (reverse (member (assoc 40 (setq x04 (reverse x04))) x04)))) x04)
                 x05 (cdr x05)
                 x06 (cdr x06))
           (repeat 4
             (setq x0b (append x0b (list (cons 40 (/ (+ (cdar x03) (cdar x04)) 2))))
                   x03 (cdr x03)
                   x04 (cdr x04)))
           (and (> (distance x05 x06) (distance x05 (cdr (last x08))))
                (> (distance x05 x06) (distance (cdr (last x07)) x06))
                (setq x08 (reverse (cons (cons 10 x06) x08))
                      x06 (cdar x08)
                      x08 (cdr x08))) ;x04 (reverse x04)
           (setq x0b (append x0b (list (cons 40 (/ (+ (cdar x03) (cdar x04)) 2)))))
           (setq x0c (list (cons 10 (polar x05 (angle x05 x06) (/ (distance x05 x06) 2)))))
           (while (and (setq x09 (cdadr x07)) (setq x0a (cdadr x08)))
             (eval
               (nth (1-
                      (length
                        (member (setq x0e (apply 'min (setq x0d (list (distance x05 x0a) (distance x06 x09) (distance x09 x0a)))))
                                x0d)))
                    x00)))
           (setq x00 (cdar x03))
           (or x0a
               (setq x08 x07
                     x00 (cdar x04)
                     x04 x03
                     x0a x09
                     x05 x06))
           (repeat (length x08)
             (setq x0b (append x0b (list (cons 40 (/ (+ x00 (cdar x04)) 2))))
                   x0c (append x0c (list (cons 10 (polar x05 (angle x05 x0a) (/ (distance x05 x0a) 2)))))
                   x04 (cdr x04)
                   x08 (cdr x08)
                   x0a (cdar x08)))
           
           (or
             (if
             (entmake (append (quote ((0 . "SPLINE") (100 . "AcDbEntity")
                                                       (100 . "AcDbSpline") 
                                                      ; (6 . "ACAD_ISO04W100")
                                                      ; (370 . 20)
                                                       (70 . 8)
                                                       (71 . 3)))
                                (list (cons 72 (length x0b)) (cons 73 (length x0c)))
                                (quote ((74 . 0) (42 . 1.0e-10) (43 . 1.0e-10)))
                                x0b
                                x0c))
             (progn
             (mapcar
               '(lambda (x y) (vlax-put-property (vlax-ename->vla-object(entlast)) x y))
               '(Linetype LineWeight Color Layer)
               (mapcar
                 '(lambda (x)
                    (vlax-get-property (vlax-ename->vla-object x01) x))
                 '(Linetype LineWeight Color Layer)))
             (vla-put-Color (vlax-ename->vla-object(entlast)) 11) ;_Цвет номер 13
             )
             )
               (princ "\nСплайн не созданн!")))
          (t (princ "\nВыбраны примитивы разных типов!")))
    (redraw x01 4)
    (redraw x02 4))
  (setvar "BLIPMODE" _bm)
  (setvar "CMDECHO" _cm)
  (princ))
(princ "\nType BI_LINE2 in command line")(princ)

[bboysyndrom]

Подозреваю, что пристроили функцию, которая изменяет свойства средней линии с " тип линии ACAD_ISO..., толщина 0.2" на "послою, послою, цвет11"? Неужели нельзя все проще сделать?
Объясните, что происходит в этих строках?

(or (entmake (list '(0 . "LINE") ---???
'(6 . "ACAD_ISO04W100") ---???
'(370 . 20) ---???
(cons 10 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ x05 x06)) 0 1))
(cons 11 (trans (mapcar '* '(0.5 0.5 0.5) (mapcar '+ x03 x04)) 0 1))))

[VVA]

bboysyndrom,Если это про #48, то не правильно подозреваешь

Сообщение от bboysyndrom Объясните, что происходит в этих строках?

Создается линия, остальное нужно было убрать либо закоментировать
Исправил #48

[bboysyndrom]

А как теперь сделать возможность выбора цвета при выполнении команды и свойством цвета ПоСлою по умолчанию?

(_bi_line2 --- Выберите цвет<ПоСлою"по умолчанию">)

Нужно это при проектировании трубопроводов: Ду150 и более - осевая линия(цвет 11), Ду100 и менее - жирная основная линия (цвет красный).

[Astartes]

bboysyndrom, А слоями не пользуешся? Создай слой Ду150 дай ему цвет 11. Потом воспользуйся функцией изоляция слоя и проставляй осевые. Зачем это все прописывать в программе?
Хотя я может чегото и не понимаю.

[bboysyndrom]

Слои использую как линии трубопроводов, по продукту (Гудрон, например). Цвета определяют стиль линий при печати (например, 11 - осевая, красный - жирная, белый - тонкая).

Кто способен, просьба настроить этот Lisp, чтобы
- при запуске функции был запрос(меню):

Выберите линии, дуги... или [Цвет(11, 5 и т.д.)/реЖим(удалять исходные, оставлять исходные)] <Цвет>:

т.е. была возможность выбора цвета и режима.

Помогите начинающему инженеру в создании этого лиспа, кто может =)