Помогу бесплатно разработать любую программу на autolisp.

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

Код:

;;;Версия 03  17.06.2019
 
;;;(defun *error* (errmsg)  Удалить функцию глобального переопределения *error* !
;;; (setvar "osmode" osmode_old)(princ)
;;;)
 
(defun funError (errmsg)
 (setq *error* errorOLD)
 (setvar "osmode" osmode_old)
 (prompt "\nПовторний запуск программы-  11")
 (princ)
)
;;;----------------------------------------------------------------
(defun C:11 (/)
 (setvar "cmdecho" 0)(vl-load-com)
 
  (setq errorOLD *error*);  Добавленно в программу
  (setq *error* funError);  Добавленно в программу
 
 (setq osmode_old (getvar "osmode"))
  (While
   (setvar "osmode" 0)
   (setq Primitiv (car(entsel "\nВыберите мышкой текст-отметку  Выход-Esc  ")))
   (setq PrimitivDXF (entget Primitiv))
    (if (or(= (cdr(assoc 0 PrimitivDXF)) "TEXT")(= (cdr(assoc 0 PrimitivDXF)) "MTEXT"))
     (progn
      (setq Z$ (cdr(assoc 1 PrimitivDXF)))
     (if (wcmatch Z$ "#*")
       (progn
        (if (vl-string-position 44 Z$ )(setq Z$(vl-string-subst "." "," Z$)))
        (setq Z(atof Z$))
        (if(wcmatch Z$ "*@*")(command "_change" Primitiv "" "_P" "_C" 1 ""))
        (setvar "osmode" osmode_old)
        (setq XYmat (getpoint "\nУкажите мышкой точку : "))
        (setvar "osmode" 0)
        (command "_point" (list (car XYmat)(cadr XYmat)Z))
        (command "_change" Primitiv "" "_P" "_LA" (getvar "CLAYER") "")
       )
       (alert "\nВыбран текст без отметки!!!")
     )
    )
    (alert "\nЭто не текст!!!")
   )
 )
)
(C:11)

 

ivsem, Нет, "error" я не заметил, а поменял "osmode" принудительно - перед выполнением макроса включил только нужные мне привязки, а после выполнения - вернул старые.

Код:

(defun C:12 (/)
  (setvar "cmdecho" 0)(vl-load-com)
  (setq osmode_old (getvar "osmode"))
   (While
    (setvar "osmode" 4096)
    (setq Primitiv (car(entsel "\nВыберите мышкой текст-отметку  Выход-Esc  ")))
   (setq PrimitivDXF (entget Primitiv))
     (if (or(= (cdr(assoc 0 PrimitivDXF)) "TEXT")(= (cdr(assoc 0 PrimitivDXF)) "MTEXT"))
     (progn
       (setq Z$ (cdr(assoc 1 PrimitivDXF)))
       (if (wcmatch Z$ "#*")
         (progn
        (if (vl-string-position 44 Z$ )(setq Z$(vl-string-subst "." "," Z$)))
       (setq Z(atof Z$))
         (if(wcmatch Z$ "*@*")(command "_change" Primitiv "" "_P" "_C" 1 ""))
         ;(setvar "osmode" osmode_old)
(setvar "osmode" 37)
         (setq XYmat (getpoint "\nУкажите мышкой точку : "))
         (setvar "osmode" 4096)
         (command "_point" (list (car XYmat)(cadr XYmat)Z))
         (command "_change" Primitiv "" "_P" "_LA" (getvar "CLAYER") "")
         )
         (alert "\nВыбран текст без отметки!!!")
       )  
     )
     (alert "\nЭто не текст!!!")
     ) 
  )
)
(C:12)

 

Давно назревала просьба: В прилагаемом ДВГ линейный(параллельный)размер (проект\факт) Как заставить автокад, чтобы он красил числитель и знаменатель в разные цвета. Я обожаю черно белые чертежи, но все таки заставили сдавать ИД в цвете.

--- Сообщения объединены, 22 июн 2019, Оригинальное время сообщения: 22 июн 2019 ---

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

 

Антон, ТочностиНЕТ хорошая штука, но, можно и так пользоваться.

 

Qvinto, сделал так: двойной клик по размеру, который создан "Точности нет" далее ПКМ- "преобразовать размер в текст", далее можно разными цветами полученный Мтекст покрасить.

 

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

 

Какова конечная цель программы? Сформировать ведомость координат проекций точек на кривую?

 

Нет) Это будет часть алгоритма, который определяет с какой стороны от сплайна находится точка.

 

Код:

(vl-load-com)
   (setq PrimitivSpline (car(entsel "\nВыберите сплайн" )))
   (setq PrimitivPoint (car(entsel "\nВыберите точку" )))
   (setq XYmatPoint (cdr(assoc 10 (entget PrimitivPoint))))
   (setq XYmatPointOnSpline  (vlax-curve-getClosestPointTo (vlax-ename->vla-object PrimitivSpline) XYmatPoint t))
   (command "_line" XYmatPoint XYmatPointOnSpline "")

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

 

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

 

Steinar, может через параметр кривой vlax-curve-getParamAtPoint искать некую 3-ю точку, скажем +0.1 или -0.1 к параметру точки полученной через GetClosestPointTo, затем проверять угол этих трех точек на равенство 90гр.. единственное надо подумать над условием в начале и конце кривой + или -

 

Код:

(vl-load-com)
 (setq PrimitivSpline (car(entsel "\nВыберите сплайн" )))
 (setq VlaPrimitivSpline (vlax-ename->vla-object PrimitivSpline))
 (setq PrimitivPoint (car(entsel "\nВыберите точку" )))
 (setq XYmatPoint (cdr(assoc 10 (entget PrimitivPoint))))
 (setq XYmatPointOnSpline(vlax-curve-getClosestPointTo VlaPrimitivSpline XYmatPoint))
 (setq XYmatStartPointOnSpline (vlax-curve-getStartPoint VlaPrimitivSpline))
 (setq XYmatEndPointOnSpline (vlax-curve-getEndPoint VlaPrimitivSpline))
 (if (or(equal XYmatPointOnSpline XYmatStartPointOnSpline)(equal XYmatPointOnSpline XYmatEndPointOnSpline))
      (alert "Точка за пределом сплайна")
      (command "_line" XYmatPoint XYmatPointOnSpline "")
 )

Вероятность того, что проекция случайной точки попадет точно на конец-начало сплайна практически не вероятна.
Но можно ввести анализ и на такой "невероятный" случай.

 

Код:

 (vl-load-com)
 (setq PrimitivSpline (car(entsel "\nВыберите сплайн" )))
 (setq VlaPrimitivSpline (vlax-ename->vla-object PrimitivSpline))
 (prompt "\nВыберите точки")
 (setq NaborPrimitivPoint (ssget '((0 . "POINT"))))
 (setq N 0)
 (repeat (sslength NaborPrimitivPoint)
  (setq PrimitivPoint (ssname NaborPrimitivPoint N))
  (setq XYmatPoint (cdr(assoc 10 (entget PrimitivPoint))))
  (setq XYmatPointOnSpline(vlax-curve-getClosestPointTo VlaPrimitivSpline XYmatPoint))
  (setq XYmatStartPointOnSpline (vlax-curve-getStartPoint VlaPrimitivSpline))
  (setq XYmatEndPointOnSpline (vlax-curve-getEndPoint VlaPrimitivSpline))
   (if (not(or(equal XYmatPointOnSpline XYmatStartPointOnSpline 0.000000001)
              (equal XYmatPointOnSpline XYmatEndPointOnSpline 0.000000001)))
     (command "_line" XYmatPoint XYmatPointOnSpline "")
   )
   (setq N (1+ N))
 )

 

Добавил разделение точек на правые и левые по ходу сплайна. Слева-синие, справа-красные.

Код:

(vl-load-com)
 (setq PrimitivSpline (car(entsel "\nВыберите сплайн" )))
 (setq VlaPrimitivSpline (vlax-ename->vla-object PrimitivSpline))
 (prompt "\nВыберите точки")
 (setq NaborPrimitivPoint (ssget '((0 . "POINT"))))
 (setq N 0)
 (repeat (sslength NaborPrimitivPoint)
  (setq PrimitivPoint (ssname NaborPrimitivPoint N))
  (setq XYmatPoint (cdr(assoc 10 (entget PrimitivPoint))))
  (setq XYmatPointOnSpline(vlax-curve-getClosestPointTo VlaPrimitivSpline XYmatPoint))
  (setq XYmatStartPointOnSpline (vlax-curve-getStartPoint VlaPrimitivSpline))
  (setq XYmatEndPointOnSpline (vlax-curve-getEndPoint VlaPrimitivSpline))
   (if (not(or(equal XYmatPointOnSpline XYmatStartPointOnSpline 0.000000001)
              (equal XYmatPointOnSpline XYmatEndPointOnSpline 0.000000001)))
     (progn
       (command "_line" XYmatPoint XYmatPointOnSpline "")
       (setq AngleToPoint(angle XYmatPointOnSpline XYmatPoint))
       (setq FirstDerivSpline(vlax-curve-getFirstDeriv VlaPrimitivSpline
(vlax-curve-getParamAtPoint VlaPrimitivSpline XYmatPointOnSpline)))
       (setq AngleSpline (Angle (list 0 0 0) FirstDerivSpline))
      (setq aaa (- AngleToPoint AngleSpline))
       (if (< aaa 0.0)(setq aaa (+ aaa (* PI 2))))
       (if (> aaa (* PI 2))(setq aaa (- aaa (* PI 2))))
       (if (and(> aaa 0.0)(< aaa PI))
 (progn
   (command "_color" 5)
   (command "_circle" XYmatPoint 6)
   (command "_change" PrimitivPoint "" "_P" "_C" 5 "")
 )
 (progn
   (command "_color" 1)
   (command "_circle" XYmatPoint 10)
   (command "_change" PrimitivPoint "" "_P" "_C" 1 "")
 )
      )
     )
   )
   (setq N (1+ N))
 )

 

ivsem, сейчас протестирую...

--- Сообщения объединены, 1 июл 2019, Оригинальное время сообщения: 1 июл 2019 ---

Сработало, но не для всех точек:

Дальше я сам постараюсь разобраться. Спасибо!

 

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

 

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

 

ivsem, добрый день. Увидел кривые и вспомнил старую задачу, решения которой у меня до сих пор нет.По возможности прошу помочь. Суть просьбы(приложил двж):
Есть синяя полилиния состоящая из прямых отрезков и дуг (ось трассы).
Есть полилиния "хорда" А-Б фиксированной заданной длины L (в примере 300м, это расстояние прямой видимости из точки А)
Необходимо построить множество таких "хорд"с шагом n, при этом точки А и Б должны лежать на оси трассы и эти "хорды" должны иметь заданную длину. В результате получится коридор с шагом n(в примере 5м), сформированный точками пересечения "хорд" между собой.
Данный коридор позволяет оценить видимость на участке автомобильной дороги и выявить помехи/ назначить мероприятия по обеспечению видимости в плане.

***
Спасибо заранее!!

 

Тестируйте. Повторный запуск программы- набрать число 11 и нажать Enter.

 

Спасибо огромное!!! попробовал на полилинии более сложной конфигурации, сплайне, все отрабатывает но в определенный момент делает пропуски (во вложении) похоже что это связано с длиной хорды и небольшим расстоянием между "витками"
***
с помощью команды акада "контур" можно по хордам получить искомую линию в пару кликов