[Иван]

ДД!МОжет есть у кого-нить лисп для черчения бергшрихов.Имеем кучу горизонталей,к которым надо прорисовать бергшрихи.
Ориентировочно вот такой:
1.Выбор обекта(ов) (линии,сплайны)
2.размер бергштриха
3.Указать направление
Отрисовка из центра объекта

Заранее сенгс откликнувшимся)))

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

Отрисовка из центра - это круто. Для приколу: найди центры представленых примитивов.
[ATTACH]1163065045.dwg[/ATTACH]

[Иван]

Сообщение от kpblc Отрисовка из центра - это круто. Для приколу: найди центры представленых примитивов. [ATTACH]1163065045.dwg[/ATTACH]

У каждого объекта есть центр.Сложные объекты состоят из нескольких простых.Соответсвенно у полилинии и сплайна нужно несколько бергштрихов.Ну да черт с ними со сложными,хотя бы к линиям из центра.А для сложных - через точку вставки

[DEM]

А может все же не из цента, а парпандекулярно объектам

[Иван]

Сообщение от DEM А может все же не из цента, а парпандекулярно объектам

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

[Zouss]

на конкурс за звание примитивнейшей проги

Код:

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

(defun c:m1 (/)					       ;обзовите запускающую команду как хотите
  (berg)
) ;_  defun

(defun berg (/)
  (setq	ss (ssget) ;_  ssget
	n  (sslength ss)
	i  0
	l  (getdist "задайте дистанцию между бергштрихами")
  ) ;_  setq
  (repeat n
    (setq ssi (ssadd (ssname ss i))
	  i   (1+ i)
    ) ;_  setq
    (command "MEASURE" ssi "BLOCK" "BERG" "Y" l)
  ) ;_  repeat
) ;_  defun

в файле должен присутствовать блок с именем BERG (прилагается ниже)

изменение размера бергштрихов с помощью редактирования масштаба вставки блоков, изменение ориентации бергштрихов с помощью изменения знака масштаба вставки по оси Y (положительный/отрицательный/средний)
[ATTACH]1163084034.dwg[/ATTACH]

[Иван]

Спасибо за отклик ,только мне нужна не отрисовка забора,а именно бергштрих для горизонтали.Последовательность действий такая:
1.Выделите объект(ы)
2.Укажите размер бергштриха
3.Укажите направление бергштриха
И по итогу все горизонтали(в данном случае,просто Line) обзаводятся палочками той длины,которую я укажу и того направления,куда я тыкну.причем появиться они должны из центра этих линий.

P/S А Ваш лисп-это имитация команды Меasure :wink:

[DEM]

Блин скачайте себе СПДС.
Там есть функция Сварка и работает она с плилиниями.
Правда штрихи одинаковые но вам пойдеть Я думаю.

[Иван]

Сообщение от DEM Блин скачайте себе СПДС. Там есть функция Сварка и работает она с плилиниями. Правда штрихи одинаковые но вам пойдеть Я думаю.

Что это?Да и если одинаковые,то не подойдет.Да и нужно указание направления и именно из центра

[ShaggyDoc]

Иван, зачем зацикливаться на каком-то мифическом "центре", тем более, не зная, что такое СПДС?

Не надо топографу ничего знать ни про какие центры. Думаешь первому пришла идея рисовать берг-штрихи программно?

А делаются они именно так, как показал Zouss - используя разбивку примитива блоком. И ничего, вызывающего улыбку, в этом нет. Все дополнительные программы, в конце концов являются "имитациями" команд и их последовательностей.

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

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

Штрихи рисуются не "из центра", а по нормали к линиям.

Если же не устраивает "имитация", можно поступить просто - изучить ObjectARX, создать свой объект "ГОРИЗОНТАЛЬ", который сам будет рисоваться со штрихами, надписями отметок, и от "центра".

[Krieger]

Сообщение от ShaggyDoc можно поступить просто - изучить ObjectARX

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

[DEM]

Хм ну сделайте вы тогда тип линии свой.
Отрезки с дугами преобразуйте в единую полилинию с помощью Экспрес Тулс.

[Krieger]

Я хэть и не топограф, но по опыту работы со спортивными картами, надо что-то типа такого: (см.картинку)
Как тут типом линии или одной нормальностью обойтись?
[ATTACH]1163138855.gif[/ATTACH]

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

> Krieger : достаточно давно была тема по поводу получения попиндикуляру к кривой от указанной точки, там вроде как было и лисповое решение.

[Иван]

Я понимаю,что лисп-это всего навсего последовательность стандартных команд,только вот незадача-я не умею пока писать его. :cry: Вот и решил спросить,может есть у кого такой лиспик,не один же я занимаюсь вертикальной планировкой.
Насчет размера бергштриха я и не замарачиваюсь,можно и одной длины,например 0,5.
Вообщем ситуэйшин такой.Имеем вариант 1,в идеале нужен вариант 3.Спрашивал я про 2(хотелось просто выделить все горизонтали,указать направление и размер и чтобы вар1 превратился в вар2 )
Если все же кто-нить сможет написать (ну очень простой лиспик со слов некоторых участников :wink: )буду очень признателен.
[ATTACH]1163145442.dwg[/ATTACH]

[DEM]

Черт его знает, что у вас там в файле, у меня открылась лишь одна линия.
Из центра чет не получается, а если подойдут перпендикуляры к кривой то можно и написать.

[Иван]

Сообщение от DEM Черт его знает, что у вас там в файле, у меня открылась лишь одна линия. Из центра чет не получается, а если подойдут перпендикуляры к кривой то можно и написать.

ну хз,вроде загружается.От перпендикуляров к кривой тоже не откажусь Перпендикуляр к указанному месту заданной длины?

[VVA]

1. Про перпендикуляры
LISP. Построение перпендикуляров к любым линейным примитивам
2. Про бергштрихи

Код:

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

(defun C:M1 ( / adoc *error* selset len Fpt Spt Mpt ang what par)
(defun *error* (msg)(vla-Regen adoc acActiveViewport)(vla-EndUndoMark adoc))
;********************************
; Векторное произведение векторов
;********************************
; W1, W2 - вектора
; Возвращает: вектор нормали к плоскости заданной векторами  в правой системе координат.
;W1 и W2 не должны лежать на одной прямой).
(defun 3d_Wnorm (W1 W2)(list (- (* (cadr W1)(caddr W2))(* (caddr W1)(cadr W2)))
        (- (* (caddr W1)(car W2)) (* (car W1)(caddr W2)))(- (* (car W1)(cadr W2)) (* (cadr W1)(car W2)))))
(defun group-by-num (lst num / ls ret)
 (if (= (rem (length lst) num ) 0)(progn (setq ls nil)
  (repeat (/ (length lst) num)(repeat num (setq ls (cons (car lst) ls)
  lst (cdr lst)))(setq ret (append ret (list (reverse ls))) ls nil))))
  ret)
(defun getcoors (obj / objname crs)(setq objname (vla-get-ObjectName obj) crs (cond
 ((= objname "AcDbLine")(list (vlax-curve-getStartPoint obj)(vlax-curve-getEndPoint obj)))
 ((wcmatch objname "*Polyline")((lambda ( / i lst)(while (<= (setq i (if i (1+ i) 0))(vlax-curve-getEndParam obj))
  (setq lst (append lst (list (vlax-curve-getPointAtParam obj i))))) lst)))
((= objname "AcDbSpline")(group-by-num (vlax-safearray->list(vlax-variant-value(vla-get-fitpoints obj))) 3))
(t nil))))
(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-StartUndoMark adoc)(princ "\nВыберите горизонтали ")
(if (setq selset (ssget "_:L" '((0 . "*LINE"))))(progn
  (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))))
  (foreach item lst (setq crs (getcoors item) Fpt (car crs))
   (while (setq crs (cdr crs))(setq Spt (car crs))
    (setq par (+(* (- (if (cdr crs)(vlax-curve-getParamAtPoint item Spt)
			(vlax-curve-getEndParam item))
		(vlax-curve-getParamAtPoint item Fpt)) 0.5)
		    (vlax-curve-getParamAtPoint item Fpt)))
     (if (null len)(progn (initget 6)(setq len (getdist "\nРазмер бергштриха <0.5>: "))
        (if (null len)(setq len 0.5))(initget 1)(setq Mpt (getpoint
            (trans (vlax-curve-getPointAtParam item par) 0 1) "\nНаправление бергштриха: ")
            Mpt (trans Mpt 1 0) Mpt (mapcar '- Mpt Fpt) ang (mapcar '- Spt Fpt)
            ang (last (3d_Wnorm ang Mpt)))(if (minusp ang)(setq what -)(setq what +))))
	(setq ang (what (angle (setq Mpt (vlax-curve-getPointAtParam item par))
			 (vlax-curve-getPointAtParam item (+ par 0.0001)))
	            (* 0.5 PI)))
	(vla-AddLine (vla-get-block (vla-get-ActiveLayout adoc))
	  (vlax-3d-point Mpt)(vlax-3d-point (polar Mpt ang len)))
	(setq Fpt Spt)))
(vla-EndUndoMark adoc)))(princ))
(princ "\nНаберите в командной строке M1")

Обрабатывает LINE, all Polyline, Spline

[DEM]

VVA
Блин а Я тут мучусь _.divide думал так лучше получится, правда Я там блок применял.

[Alxd]

У меня есть такая программулька.
(defun c:sht( / ang abas sel obj pnt pnt1 pnt2 flg snp cmd scl)

(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "_.undo" "_begin")

(setq snp (getvar "OSMODE"))
(setvar "OSMODE" 16417)

(setq abas (getvar "ANGBASE"))
(setq scl (getscl))
(setq obj (entsel "\nУкажи местоположение штриха на линии : "))
(setq pnt (cdr obj))
(setq obj (car obj))
(if (/= (cdr (assoc '0 (entget obj))) "LINE") (quit))
(setq ang (angle (cdr (assoc '10 (entget obj))) (cdr (assoc '11 (entget obj)))))
(if (and (> ang 1.5708) (< ang 4.71239))
(setq flg 1)
(setq flg 0)
)
(setq pnt1 (polar (car pnt) (+ ang 1.5708) (* 1.0 scl)))
(setq pnt (inters (car pnt) pnt1 (cdr (assoc '10 (entget obj))) (cdr (assoc '11 (entget obj))) nil))
(setvar "ANGBASE" ang)
(setq sel (getangle pnt "\nС какой стороны ставить текст?"))
(if (= flg 0)
(if (and (> sel 0) (< sel 3.14))
(setq pnt1 (polar pnt (+ ang 1.5708) (* 1.0 scl)))
(setq pnt1 (polar pnt (- ang 1.5708) (* 4.0 scl)))
)
(if (and (> sel 0) (< sel 3.14))
(setq pnt1 (polar pnt (+ ang 1.5708) (* 4.0 scl)))
(setq pnt1 (polar pnt (- ang 1.5708) (* 1.0 scl)))
)
)
(if (and (> sel 0) (< sel 3.14))
(setq pnt2 (polar pnt (- ang 1.5708) (* 2.0 scl)))
(setq pnt2 (polar pnt (+ ang 1.5708) (* 2.0 scl)))
)
(setq sel (getstring T "\nТекст : "))
(if (= flg 0)
; (command "_.text" "_j" "_c" pnt1 (* 3.0 scl) 0.0 sel)
; (command "_.text" "_j" "_c" pnt1 (* 3.0 scl) 180.0 sel)
(command "_.text" "_j" "_c" pnt1 2000 0.0 sel)
(command "_.text" "_j" "_c" pnt1 2000 180.0 sel)
)

(command "_.line" pnt pnt2 (command))

(command "_.undo" "_end")
(setvar "ANGBASE" abas)
(setvar "CMDECHO" cmd)
(setvar "OSMODE" snp)
(princ)
)
(princ)

надеюсь пригодится