Нужен лисп (масив с разным шагом)

Нужен лисп (масив с разным шагом) · 27.05.2007, 09:33

Уважаемые коллеги по Специальности ПГС!

Кто рисует ригели часто приходится расставлять хомуты
с шагом на 1/4 пролета 100мм в пролете 200мм
существующая команда массив в автокаде делает
с определенным шагом.

Пример как должен выглядеть лисп:

1) Выбираем объект
2) Указываем область распределения (длину, направление Х, У)

программа автоматически распределяет по заданному шагу

Если у кого есть
заранее благодарен
[ATTACH]1180243969.JPG[/ATTACH]

dextron3 · 01.06.2007, 09:58

будем пользоваться ОФСЕТОМ и МАССИВОМ как в первобытные времена

DEM · 01.06.2007, 11:18

Вот тебе быстрый массив с одинаковым шагом.
Правда почему то на некоторых компах не работаеть

Код:

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

(defun C:scopi (/ pt1 pt2 sh ss r1
	      )
  (setq pt1 (getpoint "\nНачальная точка: "))
  (setq pt2 (getpoint pt1 "\nКонечная точка: "))
  (setq sh (getdist "\nВведите шаг: "))
  (setq L1 (distance pt1 pt2))
  (setq ss (fix (+ 1 (/ L1 sh))))
  (setq r1 (/ (* 180 (angle pt1 pt2)) pi))
  (ssget )  
  (command "_.ucs" "_z" r1)
  (command "_.-array" "_P" "" "П" "1" ss sh)
  (command "_.ucs" "_p") 
  (princ)
)

dextron3 · 01.06.2007, 11:59

Цитата:

Сообщение от DEM

Вот тебе быстрый массив с одинаковым шагом.
Правда почему то на некоторых компах не работаеть

Код:

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

(defun C:scopi (/ pt1 pt2 sh ss r1
	      )
  (setq pt1 (getpoint "\nНачальная точка: "))
  (setq pt2 (getpoint pt1 "\nКонечная точка: "))
  (setq sh (getdist "\nВведите шаг: "))
  (setq L1 (distance pt1 pt2))
  (setq ss (fix (+ 1 (/ L1 sh))))
  (setq r1 (/ (* 180 (angle pt1 pt2)) pi))
  (ssget )  
  (command "_.ucs" "_z" r1)
  (command "_.-array" "_P" "" "П" "1" ss sh)
  (command "_.ucs" "_p") 
  (princ)
)

Command: scopi

Начальная точка:
Конечная точка:
Введите шаг: 100

Select objects: 1 found

Select objects:
_.ucs
Current ucs name: *TOP*
Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis]
<World>: _z
Specify rotation angle about Z axis <90>: 0.000000000000000
Command: _.-array
Select objects: _P 1 found

Select objects: Enter the type of array [Rectangular/Polar] <R>: П
Invalid option keyword.
; error: Function cancelled
Enter the type of array [Rectangular/Polar] <R>: к

Invalid option keyword.
Enter the type of array [Rectangular/Polar] <R>: r

Enter the number of rows (---) <1>:

Enter the number of columns (|||) <1> 100

Specify the distance between columns (|||): 100

это ты называешь быстрым :twisted: :twisted: :twisted:

Profan · 01.06.2007, 12:08

Будет быстро, если вместо "П" написать "_R".
Объекты могут быть предварительно выбраны.

dextron3 · 01.06.2007, 12:49

Цитата:

Сообщение от Profan

Будет быстро, если вместо "П" написать "_R".
Объекты должны быть предварительно выбраны.

а еще быстрее можно
1. Выбрать объект
2. Выбрать направление 2мя точками
3. Ввести шаг
4. Обрадоваться увиденному

Я придумал способ более приметивный но все смеятся будут
если скажу

Profan · 01.06.2007, 12:54

Здесь любят посмеяться. Скажи.

VVA · 01.06.2007, 13:05

>dextron3 У меня вот что получилось

Код:

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

;Переменный массив
;http://forum.dwg.ru/showthread.php?p=143608#post143608
;; Владимир Азарко (VVA) 01.06.2007
(defun C:HOMUT ( / pat T1 T2 all_len ost_len T11 T21 Curr-len Shag Dst Len *error* adoc Clay)
(defun *error* (msg)
  (princ msg)
  (setvar "CLAYER" Clay)
  (vla-EndUndoMark adoc)
  )
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)))
        (t (list str)))) ;_  defun
(defun get_pattern ( / shg shglist Plist ret)
(princ "\nСтруктура Долевой_индекс * Шаговый_индекс. Пример 0.25*100")  
(setq shg (getstring T "\nОписание раскладки через пробел (пример 0.25*100 0.5*200 0.25*100):"))
(setq shg  (vl-string-subst "*" "*-" shg)
      shg  (vl-string-subst "*" "-*" shg)
      shg  (vl-string-subst "*." "*0." shg)
      shg  (vl-string-subst "0 0" "0-0" shg)
      shg  (vl-string-subst "0" "-0" shg)
      shg  (vl-string-subst " ." "-." shg)
      shg  (vl-string-subst " ." "-," shg)
      shg (vl-string-translate ",-" ". " shg))
(setq shglist (str-str-lst shg " "))
(setq shglist (vl-remove-if '(lambda(x)(= x "")) shglist))
(setq Plist (mapcar '(lambda(x / lst)
          (setq lst (str-str-lst x "*"))
          (cons (atof (vl-string-trim " \t" (mip-conv-to-str(nth 0 lst))))
                (atof (vl-string-trim " \t" (mip-conv-to-str(nth 1 lst))))
                )
           )
        shglist))
  (setq Plist (vl-remove-if 'null Plist))
  (cond
    ((vl-some '(lambda(x)(zerop (car x))) Plist)
     (alert "Нулевой долевой индекс"))
    ((vl-some '(lambda(x)(zerop (cdr x))) Plist)
     (alert "Нулевой шаговый индекс"))
    ((not(equal 1.0 (apply '+ (mapcar 'car Plist)) 1e-6))
     (alert "Сумма долевых индексов не равна 1"))
    (t (setq ret Plist)))
  ret)
(defun draw-homut ( TN ang check_len KShag Dst Len )
(command "_.LINE" "_none" (polar TN (- ang (* PI 0.5))(* 0.5 len))
         "_none" (polar TN (+ ang (* PI 0.5))(* 0.5 len)) "")
(repeat KShag
  (setq TN (polar TN ang Dst))
  (setq check_len (- check_len dst))
  (if (> check_len 0)
    (progn
      (command "_.LINE" "_none" (polar TN (- ang (* PI 0.5))(* 0.5 len))
         "_none" (polar TN (+ ang (* PI 0.5))(* 0.5 len))  ""))
    )
  )
  (list TN check_len)
)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(setvar "CMDECHO" 0)
(if (setq pat (get_pattern))
 (progn 
(initget 1)
(setq t1 (getpoint "\nНачальная точка раскладки:"))
(initget 1)
(setq t2 (getpoint t1 "\nКонечная точка раскладки:"))
(while (null len)
(princ "\nУкажите образец")
(setq len (ssget "_:S:E" '((0 . "LINE,*POLYLINE"))))
  )
(setq T11 (ssname len 0) len nil)
(setq len (vla-get-length (vlax-ename->vla-object t11)))
(setvar "CLAYER" (cdr(assoc 8 (entget T11))))
(setq all_len (distance t1 t2))
(setq ost_len all_len)
;;---- 1-я часть -----
(setq Curr-len (* (car(nth 0 pat)) all_len))
(setq Shag (/ Curr-len (cdr(nth 0 pat))))
(setq Shag (fix (+ Shag 0.5)))
(setq Dst (cdr(nth 0 pat)))
(setq ost_len (draw-homut T1 (angle T1 T2) ost_len Shag Dst Len))
(setq T11 (car ost_len)
      ost_len (cadr ost_len))
;;---- Последняя часть -----
(setq Curr-len (* (car(last pat)) all_len))
(setq Shag (/ Curr-len (cdr(last pat))))
(setq Shag (fix (+ Shag 0.5)))
(setq Dst (cdr(last pat)))
(setq ost_len (draw-homut T2 (angle T2 T1) ost_len Shag Dst Len))
(setq T21 (car ost_len)
      ost_len (cadr ost_len))
;;---- Промежуточные части ---------
(setq pat (cdr pat))
(setq pat (reverse(cdr(reverse pat))))
(while pat
(setq Curr-len (* (car(car pat)) all_len))
(setq Shag (/ Curr-len (cdr(car pat))))
(if (= (length pat) 1)
  (setq Shag (fix Shag))
  (setq Shag (fix (+ Shag 0.5)))
  )
(setq Dst (cdr(car pat)))
(setq ost_len (draw-homut T11 (angle T1 T2) ost_len Shag Dst Len))
(setq T11 (car ost_len)
      ost_len (cadr ost_len))
(setq pat (cdr pat))  
  );_while
  )
)
(vla-Endundomark adoc)
  (princ)
)

Соглашения:
Долевой индекс:
Число больше 0 и меньше 1. Задает часть пролета для данного шага
Например для 1/4 пролета - 0.25
Шаговый индекс - собстенно сам шаг (число>0)
Раскладка хомутов затается шаблоном типа
Долевой_индекс1*Шаговый_ишдекс1 Долевой_индекс2*Шаговый_ишдекс3 и т.д.,
разделенных пробелом
Например задание:
1/4 пролета с шагом 100
2/4 пролета с шагом 250
1/4 пролета в шагом 150
запишется ввиде
0.25*100_0.5*250_0.25*150
(вместо _ -> пробел)
Сумма Долевых индексов должна равняться 1

DEM · 01.06.2007, 13:05

Цитата:

Сообщение от dextron3

это ты называешь быстрым :twisted: :twisted: :twisted:

Цитата:

Сообщение от dextron3

а еще быстрее можно
1. Выбрать объект
2. Выбрать направление 2мя точками
3. Ввести шаг
4. Обрадоваться увиденному

Фиг его знаеть почему у тебя так работает.
Но у меня он работает по приведенному тобой алгоритму.
И запросы делает именно в том порядке, который ты перечислил.
Я тестировал только на своих машинах, и стоит у меня руссифицированный автокад.
Так что уж извольте, сами подправьте код, если такой умный. :cry:

dextron3 · 01.06.2007, 16:01

VVA

посмотри что я делаю не правильно

Command: HOMUT

Структура Долевой_индекс * Шаговый_индекс. Пример 0.25*100
Описание раскладки через пробел (пример 0.25*100 0.5*200 0.25*100):0.25*100
0.5*200 0.25*100
no function definition: MIP-CONV-TO-STR; error: An error has occurred inside
the *error* functionAutoCAD variable setting rejected: "CLAYER" nil

dextron3 · 01.06.2007, 16:04

может из за того что английский автокад у меня? :shock: :shock:

dextron3 · 01.06.2007, 16:10

Цитата:

Сообщение от Profan

Здесь любят посмеяться. Скажи.

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

и все чертишь сварной шов, взрываешь и убираешь среднюю линию

элементарно :!:

dextron3 · 01.06.2007, 16:40

вот сваркой хомуты
[ATTACH]1180701630.JPG[/ATTACH]

DEM · 01.06.2007, 16:46

ГЫЫ
голь на выдумки хитра.

VVA · 01.06.2007, 18:54

Забыл ф-цию выложить. Пробуй так. Правила те же

Код:

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

;Переменный массив 
;http://forum.dwg.ru/showthread.php?p=143739#post143739
;; Владимир Азарко (VVA) 01.06.2007 
(defun C:HOMUT ( / pat T1 T2 all_len ost_len T11 T21 Curr-len Shag Dst Len *error* adoc Clay) 
(defun *error* (msg) 
  (princ msg) 
  (setvar "CLAYER" Clay) 
  (vla-EndUndoMark adoc) 
  ) 
(defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
        ((null dat)(setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))))

(defun str-str-lst (str pat / i) 
  (cond ((= str "") nil) 
        ((setq i (vl-string-search pat str)) 
         (cons (substr str 1 i) 
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat))) 
        (t (list str)))) ;_  defun 
(defun get_pattern ( / shg shglist Plist ret) 
(princ "\nСтруктура Долевой_индекс * Шаговый_индекс. Пример 0.25*100")  
(setq shg (getstring T "\nОписание раскладки через пробел (пример 0.25*100 0.5*200 0.25*100):")) 
(setq shg  (vl-string-subst "*" "*-" shg) 
      shg  (vl-string-subst "*" "-*" shg) 
      shg  (vl-string-subst "*." "*0." shg) 
      shg  (vl-string-subst "0 0" "0-0" shg) 
      shg  (vl-string-subst "0" "-0" shg) 
      shg  (vl-string-subst " ." "-." shg) 
      shg  (vl-string-subst " ." "-," shg) 
      shg (vl-string-translate ",-" ". " shg)) 
(setq shglist (str-str-lst shg " ")) 
(setq shglist (vl-remove-if '(lambda(x)(= x "")) shglist)) 
(setq Plist (mapcar '(lambda(x / lst) 
          (setq lst (str-str-lst x "*")) 
          (cons (atof (vl-string-trim " \t" (mip-conv-to-str(nth 0 lst)))) 
                (atof (vl-string-trim " \t" (mip-conv-to-str(nth 1 lst)))) 
                ) 
           ) 
        shglist)) 
  (setq Plist (vl-remove-if 'null Plist)) 
  (cond 
    ((vl-some '(lambda(x)(zerop (car x))) Plist) 
     (alert "Нулевой долевой индекс")) 
    ((vl-some '(lambda(x)(zerop (cdr x))) Plist) 
     (alert "Нулевой шаговый индекс")) 
    ((not(equal 1.0 (apply '+ (mapcar 'car Plist)) 1e-6)) 
     (alert "Сумма долевых индексов не равна 1")) 
    (t (setq ret Plist))) 
  ret) 
(defun draw-homut ( TN ang check_len KShag Dst Len ) 
(command "_.LINE" "_none" (polar TN (- ang (* PI 0.5))(* 0.5 len)) 
         "_none" (polar TN (+ ang (* PI 0.5))(* 0.5 len)) "") 
(repeat KShag 
  (setq TN (polar TN ang Dst)) 
  (setq check_len (- check_len dst)) 
  (if (> check_len 0) 
    (progn 
      (command "_.LINE" "_none" (polar TN (- ang (* PI 0.5))(* 0.5 len)) 
         "_none" (polar TN (+ ang (* PI 0.5))(* 0.5 len))  "")) 
    ) 
  ) 
  (list TN check_len) 
) 
(vl-load-com) 
(setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
(vla-startundomark adoc) 
(setq Clay (getvar "CLAYER"))
(setvar "CMDECHO" 0) 
(if (setq pat (get_pattern)) 
 (progn 
(initget 1) 
(setq t1 (getpoint "\nНачальная точка раскладки:")) 
(initget 1) 
(setq t2 (getpoint t1 "\nКонечная точка раскладки:")) 
(while (null len) 
(princ "\nУкажите образец") 
(setq len (ssget "_:S:E" '((0 . "LINE,*POLYLINE")))) 
  ) 
(setq T11 (ssname len 0) len nil) 
(setq len (vla-get-length (vlax-ename->vla-object t11))) 
(setvar "CLAYER" (cdr(assoc 8 (entget T11)))) 
(setq all_len (distance t1 t2)) 
(setq ost_len all_len) 
;;---- 1-я часть ----- 
(setq Curr-len (* (car(nth 0 pat)) all_len)) 
(setq Shag (/ Curr-len (cdr(nth 0 pat)))) 
(setq Shag (fix (+ Shag 0.5))) 
(setq Dst (cdr(nth 0 pat))) 
(setq ost_len (draw-homut T1 (angle T1 T2) ost_len Shag Dst Len)) 
(setq T11 (car ost_len) 
      ost_len (cadr ost_len)) 
;;---- Последняя часть ----- 
(setq Curr-len (* (car(last pat)) all_len)) 
(setq Shag (/ Curr-len (cdr(last pat)))) 
(setq Shag (fix (+ Shag 0.5))) 
(setq Dst (cdr(last pat))) 
(setq ost_len (draw-homut T2 (angle T2 T1) ost_len Shag Dst Len)) 
(setq T21 (car ost_len) 
      ost_len (cadr ost_len)) 
;;---- Промежуточные части --------- 
(setq pat (cdr pat)) 
(setq pat (reverse(cdr(reverse pat)))) 
(while pat 
(setq Curr-len (* (car(car pat)) all_len)) 
(setq Shag (/ Curr-len (cdr(car pat)))) 
(if (= (length pat) 1) 
  (setq Shag (fix Shag)) 
  (setq Shag (fix (+ Shag 0.5))) 
  ) 
(setq Dst (cdr(car pat))) 
(setq ost_len (draw-homut T11 (angle T1 T2) ost_len Shag Dst Len)) 
(setq T11 (car ost_len) 
      ost_len (cadr ost_len)) 
(setq pat (cdr pat))  
  );_while 
  ) 
) 
 (setvar "CLAYER" Clay) 
(vla-Endundomark adoc) 
  (princ) 
)

dextron3 · 01.06.2007, 20:12

VVA
Вот это другое дело!
Все нормально работает! Спасибо

Только два небольших минуса:

1. Нельзя ли это (0.25*100 0.5*200 0.25*100) вшить
в программу чтобы не вводить, это ведь константа
2. Почему выделять можно только 1 объект для копирования, бывает ситуация что 2 хомута нужно копировать

ну и совсем незначительный минус
3. При переходе шага хомуты налагаются друг на друга

если нетрудно подправить возможна?

VVA · 04.06.2007, 13:34

Код:

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

;Переменный массив
;http://forum.dwg.ru/showthread.php?p=143986#post143986
;; Владимир Азарко (VVA) 01.06.2007
(defun C:HOMUT ( / pat T1 T2 all_len ost_len T11 T21 Curr-len Shag Dst Len *error* adoc Clay)
(defun *error* (msg)(princ msg)
  (setvar "CLAYER" Clay)(vla-EndUndoMark adoc))
(defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
        ((null dat)(setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))))  
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)))
        (t (list str)))) ;_  defun
(defun get_pattern ( / shg shglist Plist ret)
(princ "\nСтруктура Долевой_индекс * Шаговый_индекс. Пример 0.25*100")  
(setq shg (getstring T "\nОписание раскладки через пробел или _ (пример 0.25*100 0.5*200 0.25*100):"))
(setq shg  (vl-string-translate "_" " " shg)
      shg  (vl-string-subst "*" "*-" shg)
      shg  (vl-string-subst "*" "-*" shg)
      shg  (vl-string-subst "*." "*0." shg)
      shg  (vl-string-subst "0 0" "0-0" shg)
      shg  (vl-string-subst "0" "-0" shg)
      shg  (vl-string-subst " ." "-." shg)
      shg  (vl-string-subst " ." "-," shg)
      shg (vl-string-translate ",-" ". " shg))
(setq shglist (str-str-lst shg " "))
(setq shglist (vl-remove-if '(lambda(x)(= x "")) shglist))
(setq Plist (mapcar '(lambda(x / lst)
          (setq lst (str-str-lst x "*"))
          (cons (atof (vl-string-trim " \t" (mip-conv-to-str(nth 0 lst))))
                (atof (vl-string-trim " \t" (mip-conv-to-str(nth 1 lst))))
                )
           )
        shglist))
  (setq Plist (vl-remove-if 'null Plist))
  (cond
    ((vl-some '(lambda(x)(zerop (car x))) Plist)
     (alert "Нулевой долевой индекс"))
    ((vl-some '(lambda(x)(zerop (cdr x))) Plist)
     (alert "Нулевой шаговый индекс"))
    ((not(equal 1.0 (apply '+ (mapcar 'car Plist)) 1e-6))
     (alert "Сумма долевых индексов не равна 1"))
    (t (setq ret Plist)))
  ret)
(defun draw-homut ( TN ang check_len KShag Dst Len First)
(if First  
(command "_.LINE" "_none" (polar TN (- ang (* PI 0.5))(* 0.5 len))
         "_none" (polar TN (+ ang (* PI 0.5))(* 0.5 len)) "")
  )
(repeat KShag
  (setq TN (polar TN ang Dst))
  (setq check_len (- check_len dst))
  (if (> check_len 0)
    (progn
      (command "_.LINE" "_none" (polar TN (- ang (* PI 0.5))(* 0.5 len))
         "_none" (polar TN (+ ang (* PI 0.5))(* 0.5 len))  ""))
    )
  )
  (list TN check_len)
)
(vl-load-com)
(setvar "CMDECHO" 0)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(if (setq pat (get_pattern))
 (progn 
(initget 1)
(setq t1 (getpoint "\nНачальная точка раскладки:"))
(initget 1)
(setq t2 (getpoint t1 "\nКонечная точка раскладки:"))
(while (null len)
(princ "\nУкажите образец")
(setq len (ssget "_:S:E" '((0 . "LINE,*POLYLINE"))))
  )
(setq T11 (ssname len 0) len nil)
(setq len (vla-get-length (vlax-ename->vla-object t11)))
(setvar "CLAYER" (cdr(assoc 8 (entget T11))))
(setq all_len (distance t1 t2))
(setq ost_len all_len)
;;---- 1-я часть -----
(setq Curr-len (* (car(nth 0 pat)) all_len))
(setq Shag (/ Curr-len (cdr(nth 0 pat))))
(setq Shag (fix (+ Shag 0.5)))
(setq Dst (cdr(nth 0 pat)))
(setq ost_len (draw-homut T1 (angle T1 T2) ost_len Shag Dst Len T))
(setq T11 (car ost_len)
      ost_len (cadr ost_len))
;;---- Последняя часть -----
(setq Curr-len (* (car(last pat)) all_len))
(setq Shag (/ Curr-len (cdr(last pat))))
(setq Shag (fix (+ Shag 0.5)))
(setq Dst (cdr(last pat)))
(setq ost_len (draw-homut T2 (angle T2 T1) ost_len Shag Dst Len T))
(setq T21 (car ost_len)
      ost_len (cadr ost_len))
;;---- Промежуточные части ---------
(setq pat (cdr pat))
(setq pat (reverse(cdr(reverse pat))))
(while pat
(setq Curr-len (* (car(car pat)) all_len))
(setq Shag (/ Curr-len (cdr(car pat))))
(if (= (length pat) 1)
  (setq Shag (fix Shag))
  (setq Shag (fix (+ Shag 0.5)))
  )
(setq Dst (cdr(car pat)))
(setq ost_len (draw-homut T11 (angle T1 T2) ost_len Shag Dst Len Nil))
(setq T11 (car ost_len)
      ost_len (cadr ost_len))
(setq pat (cdr pat))  
  );_while
  )
)
(vla-Endundomark adoc)
  (princ)
)

Соглашения:
Долевой индекс:
Число больше 0 и меньше 1. Задает часть пролета для данного шага
Например для 1/4 пролета - 0.25
Шаговый индекс - собстенно сам шаг (число>0)
Раскладка хомутов затается шаблоном типа
Долевой_индекс1*Шаговый_индекс1 Долевой_индекс2*Шаговый_индекс2 и т.д.,
разделенных пробелом или ПОДЧЕРКИВАНИЕМ (_)
Например задание:
1/4 пролета с шагом 100
2/4 пролета с шагом 250
1/4 пролета в шагом 150
запишется ввиде
0.25*100_0.5*250_0.25*150
Сумма Долевых индексов должна равняться 1
Теперь по пунктам
1. Для разделения друг от друга Долевой_индексN*Шаговый_индексN добавлен символ подчеркивание (_) специально для использования в меню или tool-palette.
"Вшить" свою раскладку можешь в меню или палитру инструментов кнопочкой вида:

Код:

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

^C^CHOMUT;0.25*100_0.5*200_0.25*100;

Команда должна быть загружена.
Подробнее о загрузке : http://dwg.ru/art/8
3. Вроде исправил
2. У выделенного объекта берется слой отрисовки и его длина.
Хомуты рисуются отрезками указанной длины перпендикулярно линии, указанной точками, причем она проходит посередине отрезков.
Если копировать объекты, то неясно
2.1 что брать в качестве базовой точки выбранных объектов
2.2 Как согласовывать углы поворота.

dextron3 · 04.06.2007, 20:31

VVA
Вот это другое дело!

1. Все проблема с наложением решена
2. Кнопка автоматизации полностью работоспособна

Нашел неисправность

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

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

см. чертеж :roll: :roll: :roll:
[ATTACH]1180974683.JPG[/ATTACH]

VVA · 11.06.2007, 10:47

Цитата:

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

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

Код:

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

;Переменный массив
;http://forum.dwg.ru/showthread.php?p=145451#post145451
;; Владимир Азарко (VVA) 01.06.2007
(defun C:HOMUT1 ( / pat T1 T2 all_len ost_len T11 T21 Curr-len Shag Dst Len *error* adoc Clay)
(defun *error* (msg)(princ msg)
  (setvar "CLAYER" Clay)(vla-EndUndoMark adoc))
(defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
        ((null dat)(setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))))  
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)))
        (t (list str)))) ;_  defun
(defun get_pattern ( / shg shglist Plist ret)
(princ "\nСтруктура Долевой_индекс * Шаговый_индекс. Пример 0.25*100")  
(setq shg (getstring T "\nОписание раскладки через пробел или _ (пример 0.25*100 0.5*200 0.25*100):"))
(setq shg  (vl-string-translate "_" " " shg)
      shg  (vl-string-subst "*" "*-" shg)
      shg  (vl-string-subst "*" "-*" shg)
      shg  (vl-string-subst "*." "*0." shg)
      shg  (vl-string-subst "0 0" "0-0" shg)
      shg  (vl-string-subst "0" "-0" shg)
      shg  (vl-string-subst " ." "-." shg)
      shg  (vl-string-subst " ." "-," shg)
      shg (vl-string-translate ",-" ". " shg))
(setq shglist (str-str-lst shg " "))
(setq shglist (vl-remove-if '(lambda(x)(= x "")) shglist))
(setq Plist (mapcar '(lambda(x / lst)
          (setq lst (str-str-lst x "*"))
          (cons (atof (vl-string-trim " \t" (mip-conv-to-str(nth 0 lst))))
                (atof (vl-string-trim " \t" (mip-conv-to-str(nth 1 lst))))
                )
           )
        shglist))
  (setq Plist (vl-remove-if 'null Plist))
  (cond
    ((vl-some '(lambda(x)(zerop (car x))) Plist)
     (alert "Нулевой долевой индекс"))
    ((vl-some '(lambda(x)(zerop (cdr x))) Plist)
     (alert "Нулевой шаговый индекс"))
    ((not(equal 1.0 (apply '+ (mapcar 'car Plist)) 1e-6))
     (alert "Сумма долевых индексов не равна 1"))
    (t (setq ret Plist)))
  ret)
(defun draw-homut ( TN ang check_len KShag Dst Len First)
(if First  
(command "_.LINE" "_none" (polar TN (- ang (* PI 0.5))(* 0.5 len))
         "_none" (polar TN (+ ang (* PI 0.5))(* 0.5 len)) "")
  )
(repeat KShag
  (setq TN (polar TN ang Dst))
  (setq check_len (- check_len dst))
  (if (> check_len 0)
    (progn
      (command "_.LINE" "_none" (polar TN (- ang (* PI 0.5))(* 0.5 len))
         "_none" (polar TN (+ ang (* PI 0.5))(* 0.5 len))  ""))
    )
  )
  (list TN check_len)
)
(vl-load-com)
(setvar "CMDECHO" 0)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(if (setq pat (get_pattern))
 (progn 
(initget 1)
(setq t1 (getpoint "\nНачальная точка раскладки:"))
(initget 1)
(setq t2 (getpoint t1 "\nКонечная точка раскладки:"))
(while (null len)
(princ "\nУкажите образец")
(setq len (ssget "_:S:E" '((0 . "LINE,*POLYLINE"))))
  )
(setq T11 (ssname len 0) len nil)
(setq len (vla-get-length (vlax-ename->vla-object t11)))
(setvar "CLAYER" (cdr(assoc 8 (entget T11))))
(setq all_len (distance t1 t2))
(setq ost_len all_len)
;;---- 1-я часть -----
(setq Curr-len (* (car(nth 0 pat)) all_len))
(setq Shag (/ Curr-len (cdr(nth 0 pat))))
(setq Shag (fix (+ Shag 0.5)))
(setq Dst (cdr(nth 0 pat)))
(setq ost_len (draw-homut T1 (angle T1 T2) ost_len Shag Dst Len nil))
(setq T11 (car ost_len)
      ost_len (cadr ost_len))
;;---- Последняя часть -----
(setq Curr-len (* (car(last pat)) all_len))
(setq Shag (/ Curr-len (cdr(last pat))))
(setq Shag (fix (+ Shag 0.5)))
(setq Dst (cdr(last pat)))
(setq ost_len (draw-homut T2 (angle T2 T1) ost_len Shag Dst Len T))
(setq T21 (car ost_len)
      ost_len (cadr ost_len))
;;---- Промежуточные части ---------
(setq pat (cdr pat))
(setq pat (reverse(cdr(reverse pat))))
(while pat
(setq Curr-len (* (car(car pat)) all_len))
(setq Shag (/ Curr-len (cdr(car pat))))
(if (= (length pat) 1)
  (setq Shag (fix Shag))
  (setq Shag (fix (+ Shag 0.5)))
  )
(setq Dst (cdr(car pat)))
(setq ost_len (draw-homut T11 (angle T1 T2) ost_len Shag Dst Len Nil))
(setq T11 (car ost_len)
      ost_len (cadr ost_len))
(setq pat (cdr pat))  
  );_while
  )
)
(vla-Endundomark adoc)
  (princ)
)

Оба варианта лишь одной строкой:

Код:

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

;;---- 1-я часть -----
(setq Curr-len (* (car(nth 0 pat)) all_len))
(setq Shag (/ Curr-len (cdr(nth 0 pat))))
(setq Shag (fix (+ Shag 0.5)))
(setq Dst (cdr(nth 0 pat)))
(setq ost_len (draw-homut T1 (angle T1 T2) ost_len Shag Dst Len nil));_<<-Отличие:вместо nil T

dextron3 · 11.06.2007, 19:50

Тут два варианта постоянно приходится использовать, первым при нарисованном аналоге а второй при уже использованном первом

Спасибо!!!

27.05.2007, 09:33
Нужен лисп (масив с разным шагом) dextron3 проектировшик СССР Регистрация: 01.01.2007 Сообщений: 5,149 Уважаемые коллеги по Специальности ПГС! Кто рисует ригели часто приходится расставлять хомуты с шагом на 1/4 пролета 100мм в пролете 200мм существующая команда массив в автокаде делает с определенным шагом. Пример как должен выглядеть лисп: 1) Выбираем объект 2) Указываем область распределения (длину, направление Х, У) программа автоматически распределяет по заданному шагу Если у кого есть заранее благодарен [ATTACH]1180243969.JPG[/ATTACH] __________________ инженер проектировшик с опттом программа авто гад образование высшие
Просмотров: 6673