[Profan]

Программа может заменить стандартную команду "_Line" ("Отрезок")

Код:

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

 
;********** SETI.LSP ***********************************
; Программа отрисовки сети из сопряженных отрезков.
; Автор Громов В.В. 2009 г.
; Макрос для загрузки:
; ^C^C(if (not C:СЕТИ) (load "seti")) СЕТИ
;
(defun C:СЕТИ ( / echo rd pt1 pt2 pt3 ent1 ent2)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(if (null rds) (setq rds "0"))
(princ (strcat "\n Радиус сопряжения <" rds ">: "))
(setq rd (getint))
(if (= rd nil) (setq rd (atoi rds)) (setq rds (itoa rd)))
(vl-cmdf "_FILLET" "_r" rd)
(initget 7)
(setq pt1 (getpoint "\n Начальная точка: "))
(initget 7)
(setq pt2 (getpoint pt1 "\n Вторая точка: "))
(vl-cmdf "_LINE" pt1 pt2 "")
(setq ent1 (entlast))
(setq pt3 (getpoint pt2 "\n Следующая точка <Enter-Конец>: "))
(if pt3
(progn
(vl-cmdf "_LINE" pt2 pt3 "")
(setq ent2 (entlast))
(vl-cmdf "_fillet" ent1 ent2)
(while pt3
   (setq pt2 pt3)
   (setq ent1 ent2)
   (setq pt3 (getpoint pt2 "\n Следующая точка <Enter-Конец> "))
   (if pt3
       (progn
       (vl-cmdf "_LINE" pt2 pt3 "")
       (setq ent2 (entlast))
       (vl-cmdf "_fillet" ent1 ent2)
       )
       (princ "\n Конец.")
   )
)
)
)
(setvar "CMDECHO" echo)
(princ)
)
(princ "\n Ввести в командной строке СЕТИ")

Вариант с преобразованием отрезков и дуг в полилинию.

Код:

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

 
;********** SETI_PL.LSP *****************************************
; Программа отрисовки сети из сопряженных отрезков 
; с последующим объединением в полилинию.
; Автор Громов Владимир 2009 г.
; Макрос для загрузки:
; ^C^C(if (not C:СЕТИ_ПЛ) (load "seti_pl")) СЕТИ_ПЛ
;
(defun C:СЕТИ_ПЛ ( / echo rd pt1 pt2 pt3 ent1 ent2 ss dlina)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq ss (ssadd))
(if (null rds) (setq rds "0"))
(princ (strcat "\n Радиус сопряжения <" rds ">: "))
(setq rd (getint))
(if (= rd nil) (setq rd (atoi rds)) (setq rds (itoa rd)))
(vl-cmdf "_FILLET" "_r" rd)
(initget 7)
(setq pt1 (getpoint "\n Начальная точка: "))
(initget 7)
(setq pt2 (getpoint pt1 "\n Вторая точка: "))
(vl-cmdf "_LINE" pt1 pt2 "")
(setq ent1 (entlast))
(ssadd ent1 ss)
(setq pt3 (getpoint pt2 "\n Следующая точка <Enter-Конец>: "))
(if pt3
(progn
(vl-cmdf "_LINE" pt2 pt3 "")
(setq ent2 (entlast))
(ssadd ent2 ss)
(vl-cmdf "_fillet" ent1 ent2)
(ssadd (entlast) ss)
(while pt3
   (setq pt2 pt3)
   (setq ent1 ent2)
   (setq pt3 (getpoint pt2 "\n Следующая точка <Enter-Конец> "))
   (if pt3
       (progn
       (vl-cmdf "_LINE" pt2 pt3 "")
       (setq ent2 (entlast))
       (ssadd ent2 ss)
       (vl-cmdf "_fillet" ent1 ent2)
       (ssadd (entlast) ss)
       )
       (princ "\n Конец.")
   )
)
)
)
(vl-cmdf "_PEDIT" "_m" ss "" "_yes" "_join" "" "")
(vl-load-com)
(setq dlina (vlax-get-property (vlax-ename->vla-object (entlast)) 'length))
(princ "\n Длина трассы = ") (princ dlina)
(setvar "CMDECHO" echo)
(princ)
)
(princ "\n Ввести в командной строке СЕТИ_ПЛ")

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

Критику примешь?

[Profan]

Сообщение от Кулик Алексей aka kpblc Критику примешь?

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

[ShaggyDoc]

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

Код:

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

(setq old_osnap (getvar "OSMODE"))
(setvar "OSMODE" 0)
(vl-cmdf "_LINE" pt1 pt2 "")
(setvar "OSMODE" old_osnap)

Тогда и пользователь может любыми привязками пользоваться и программа будет работать правильно.

[Krieger]

Тогда уж так:
(vl-cmdf "_LINE" "_none" pt1 "_none" pt2 "")
Тогда восстанавливать не надо привязки и esc не помешает.

[Makswell]

Сообщение от Profan Модуль обработки ошибок сознательно не делал, возможные ошибки здесь мало чем отличаются от возможных ошибок при выполнении команды "_Line".

Как сказать. При отмене команды _Line переменная CMDECHO не сбрасывается в 0. ИМХО это важно.

[Profan]

Именно эти замечания я и ожидал увидеть. Можно оставить CMDECHO равной 1. Если количество командных строк не более 3, то фактически все промежуточные сообщения проскакивают незаметно. С OSMODE вообще связываться не хочу. Не думаем же мы об этой переменной, когда рисуем отрезки, просто устанавливаем заранее нужные нам объектные привязки. Да и F3 работает ведь. Честно скажу - совсем неохота расчитывать на дремучих пользователей.

[Дима_]

Ну если уж на то пошло - почему-бы просто не заменить

Код:

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

(vl-cmdf "_LINE" pt2 pt3 "")

на

Код:

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

(entmakex (list (cons 0 "line") (cons 10 pt2) (cons 11 pt3)))

P.S. А еще красивее вместо

Код:

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

(vl-cmdf "_LINE" pt2 pt3 "")
(setq ent2 (entlast))

Код:

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

(setq ent2 (entmakex (list (cons 0 "line") (cons 10 pt2) (cons 11 pt3))))

[Makswell]

ну и

Код:

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

(vl-cmdf "_FILLET" "_r" rd)

ИМХО лучше заменить на

Код:

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

(setvar "FILLETRAD" rd)

Добавлено:
а лучше, конечно так:

Код:

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

(setq old_FILLETRAD (getvar "FILLETRAD"))
....
....
(setvar "FILLETRAD" rd)
....
....
(setvar "FILLETRAD" old_FILLETRAD)

[Profan]

Дима_, объясни - в чем для пользователя проявится преимущество твоего варианта кода?
Makswell, а в твоей замене что-то не вижу смысла...

[Makswell]

Сообщение от Profan Makswell, а в твоей замене что-то не вижу смысла...

Так быстрее и без эха в ком. строке.
А насчет добавленного позже кода, я (и не только) считаю, что после окончания работы программы сама система Автокада должна оставаться в таком же виде, что и непосредственно перед запуском лиспа. Вот запустит потом юзер просто _FILLET, а там уже какой-то непонятный радиус появился. А может у юзера вообще привычка делать _FILLET с радиусом 0? Короче, вспомни увлекательные приключения некоторых пользователей на тему FILEDIA.

[Дима_]

То Profan 100% избавления от гемороя с привязками.

[Profan]

Да какой, блин, геморрой с привязками? Пользователь рисовал подобную трассу отрезками с нужными ему привязками или с отключенными привязками и никакого геморроя у него не образовалось. Точно так же, и с теми же привязками или без оных он будет тащить свою трассу с помощью программы. Суть-то программы в том, что теперь пользователю не надо прощелкивать трассу, отрисованную последовательными отрезками, командой "_FILLET" ("СОПРЯЖЕНИЕ"). Вот это главное.
Makswell, FILEDIA скрыта от пользователя, а при выполнении команды "_FILLET" на экран выводится текущее значение радиуса сопряжения, причем, независимо от значения переменной CMDECHO.

И вообще, знаете, чем слаботочник обосновал необходимость такой программы? Думаете, он кабель или короб гнет по радиусу, скажем, 150 мм? Да нет, это не трубопровод. Просто ему нужно, чтобы его трассы на чертеже имели закругления в углах. В отличие от стен, которые закруглений в углах не имеют. Вот такая подоплёка.

Еще добавлю. На форуме caduser.ru один пользователь предложил дополнить программу возможностью по ходу построения отменять сегменты. Что-то я сомневаюсь в необходимости этого для случая простых отрезков с дугами. Тем не менее, был бы рад подсказке, как это сделать. Во второй программе идет накопление объектов в наборе, из которого потом формируется полилиния. Если я отменю сегмент, этот объект из набора тоже исчезнет?

[VVA]

Profan, Отменять сегменты последовательно?

[Profan]

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

[Дима_]

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

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

Код:

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

(vl-cmdf "_line" (getpoint) (getpoint) "")

, а потом

Код:

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

(entmakex (list (cons 0 "line") (cons 10 (getpoint)) (cons 11 (getpoint))))

.

[Profan]

Сообщение от Дима_ В том-то и беда, что сейчас не образовались а в самый нужный момент и не заметишь как провод "в воздухе" висит.

Дима_, да я в принципе не спорю с тем фактом, что неправильно установленные привязки могут сыграть плохую роль при отрисовке объектов. Но в данном случае отрисовка производится вообще при выключенных привязках, а эту операцию мои заказчики выполняют нажатием клавиши F3. Вообще, отрисовку сетей они производят фактически на глазок, вдоль стен помещений и изредка могут временно включить привязку при подводке к какому-нибудь распределителю. В большинстве случаев отрисовка производится в режиме ОРТО, но иногда и при выключенным режиме ОРТО, что выполняется нажатием клавиши Shift. И вот тут есть своя проблема: клавиша Shift является клавишей временной замены (переключателем режима ОРТО). Но в то же время при нажатой клавише Shift радиус сопряжения временно сбрасывается в 0 - вот проблема, с которой я еще не разобрался. Или вот отмена последнего отрисованного сегмена в случае циклического выполнения команд с переназначением координат точек. А то - какие-то привязки. Задача специализированная. Конечно, если к ней подходить, как к некой абстрактной задаче отрисовки с неопределенными условиями - тогда можно и поизгаляться с предвосхищениям всех мыслимых условий. Но, может, к этому я еще вернусь, пока надо решить несколько принципиальных вопросов, возможно у заказчиков (пользователей) появятся дополнительные пожелания.

[VVA]

Profan, Вот вариант с отменой. Добавил коментарии, должно быть понятно.
Остановлюсь на основном моменте. При отмене с помощью UNDO восстанавливается и состояние системных переменных, в том числе и USER*
Поэтому
1. С помощью UNDOMARKS контролируем счетчик отмен, чтобы не отменить лишнего
2. Запоминаем X последней точки в USERR1, Y в USERR2. В случае отмены последнюю точку восстанавливает из этих переменных
3. Для сопряжения запоминаем метку (5 код dxf) последнего отрезка в переменной USERS2, в переменную USERS1 запоминаем предыдущее значение USERS2. Это позволит начать сопрягать начиная с 2 отрезков.
4. Для вызова сопряжения используем vl-cmdf. В случае невозможности сопрячь отрезки заданным радиусом не произойдет аварийного завершения команды.
Вот как-то так

Код:

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

;;;********** SETI.LSP ***********************************
;;; Программа отрисовки сети из сопряженных отрезков.
;;; Автор Громов В.В. 2009 г.
;;; Корректировка для опции Отмени (UNDO)
;;; Владимир Азарко (VVA) 
;;; Макрос для загрузки:
;;; ^C^C(if (not C:СЕТИ)(load "seti"));СЕТИ;
;;; ^C^C(if (not C:СЕТИ_ПЛ)(load "seti"));СЕТИ_ПЛ;
;;;
 
(defun C:СЕТИ_ПЛ ()(seti t))
(defun C:СЕТИ ()(seti nil))
(princ "\n Ввести в командной строке СЕТИ_ПЛ или СЕТИ")
(defun seti ( toPline / echo rd pt1 pt2 ent1 ent2 U_M *error* old_FRD eLast ss)
;;;Функция seti - отрисовка сетей
;;; Аргумент toPline = t - собирать в полилинию
;;;          toPline = nil - нет
  (vl-load-com)
  ;;;Объявляем локальную ф-цию *error*
  (defun *error* (msg / image_set)
;;;Прерываем активную команду  
(while (> (getvar "CMDACTIVE") 0)(command))
(princ msg)
(setvar "FILLETRAD" old_FRD)
(setvar "USERS1" "")  ;;;Чистим переменные
(setvar "USERS2" "")  ;;;Чистим переменные
 (princ)
  )
;;;Проверяем установки UNDO и устанавливает All control
  (setq U_M (getvar "UNDOCTL"))
  (cond
    ((= (logand U_M 1) 0)(command "_.UNDO" "_All"))  ;;; Отключено UNDO
    ((= (logand U_M 3) 3)(command "_.UNDO" "_Control" "_All")) ;;; Разрешена отмена одной операции
    (t nil)
  ) ;_ end of cond
(setq U_M (getvar "UNDOMARKS")) ;;;VVA Запоминаем счетчик отмен UNDO
(setq old_FRD  (getvar "FILLETRAD"))
(setvar "USERS1" "")  ;;;Чистим переменные
(setvar "USERS2" "")  ;;;Чистим переменные
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(if toPline  
;;; Запоминаем в eLast последний примитив
(if (null(setq eLast (entlast)))
    (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
       (setq eLast (entlast))(entdel eLast)))
  )
(if (not(numberp *RDS*))(setq *RDS* (getvar "FILLETRAD")))
(princ "\n Радиус сопряжения <")(princ  *RDS*)(princ ">: ")
(if (setq rd (getint))(setq *RDS* rd)(setq rd *RDS*))
(setvar "FILLETRAD" rd)  
(initget 7)
(setq pt1 (getpoint "\n Начальная точка: "))
(initget "Отмени Undo _Undo Undo")
(while (setq pt2 (getpoint pt1 "\nСледующая точка [Отмени] <выход>: "))
  (cond
     ((listp pt2) ;_Указана точка
      ;;;Запоминаем в переменных USERR1 и USERR2 X и Y указанной точки
      ;;;в мировых координатах. Это позволит пользователю прозрачно менять ПСК
      (setvar "USERR1" (car (trans pt1 1 0))) ;;;Запоминаем X точки pt1 в МСК
      (setvar "USERR2" (cadr (trans pt1 1 0)));;;Запоминаем Y точки pt1 в МСК
      (command "_.UNDO" "_M")                 ;;;Ставим метку UNDO
      (command "_.LINE" "_none" pt1 "_none" pt2 "")
      (setvar "USERS1" (getvar "USERS2"))  ;;;Перемещаем метку 2-го примитива в 1-й
      (setvar "USERS2" (cdr(assoc 5 (entget (entlast))))) ;;Метка последнего примитива
      (if (and (setq ent1 (handent (getvar "USERS1")))  ;;; Примитив существует
               (setq ent2 (handent (getvar "USERS2")))  ;;; Примитив существует
               (entget ent1)  ;;; Примитив не удален
               (entget ent2)  ;;; Примитив не удален
               )
        (vl-cmdf "_.FILLET"  ent1 ent2)
 
        ;;;Сопрягаем
        )
      (setq pt1 pt2)
      )
     ((= pt2 "Undo")
      (if (< U_M (getvar "UNDOMARKS")) ;;;Если есть что отменять
        (progn
       (command "_.UNDO" "_B")
       (setq pt1 (list (getvar "USERR1") (getvar "USERR2")))
           (setvar "LASTPOINT" (setq pt1 (trans pt1 0 1)))
          )
        (alert "Отменять больше нечего")
        )
      )
     (t nil)
     )
 (initget "Отмени Undo _Undo Undo")
)
  ;;;Нужно собрать все в полилинию
  (if (and toPline eLast)
    (progn
     (setq ss (ssadd))
     (while (setq  eLast (entnext  eLast))(ssadd  eLast ss))
     (if (= (sslength ss) 0)(setq ss nil)) ;;; Пустой набор
     (if ss ;;;что-то есть
       (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
         (vl-cmdf "_pedit" "_Multiple" ss "" "_Join" 0 "")
         (vl-cmdf "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
         )
       )
     (setq ss nil)
      )
    )
(setvar "CMDECHO" echo)
(setvar "FILLETRAD" old_FRD)
(princ)
)

[Profan]

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

[Profan]

VVA, прими мою благодарность и благодарность моих друзей, все довольны и счастливы. В некоторый момент показалось, что твоя программа конфликтует с СПДС, но потом вяснилось, что все дело в настройках СПДС (там текущий масштаб типа линий все время сбрасывался в 1, в результате чего наши отрезки и дуги отрисовывались не так, как предполагалось).

[VVA]

Версия с восстановлением переменных USER*, отменой результатов команды за 1 раз

Код:

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

;;;********** SETI.LSP *********************************** 
;;; Программа отрисовки сети из сопряженных отрезков. 
;;; Автор Громов В.В. 2009 г. 
;;; Корректировка для опции Отмени (UNDO)
;;; 20.02.2009 Восстановление переменных, отмена команды за 1 раз
;;; Владимир Азарко (VVA) 
;;; Макрос для загрузки: 
;;; ^C^C(if (not C:СЕТИ)(load "seti"));СЕТИ; 
;;; ^C^C(if (not C:СЕТИ_ПЛ)(load "seti"));СЕТИ_ПЛ; 
;;; 

(defun C:СЕТИ_ПЛ ()(seti t)) 
(defun C:СЕТИ ()(seti nil)) 
(princ "\n Ввести в командной строке СЕТИ_ПЛ или СЕТИ") 
(defun seti ( toPline / rd pt1 pt2 ent1 ent2 U_M *error* eLast ss usr_list) 
;;;Функция seti - отрисовка сетей 
;;; Аргумент toPline = t - собирать в полилинию 
;;;          toPline = nil - нет 
  (vl-load-com) 
  ;;;Объявляем локальную ф-цию *error* 
  (defun *error* (msg / image_set) 
;;;Прерываем активную команду   
(while (> (getvar "CMDACTIVE") 0)(command)) 
(princ msg) 
(mapcar '(lambda(x)(setvar (car x)(cdr x))) usr_list)
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))    
(princ) 
  )
;;;Проверяем установки UNDO и устанавливает All control 
  (setq U_M (getvar "UNDOCTL")) 
  (cond 
    ((= (logand U_M 1) 0)(command "_.UNDO" "_All"))  ;;; Отключено UNDO 
    ((= (logand U_M 3) 3)(command "_.UNDO" "_Control" "_All")) ;;; Разрешена отмена одной операции 
    (t nil) 
  ) ;_ end of cond
(setq usr_list  (mapcar '(lambda(x)(cons x (getvar x))) '("USERR1" "USERR2" "USERS1" "USERS2" "FILLETRAD" "CMDECHO")))
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
;(setq U_M (getvar "UNDOMARKS")) ;;;VVA Запоминаем счетчик отмен UNDO
(setq U_M 0) ;;;VVA Устанавливаем счетчик отмен UNDO  
(setvar "USERS1" "")  ;;;Чистим переменные 
(setvar "USERS2" "")  ;;;Чистим переменные 
(setvar "CMDECHO" 0) 
(if toPline   
;;; Запоминаем в eLast последний примитив 
(if (null(setq eLast (entlast))) 
    (progn (entmake '((0 . "point") (10 0.0 0.0 0.0))) 
       (setq eLast (entlast))(entdel eLast))) 
  ) 
(if (not(numberp *RDS*))(setq *RDS* (getvar "FILLETRAD"))) 
(princ "\n Радиус сопряжения <")(princ  *RDS*)(princ ">: ") 
(if (setq rd (getdist))(setq *RDS* rd)(setq rd *RDS*)) 
(setvar "FILLETRAD" rd)   
(initget 7) 
(setq pt1 (getpoint "\n Начальная точка: ")) 
(initget "Отмени Undo _Undo Undo") 
(while (setq pt2 (getpoint pt1 "\nСледующая точка [Отмени] <выход>: ")) 
  (cond 
     ((listp pt2) ;_Указана точка 
      ;;;Запоминаем в переменных USERR1 и USERR2 X и Y указанной точки 
      ;;;в мировых координатах. Это позволит пользователю прозрачно менять ПСК 
      (setvar "USERR1" (car (trans pt1 1 0))) ;;;Запоминаем X точки pt1 в МСК 
      (setvar "USERR2" (cadr (trans pt1 1 0)));;;Запоминаем Y точки pt1 в МСК 
      (command "_.UNDO" "_M")                 ;;;Ставим метку UNDO 
      (command "_.LINE" "_none" pt1 "_none" pt2 "") 
      (setvar "USERS1" (getvar "USERS2"))  ;;;Перемещаем метку 2-го примитива в 1-й 
      (setvar "USERS2" (cdr(assoc 5 (entget (entlast))))) ;;Метка последнего примитива 
      (if (and (setq ent1 (handent (getvar "USERS1")))  ;;; Примитив существует 
               (setq ent2 (handent (getvar "USERS2")))  ;;; Примитив существует 
               (entget ent1)  ;;; Примитив не удален 
               (entget ent2)  ;;; Примитив не удален 
               ) 
        (vl-cmdf "_.FILLET"  ent1 ent2) 

        ;;;Сопрягаем 
        )
      (setq U_M (1+ U_M)) ;;;VVA
      (setq pt1 pt2) 
      ) 
     ((= pt2 "Undo") 
      (if (> U_M 0) ;;;Если есть что отменять 
        (progn 
       (command "_.UNDO" "_B")
       (setq U_M (1- U_M)) ;;;VVA
       (setq pt1 (list (getvar "USERR1") (getvar "USERR2"))) 
           (setvar "LASTPOINT" (setq pt1 (trans pt1 0 1))) 
          ) 
        (alert "Отменять больше нечего") 
        ) 
      ) 
     (t nil) 
     ) 
(initget "Отмени Undo _Undo Undo") 
) 
  ;;;Нужно собрать все в полилинию 
  (if (and toPline eLast) 
    (progn 
     (setq ss (ssadd)) 
     (while (setq  eLast (entnext  eLast))(ssadd  eLast ss)) 
     (if (= (sslength ss) 0)(setq ss nil)) ;;; Пустой набор 
     (if ss ;;;что-то есть 
       (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1)) 
         (vl-cmdf "_pedit" "_Multiple" ss "" "_Join" 0 "") 
         (vl-cmdf "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "") 
         ) 
       ) 
     (setq ss nil) 
      ) 
    )
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
(mapcar '(lambda(x)(setvar (car x)(cdr x))) usr_list)
(princ) 
)

[Red Nova]

VVA, Некоторые пожелания.
1. При запросе радиуса сопряжения можно добавить возможность указания радиуса курсором, сейчас можно только в ком строку вводить.
2. Если выйти из сети_пл нажатием escape, то полилиния не создастся.
3. Предположим полилиния или цепь из линий уже существуют. Было бы полезным иметь возможность обработать и уже существующие примитивы.
4. Что если нужно закрыть рисуемую полилинию (close), но так чтобы начало с концом опять таки замкнулись образуя округление? Такая функция была бы также весьма кстати.

Что-то фонтазия моя разгулялась.

[Profan]

Red Nova, попробуй вот такую программу (типа шутки):

Код:

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

 
((defun C:ПСЕТЬ ( / echo rd)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 1)
(if (not(numberp *RDS*))(setq *RDS* (getvar "FILLETRAD")))
(princ "\n Радиус сопряжения или указать 2 точки <")(princ  *RDS*)(princ ">: ")
(if (setq rd (getdist))(setq *RDS* rd)(setq rd *RDS*))
(setvar "FILLETRAD" rd)
(vl-cmdf "_PLINE")
(while (/= (logand (getvar "cmdactive") 31) 0)
(command pause)
)
(vl-cmdf "_FILLET" "_p" (entlast))
(setvar "CMDECHO" echo)
(princ)
)

[Громов Владимир]

Вот еще вариант программы:

Код:

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

 
;;;********** SETI.LSP *********************************** 
;;; Программа отрисовки сети из сопряженных отрезков. 
;;; Автор Владимир Громов (Profan) 2009 г. 
;;;-------------------------------------------
;;; Корректировка для опции Отмени (UNDO)
;;; 20.02.2009 Восстановление переменных, отмена команды за 1 раз.
;;; Владимир Азарко (VVA) 
;;;-------------------------------------------
;;; 22.02.2009
;;; Добавлена простановка длин линейных сегментов на непечатаемом слое
;;; текущим текстовым стилем.
;;; Владимир Громов (Profan)
;;;-------------------------------------------
;;; Макрос для загрузки: 
;;; ^C^C(if (not C:СЕТИ)(load "seti"));СЕТИ; 
;;; ^C^C(if (not C:СЕТИ_ПЛ)(load "seti"));СЕТИ_ПЛ; 
;;; 
(defun C:СЕТИ_ПЛ ()(seti t)) 
(defun C:СЕТИ ()(seti nil)) 
(princ "\n Ввести в командной строке СЕТИ_ПЛ или СЕТИ") 
(defun seti ( toPline / rd pt1 pt2 ent1 ent2 U_M *error* eLast ss usr_list
                        lay dlina ugol lay_dlina kod40) 
;;;Функция seti - отрисовка сетей 
;;; Аргумент toPline = t - собирать в полилинию 
;;;          toPline = nil - нет 
  (vl-load-com) 
  ;;;Объявляем локальную ф-цию *error* 
  (defun *error* (msg / image_set kod40) 
;;;Прерываем активную команду   
(while (> (getvar "CMDACTIVE") 0)(command)) 
;(princ msg) 
(princ "\n *Работа программы отменена пользователем.*")
(setq kod40 (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
      (if (= kod40 0)
      (vl-cmdf "_TEXT" "0,0" "" "0" "1")
      (vl-cmdf "_TEXT" "0,0" "0" "1")
      )
(entdel (entlast))
(mapcar '(lambda(x)(setvar (car x)(cdr x))) usr_list)
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))    
(princ) 
  )
;;;Проверяем установки UNDO и устанавливает All control 
  (setq U_M (getvar "UNDOCTL")) 
  (cond 
    ((= (logand U_M 1) 0)(command "_.UNDO" "_All"))  ;;; Отключено UNDO 
    ((= (logand U_M 3) 3)(command "_.UNDO" "_Control" "_All")) ;;; Разрешена отмена одной операции 
    (t nil) 
  ) ;_ end of cond
(setq usr_list  (mapcar '(lambda(x)(cons x (getvar x))) '("USERR1" "USERR2" "USERS1" "USERS2" 
"CLAYER" "CMDECHO")))
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
;(setq U_M (getvar "UNDOMARKS")) ;;;VVA Запоминаем счетчик отмен UNDO
(setq U_M 0) ;;;VVA Устанавливаем счетчик отмен UNDO  
(setvar "USERS1" "")  ;;;Чистим переменные 
(setvar "USERS2" "")  ;;;Чистим переменные 
(setvar "CMDECHO" 0) 
(if toPline   
;;; Запоминаем в eLast последний примитив 
(if (null(setq eLast (entlast))) 
    (progn (entmake '((0 . "point") (10 0.0 0.0 0.0))) 
       (setq eLast (entlast))(entdel eLast))) 
  ) 
(princ " Текущий радиус сопряжения = ") (princ (getvar "FILLETRAD"))  
(initget 7 "Р") 
(setq pt1 (getpoint "\n Начальная точка или [Радиус]: ")) 
(if (= pt1 "Р")
    (progn
    (princ " Радиус сопряжения <") (princ (getvar "FILLETRAD")) (princ "> или указать 2 точки: ")
    (initget 5)
    (setq rd (getdist))
    (setvar "FILLETRAD" rd) 
    (setq pt1 (getpoint "\n Начальная точка: ")) 
    )
)
(initget "Отмени Undo _Undo Undo") 
(while (setq pt2 (getpoint pt1 "\n Следующая точка [Отмени] <Enter-Выход>: ")) 
  (cond 
     ((listp pt2) ;_Указана точка 
      ;;;Запоминаем в переменных USERR1 и USERR2 X и Y указанной точки 
      ;;;в мировых координатах. Это позволит пользователю прозрачно менять ПСК 
      (setvar "USERR1" (car (trans pt1 1 0))) ;;;Запоминаем X точки pt1 в МСК 
      (setvar "USERR2" (cadr (trans pt1 1 0)));;;Запоминаем Y точки pt1 в МСК 
      (command "_.UNDO" "_M")                 ;;;Ставим метку UNDO 
      (command "_.LINE" "_none" pt1 "_none" pt2 "")
      (setq lay (vlax-get-property (vlax-ename->vla-object (entlast)) 'layer))
      (setq dlina (/ (vlax-get-property (vlax-ename->vla-object (entlast)) 'length) 1000)) ; в метрах
;      (setq dlina (vlax-get-property (vlax-ename->vla-object (entlast)) 'length))
      (setq ugol (vlax-get-property (vlax-ename->vla-object (entlast)) 'angle))
      (setq ugol (* (/ 180 pi) ugol))
      (setq lay_dlina (strcat lay "_длина"))
      (vl-cmdf "_-LAYER" "_m" lay_dlina "_c" "1" "" "_p" "_no" "" "")
 
      (setvar "USERS1" (getvar "USERS2"))  ;;;Перемещаем метку 2-го примитива в 1-й 
      (setvar "USERS2" (cdr(assoc 5 (entget (entlast))))) ;;Метка последнего примитива
      (setq kod40 (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
      (if (= kod40 0)
      (vl-cmdf "_TEXT" "_m2p" pt1 pt2 "" ugol (rtos dlina 2 0))
      (vl-cmdf "_TEXT" "_m2p" pt1 pt2 ugol (rtos dlina 2 0))
      )
      (setvar "CLAYER" lay)
      (if (and (setq ent1 (handent (getvar "USERS1")))  ;;; Примитив существует 
               (setq ent2 (handent (getvar "USERS2")))  ;;; Примитив существует 
               (entget ent1)  ;;; Примитив не удален 
               (entget ent2)  ;;; Примитив не удален 
               ) 
        (vl-cmdf "_.FILLET"  ent1 ent2) 
        ;;;Сопрягаем 
        )
      (setq U_M (1+ U_M)) ;;;VVA
      (setq pt1 pt2) 
      ) 
     ((= pt2 "Undo") 
      (if (> U_M 0) ;;;Если есть что отменять 
        (progn 
       (command "_.UNDO" "_B")
       (setq U_M (1- U_M)) ;;;VVA
       (setq pt1 (list (getvar "USERR1") (getvar "USERR2"))) 
           (setvar "LASTPOINT" (setq pt1 (trans pt1 0 1))) 
          ) 
        (alert "Отменять больше нечего") 
        ) 
      ) 
     (t nil) 
     ) 
(initget "Отмени Undo _Undo Undo") 
) 
  ;;;Нужно собрать все в полилинию 
  (if (and toPline eLast) 
    (progn 
     (setq ss (ssadd)) 
     (while (setq  eLast (entnext  eLast))(ssadd  eLast ss)) 
     (if (= (sslength ss) 0)(setq ss nil)) ;;; Пустой набор 
     (if ss ;;;что-то есть 
       (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1)) 
         (vl-cmdf "_pedit" "_Multiple" ss "" "_Join" 0 "") 
         (vl-cmdf "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "") 
         ) 
       ) 
     (setq ss nil) 
      ) 
    )
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
(mapcar '(lambda(x)(setvar (car x)(cdr x))) usr_list)
(vl-cmdf "_TEXT" "0,0" "" "0" "1")
(entdel (entlast))
(princ) 
)

VVA, не понятно мне наличие имени переменной image_set в функции *error*. Откуда она взялась? И можно ли убрать возможность "прозрачно менять ПСК"?

[Red Nova]

Profan,
Close и ввод радиуса - самое то, но, конечно же, вариант округления real time от VVA куда эффектнее.

[Profan]

...но, конечно же, вариант округления real time от VVA куда эффектнее.

Какое еще округление?
Если ты про сопряжение, то посмотри, с чего тема начиналась.
И вообще, первую программу я сочинил в таком виде (сопряженные отрезки) именно из-за эффектности отрисовки. Если бы конечной целью было бы просто получение трассы из отрезков и дуг, то ничего проще не было бы расчленить полилинию, полученную в программе, приведенную в сообщении 23 и все. Ведь даже возможность отмены отрисованных сегментов уже присутствует в команде "_PLINE". Странно, что никто не предложил такой простой способ - фактически решение обратной задачи.

[Red Nova]

Какое еще округление? Если ты про сопряжение, ...

Да простит меня препод начерталки за сие недоумение.

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

Дык ясен перец. Эдакую прожку и я осилил бы написать (уроки от VVA все же не прошли даром). Но этот простой вариант с #23 имеет свои маленькие плюсы. И было бы неплохо перенять их и добавить в "правильный" вариант.

[Profan]

Red Nova, я раньше написал, что программа была написана по просьбе слаботочников. Я предлагал им сразу оперировать полилинией при отрисовке трасс сетей. Но... не работают они с полилинией. Поэтому дополнительная возможность превращения массива отрезков и дуг в полилинию является факультативной. Однако, чувствую я, что им придется перейти на полилинию, когда я вплотную приступлю к составлению программ для проектирования телевизионного кабельного вещания с учетом затухания сигнала в кабеле в зависимости от длины кабеля. Задача, как видишь, специализированная. Если же тебе хочется приспособить данные программы для своих нужд, то, может, стоит создать соответствующую тему со своими пожеланиями. Хотя, можно ведь замкнуть и выполнить сопряжение первого и последнего сегментов получившейся полилинии вручную после выхода из программы. Можно, конечно, и здесь переделать программу, но у меня была цель сделать программу с минимальным количеством запросов и в последнем варианте дополнительные запросы вообще отсутствуют, если радиус сопряжения устраивает проектировщика. Именно из-за этого я убрал возвращение переменной FILLETRAD к начальному состоянию. Есть еще пока не проявившаяся проблема. У слаботочников может быть много линий связи, а слой для простановки длины сегментов образуется добавлением суффикса "_длина" к соответствующему имени слоя. Получается, например, такое имя слоя: "СС_пожар_длина". Так вот, боюсь, что слаботочникам может не понравится нагромождение новых слоев и придется программу как-то корректировать. Но в направлении удобства именно слаботочников, а не универсализации программы для любых нужд. Но это мои предпочтения, если VVA или другие товарищи пойдут тебе навстречу - ничего плохого не случится.

[Red Nova]

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

Ухожу ухожу
................
Offtop: И все таки она вертится

[VVA]

Начнем не по порядку

VVA, не понятно мне наличие имени переменной image_set в функции *error*. Откуда она взялась? И можно ли убрать возможность "прозрачно менять ПСК"?

1. image_set. когда копировал с другого места забыл убрать
2. прозрачно менять ПСК. Нужно. Пользователь прозрачно менять не сможет. Прозрачно менять сможешь ты, если захочешь.

VVA, Некоторые пожелания. 1. При запросе радиуса сопряжения можно добавить возможность указания радиуса курсором, сейчас можно только в ком строку вводить. 2. Если выйти из сети_пл нажатием escape, то полилиния не создастся. 3. Предположим полилиния или цепь из линий уже существуют. Было бы полезным иметь возможность обработать и уже существующие примитивы. 4. Что если нужно закрыть рисуемую полилинию (close), но так чтобы начало с концом опять таки замкнулись образуя округление? Такая функция была бы также весьма кстати.

1. Это было уже в коде из #21
2. Решено. Выделено красным.
3. Pedit с опцией "Join" и Fillet с опцией "Polyline"
4. Добавлена.

Код:

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

;;;********** SETI.LSP *********************************** 
;;; Программа отрисовки сети из сопряженных отрезков. 
;;; Автор Громов В.В. 2009 г. 
;;; Корректировка для опции Отмени (UNDO)
;;; 20.02.2009 Восстановление переменных, отмена команды за 1 раз
;;; Владимир Азарко (VVA) 
;;; Макрос для загрузки: 
;;; ^C^C(if (not C:СЕТИ)(load "seti"));СЕТИ; 
;;; ^C^C(if (not C:СЕТИ_ПЛ)(load "seti"));СЕТИ_ПЛ; 
;;; 
(defun C:СЕТИ_ПЛ () (seti t))
(defun C:СЕТИ () (seti nil))
(princ "\n Ввести в командной строке СЕТИ_ПЛ или СЕТИ")
(defun seti (toPline / rd pt1 pt2 ent1 ent2 U_M *error* eLast ss
      usr_list pts)
;;;Функция seti - отрисовка сетей 
;;; Аргумент toPline = t - собирать в полилинию 
;;;          toPline = nil - нет 
  (vl-load-com)
;;;Объявляем локальную ф-цию *error* 
  (defun *error* (msg)
;;;Прерываем активную команду   
    (while (> (getvar "CMDACTIVE") 0) (command))
    (princ msg)
    (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
    (vla-EndUndoMark
      (vla-get-activedocument (vlax-get-acad-object))
    )
    (princ)
  )
;;;Проверяем установки UNDO и устанавливает All control 
  (setq U_M (getvar "UNDOCTL"))
  (cond
    ((= (logand U_M 1) 0) ;_ Отключено UNDO
     (command "_.UNDO" "_All")
     )
    ((= (logand U_M 3) 3) ;_ Разрешена отмена одной операции
     (command "_.UNDO" "_Control" "_All") 
     )
    (t nil)
  ) ;_ end of cond
  (setq usr_list (mapcar '(lambda (x) (cons x (getvar x)))
    '("USERR1"  "USERR2"      "USERS1"
      "USERS2"  "FILLETRAD"   "CMDECHO"
     )
   )
  )
  (vla-StartUndoMark
    (vla-get-activedocument (vlax-get-acad-object))
  )
  (setq U_M 0) ;_VVA Устанавливаем счетчик отмен UNDO  
  (setvar "USERS1" "") ;_Чистим переменные 
  (setvar "USERS2" "") ;_Чистим переменные 
  (setvar "CMDECHO" 0)
  (if toPline
;;; Запоминаем в eLast последний примитив 
    (if (null (setq eLast (entlast)))
      (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
      (setq eLast (entlast))
      (entdel eLast)
      )
    )
  )
  (if (not (numberp *RDS*))
    (setq *RDS* (getvar "FILLETRAD"))
  )
  (setvar "FILLETRAD" *RDS*)
;;;Ставим ловушку на случай нажатия ESC
  (VL-CATCH-ALL-APPLY
    '(LAMBDA () ;_---> Начало
       (initget 7)
       (setq pt1 (getpoint "\n Начальная точка: "))
       (setq pts pt1)
       (initget "Замкни Радиус Отмени Undo _Close R Undo Undo")
       (while
  (and pts
       (or (princ "\nРадиус <") (princ *RDS*) (princ "> ") t)
       (setq
  pt2 (getpoint
        pt1
        "Следующая точка [Радиус/Замкни/Отмени] <выход>: "
      )
       )
  )
   (if (= pt2 "Close") ;_Выбрана опция замкни
     (progn
       (setq pt2 pts ;_ Начало в pt2
      pts nil ;_ pts в nil чтобы прервать цикл
       )
     )
   )
   (cond
     ((= pt2 "R") ;_ Выбрана опция радиус
      (princ "\n Радиус сопряжения <")
      (princ *RDS*)
      (princ ">: ")
      (if (setq rd (getdist))
        (setq *RDS* rd)
        (setq rd *RDS*)
      )
      (setvar "FILLETRAD" rd)
     )
     ((listp pt2) ;_Указана точка 
;;;Запоминаем в переменных USERR1 и USERR2 X и Y указанной точки 
;;;в мировых координатах.
      (setvar "USERR1" (car (trans pt1 1 0))) ;_Запоминаем X точки pt1 в МСК 
      (setvar "USERR2" (cadr (trans pt1 1 0)));_Запоминаем Y точки pt1 в МСК 
      (command "_.UNDO" "_M") ;_Ставим метку UNDO 
      (command "_.LINE" "_none" pt1 "_none" pt2 "")
      (setvar "USERS1" (getvar "USERS2")) ;_Перемещаем метку 2-го примитива в 1-й 
      (setvar "USERS2" (cdr (assoc 5 (entget (entlast))))) ;_Метка последнего примитива 
      (if (and (setq ent1 (handent (getvar "USERS1"))) ;_ Примитив существует 
        (setq ent2 (handent (getvar "USERS2"))) ;_ Примитив существует 
        (entget ent1) ;_ Примитив не удален 
        (entget ent2) ;_ Примитив не удален 
   )
        (vl-cmdf "_.FILLET" ent1 ent2) ;_Сопрягаем 
      )
      (setq U_M (1+ U_M))
      (setq pt1 pt2)
     )
     ((= pt2 "Undo")
      (if (> U_M 0) ;_ Если есть что отменять 
        (progn
   (command "_.UNDO" "_B")
   (setq U_M (1- U_M))
   (setq pt1 (list (getvar "USERR1") (getvar "USERR2")))
   (setvar "LASTPOINT" (setq pt1 (trans pt1 0 1)))
        )
        (alert "Отменять больше нечего")
      )
     )
     (t nil)
   )
   (initget "Замкни Радиус Отмени Undo _Close R Undo Undo")
       )
     )
  ) ;_<--- Конец
;;;Нужно собрать все в полилинию 
  (if (and toPline eLast)
    (progn
      (setq ss (ssadd))
      (while (setq eLast (entnext eLast)) (ssadd eLast ss))
      (if (= (sslength ss) 0);_ Пустой набор 
 (setq ss nil)
      )
      (if ss  ;_ что-то есть 
 (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
   (vl-cmdf "_pedit" "_Multiple" ss "" "_Join" 0 "")
   (vl-cmdf "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
 )
      )
      (setq ss nil)
    )
  )
  (vla-EndUndoMark
    (vla-get-activedocument (vlax-get-acad-object))
  )
  (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
  (princ)
)

[Red Nova]

VVA,
У меня пока нормально не работает, возможно это из за русских терминов [Радиус/Замкни/Отмени], такое у меня частенько бывает. Радиус не вводится теперь ни с клавы ни с экрана, замыкание тоже не реагирует. На сколько я понял радиус должен вводится выбором в подменю. По моему субъективному мнению вариант когда радиус запрашивался в начале удобнее.
Offtop: Profan, что-то не получается покинуть твою тему

[Profan]

Вариант с преобразованием отрезков и дуг в отдельные сегменты полилиний

Код:

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

 
;********** SETI_PL.LSP *****************************************
; Программа отрисовки сети из сопряженных отрезков 
; с последующим преобразованием в отдельные сегменты полилиний.
; Автор Громов Владимир aka Profan 2010 г.
; Макрос для загрузки:
; ^C^C(if (not C:СЕТИ_ПЛ) (load "seti_pl")) СЕТИ_ПЛ
;
(defun C:СЕТИ_ПЛ ( / echo rd pt1 pt2 pt3 ent1 ent2 ss wdt1 wdt)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq ss (ssadd))
(if (null rds) (setq rds "0"))
(princ (strcat "\n Радиус сопряжения <" rds ">: "))
(setq rd (getint))
(if (= rd nil) (setq rd (atoi rds)) (setq rds (itoa rd)))
(vl-cmdf "_FILLET" "_r" rd)
(initget 7)
(setq pt1 (getpoint "\n Начальная точка: "))
(initget 7)
(setq pt2 (getpoint pt1 "\n Вторая точка: "))
(vl-cmdf "_LINE" pt1 pt2 "")
(setq ent1 (entlast))
(ssadd ent1 ss)
(setq pt3 (getpoint pt2 "\n Следующая точка <Enter-Конец>: "))
(if pt3
(progn
(vl-cmdf "_LINE" pt2 pt3 "")
(setq ent2 (entlast))
(ssadd ent2 ss)
(vl-cmdf "_fillet" ent1 ent2)
(ssadd (entlast) ss)
(while pt3
   (setq pt2 pt3)
   (setq ent1 ent2)
   (setq pt3 (getpoint pt2 "\n Следующая точка <Enter-Конец> "))
   (if pt3
       (progn
       (vl-cmdf "_LINE" pt2 pt3 "")
       (setq ent2 (entlast))
       (ssadd ent2 ss)
       (vl-cmdf "_fillet" ent1 ent2)
       (ssadd (entlast) ss)
       )
       (princ "\n Конец.")
   )
)
)
)
(setq wdt1 (getvar "PLINEWID"))
      (princ "\n Ширина сегментов полилинии <") (princ wdt1) (princ ">: ")
      (setq wdt (getreal))
      (if (= wdt nil) (setq wdt wdt1))
(cond
((= (getvar "PEDITACCEPT") 0) (vl-cmdf "_PEDIT" "_m" ss "" "_yes" "_w" wdt ""))
((= (getvar "PEDITACCEPT") 1) (vl-cmdf "_PEDIT" "_m" ss "" "_w" wdt ""))
)
(setvar "CMDECHO" echo)
(princ)
)
(princ "\n Ввести в командной строке СЕТИ_ПЛ")

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

peditaccept не проверяешь...

[Profan]

Сообщение от Кулик Алексей aka kpblc peditaccept не проверяешь...

А зачем ее проверять, если отрисовка изначально выполняется исключительно отрезками?
Хотя, ты прав. У продвинутых пользователей, таких, как Vova, например, peditaccept вполне может оказаться равной 1 (для упрощения макросов). Это в моей конторе пользователи могут даже не подозревать о такой переменной. Подправлю.

[Basawur]

Очень даже не плохо!
Лично мне больше глянулся вариант от VVA пост #21.
Ещё бы "Подобие" и "Замкнуть" как-нибудь прикрутить, было бы симпатичнее.

[Jonas]

Уважаемые аксакалы. Программа заинтересовала возможностью отрисовки траектории для последующего выдавливания при 3Д моделировании. В машиностроении нет длинных трасс (во всяком случае в моей практике), но приходиться моделировать линии гидропривода, пневмопривода и электрооборудования. Для этого лучше подходит отриовка с созданием полилинии но есть проблема, при отрисовке по всем осям x,y и z, в конце операции исчезает часть трассы.

Нельзя ли как то это исправить?
И еще нельзя ли в процессе отрисовки менять радиус сопряжения?

[LastGraff]

Сенкс, очень помогло...

[ivsib]

Уважаемые разработчики мегакласных штук а нельзя ли к этому лиспу добавить несколько функций.
Хотелось бы чтобы в конце итоговая полилиния оффсетилась (_offset) на определенное расстояние и разбивалась на отрезки (_explode). А исходная полилиния удалялась.
Ради этого даже начал изучать LISP. И уже получилось сделать подобие и удалить исходную полилинию, но разбить подобную полилинию на отрезки никак не могу.
Помогите пожалуйста.
Заранее спасибо!

[Nike]

Сообщение от ivsib но разбить подобную полилинию на отрезки никак не могу.

(command "_explode" "_l")

[ivsib]

Так не получается или я куда то не туда добавляю команду
Приведу текст лиспа. Красным выделено то что я добавил.
Если без строки (command "_explode" "_L") то работает

Код:

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

;;;********** SETI.LSP ***********************************
;;; Программа отрисовки сети из сопряженных отрезков.
;;; Автор Громов В.В. 2009 г.
;;; Корректировка для опции Отмени (UNDO)
;;; 20.02.2009 Восстановление переменных, отмена команды за 1 раз
;;; Владимир Азарко (VVA)
;;; Макрос для загрузки:
;;; ^C^C(if (not C:СЕТИ)(load "seti"));СЕТИ;
;;; ^C^C(if (not C:СЕТИ_ПЛ)(load "seti"));СЕТИ_ПЛ;
;;;

(defun C:СЕТИ_ПЛ ()(seti t))
(defun C:СЕТИ ()(seti nil))
(princ "\n Ввести в командной строке СЕТИ_ПЛ или СЕТИ")
(defun seti ( toPline / rd pt1 pt2 ent1 ent2 U_M *error* eLast ss usr_list)
;;;Функция seti - отрисовка сетей
;;; Аргумент toPline = t - собирать в полилинию
;;;          toPline = nil - нет
  (vl-load-com)
  ;;;Объявляем локальную ф-цию *error*
  (defun *error* (msg / image_set)
;;;Прерываем активную команду  
(while (> (getvar "CMDACTIVE") 0)(command))
(princ msg)
(mapcar '(lambda(x)(setvar (car x)(cdr x))) usr_list)
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))    
(princ)
  )
;;;Проверяем установки UNDO и устанавливает All control
  (setq U_M (getvar "UNDOCTL"))
  (cond
    ((= (logand U_M 1) 0)(command "_.UNDO" "_All"))  ;;; Отключено UNDO
    ((= (logand U_M 3) 3)(command "_.UNDO" "_Control" "_All")) ;;; Разрешена отмена одной операции
    (t nil)
  ) ;_ end of cond
(setq usr_list  (mapcar '(lambda(x)(cons x (getvar x))) '("USERR1" "USERR2" "USERS1" "USERS2" "FILLETRAD" "CMDECHO")))
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
;(setq U_M (getvar "UNDOMARKS")) ;;;VVA Запоминаем счетчик отмен UNDO
(setq U_M 0) ;;;VVA Устанавливаем счетчик отмен UNDO  
(setvar "USERS1" "")  ;;;Чистим переменные
(setvar "USERS2" "")  ;;;Чистим переменные
(setvar "CMDECHO" 0)
(if toPline  
;;; Запоминаем в eLast последний примитив
(if (null(setq eLast (entlast)))
    (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
       (setq eLast (entlast))(entdel eLast)))
  )
(if (not(numberp *RDS*))(setq *RDS* (getvar "FILLETRAD")))
(princ "\n Радиус сопряжения <")(princ  *RDS*)(princ ">: ")
(if (setq rd (getdist))(setq *RDS* rd)(setq rd *RDS*))
(setvar "FILLETRAD" rd)  
(initget 7)
(setq pt1 (getpoint "\n Начальная точка: "))
(initget "Отмени Undo _Undo Undo")
(while (setq pt2 (getpoint pt1 "\nСледующая точка [Отмени] <выход>: "))
  (cond
     ((listp pt2) ;_Указана точка
      ;;;Запоминаем в переменных USERR1 и USERR2 X и Y указанной точки
      ;;;в мировых координатах. Это позволит пользователю прозрачно менять ПСК
      (setvar "USERR1" (car (trans pt1 1 0))) ;;;Запоминаем X точки pt1 в МСК
      (setvar "USERR2" (cadr (trans pt1 1 0)));;;Запоминаем Y точки pt1 в МСК
      (command "_.UNDO" "_M")                 ;;;Ставим метку UNDO
      (command "_.LINE" "_none" pt1 "_none" pt2 "")
      (setvar "USERS1" (getvar "USERS2"))  ;;;Перемещаем метку 2-го примитива в 1-й
      (setvar "USERS2" (cdr(assoc 5 (entget (entlast))))) ;;Метка последнего примитива
      (if (and (setq ent1 (handent (getvar "USERS1")))  ;;; Примитив существует
               (setq ent2 (handent (getvar "USERS2")))  ;;; Примитив существует
               (entget ent1)  ;;; Примитив не удален
               (entget ent2)  ;;; Примитив не удален
               )
        (vl-cmdf "_.FILLET"  ent1 ent2)

        ;;;Сопрягаем
        )
      (setq U_M (1+ U_M)) ;;;VVA
      (setq pt1 pt2)
      )
     ((= pt2 "Undo")
      (if (> U_M 0) ;;;Если есть что отменять
        (progn
       (command "_.UNDO" "_B")
       (setq U_M (1- U_M)) ;;;VVA
       (setq pt1 (list (getvar "USERR1") (getvar "USERR2")))
           (setvar "LASTPOINT" (setq pt1 (trans pt1 0 1)))
          )
        (alert "Отменять больше нечего")
        )
      )
     (t nil)
     )
(initget "Отмени Undo _Undo Undo")
)
  ;;;Нужно собрать все в полилинию
  (if (and toPline eLast)
    (progn
     (setq ss (ssadd))
     (while (setq  eLast (entnext  eLast))(ssadd  eLast ss))
     (if (= (sslength ss) 0)(setq ss nil)) ;;; Пустой набор
     (if ss ;;;что-то есть
       (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
         (vl-cmdf "_pedit" "_Multiple" ss "" "_Join" 0 "")
         (vl-cmdf "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
         )
       )
(command "_offset" 90 (entlast))
(entdel (entlast))
(command "_explode" "_L")
     (setq ss nil)
      )
    )
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
(mapcar '(lambda(x)(setvar (car x)(cdr x))) usr_list)
(princ)
)

[Profan]

Удалено