[dextron3]

Задача:

Ну на самом деле это трехсторонний офсет
Проведена линия, выбираем офсет, и лисп офсетет в разную сторону эту линию на заданный в макросе кнопки офсет

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

Кнопка типа С_с_ofset;L18_L12_P45;

Рисутеся уголок в продольном разрезе L63x63x6

Кнопка означает офсет влево 18 офсет влево 12 и офсет вправо 45
18 центр тяжести данного уголка
[ATTACH]1183479127.JPG[/ATTACH]

:roll: :roll: :roll:

оч.нуж.всем

[Profan]

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

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

ИМХО искать "Обновление программы Прокат"...

[dextron3]

В программе прокат нету центра тяжести для привязки

[Sleekka]

В программе прокат нету центра тяжести для привязки

Я об этом говорил автору, сказал что может быть добавит.

[CB]

Посмотри здесь
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31318fs

[dextron3]

Код:

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

(defun C:OFF2 (/ d obj ent adoc *error* undo lays Flag)
  (defun *error* (msg)(vla-EndUndoMark adoc))
  (vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object))
  lays (vla-get-layers adoc))(vla-StartUndoMark adoc)(setvar "CMDECHO" 0)
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST"))))
  (if (zerop *OFF2*)(setq *OFF2* 1))(setq d (getvar "UNDOCTL"))
  (cond ((= d 0) (vl-cmdf "_.UNDO" "_All"))
    ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
    (t nil)) ;_ end of cond
  (princ "\n Величина смещения <")(princ *OFF2*)(princ ">: ")
  (initget 6)(if (null (setq d (getdist))) (setq d *OFF2*))
  (setq  *OFF2* d undo 0 Flag t)
  (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit")
  (while Flag
    (setq obj (entsel (strcat "\n Выберите объект ["
           (if (not (zerop undo)) "Отмени/" "")
           "Выход] <выход>: ")))
    (cond ((= obj "Undo")(if (not (zerop undo))(progn
           (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))(alert "Нечего больше отменять")))
    ((= obj "Exit")(setq Flag nil))
    ((null obj)(if (= (getvar "ERRNO") 52)(setq Flag nil)(princ " *** Мимо ***")))
    (t (setq ent (vlax-ename->vla-object (car obj)))
     (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
      (alert "На блокированном слое!"))
     ((vlax-method-applicable-p ent 'Offset)(vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
     (vla-offset ent d)(vla-offset ent (- 0  d)))
     (t (alert "Не удается создать объект, подобный данному")))))
   (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit"))
 (vla-EndUndoMark adoc)(princ))
(princ "\nНаберите в командной строке OFF2")

вот бы он на разные дистанции овсетил да еще три линии (прописываются в макросе кнопки) было бы супер
VVA кстати автор данного лиспа

[dextron3]

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

зараенее благодарен

[VVA]

>dextron3
Я в понедельник (9 июля) выйду из отпуска, попробую по поводу прямоугольников

[dextron3]

а про разные дистанции офсет трех линий не забудь

[Alaspher]

Показалась занятной идея многомерного оффсета. Накидал код на основе недавних экзерсисов:

Код:

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

(vl-load-com)
(defun pl:moff (param	     /		  adoc	       pl:obj-filter-select-manual
		locs	     asel	  isclock      isint	    lays	 isdel
		tmp	     ssel	  vl-err       vl-err-ent   isdele	 vl-err-cnt
		offdist	     base	  dz
	       )
  (if (= 'list (type param))
    (progn
      (defun pl:obj-filter-select-manual (sel filter)
	(vla-selectonscreen
	  sel
	  (vlax-safearray-fill
	    (vlax-make-safearray vlax-vbinteger (cons 0 (1- (length filter))))
	    (mapcar (function car) filter)
	  )
	  (vlax-safearray-fill
	    (vlax-make-safearray vlax-vbvariant (cons 0 (1- (length filter))))
	    (mapcar (function cdr) filter)
	  )
	)
      )
      (setq adoc (vla-get-activedocument (vlax-get-acad-object))
	    lays (vla-get-layers adoc)
	    ssel (vla-get-selectionsets adoc)
      )
      (if (vl-catch-all-error-p
	    (setq asel (vl-catch-all-apply (function vla-item) (list ssel "pl:ooff-sel")))
	  )
	(setq asel (vla-add (vla-get-selectionsets adoc) "pl:ooff-sel"))
      )
      (vla-clear asel)
      (pl:obj-filter-select-manual
	asel
	'((-4 . "<AND")
	  (-4 . "<NOT")
	  (0 . "INSERT")
	  (-4 . "NOT>")
	  (-4 . "<NOT")
	  (0 . "*TEXT")
	  (-4 . "NOT>")
	  (-4 . "AND>")
	 )
      )
      (vlax-for	i asel
	(if (or	(= :vlax-true (vla-get-lock (vla-item lays (vla-get-layer i))))
		(not (vlax-method-applicable-p i 'Offset))
	    )
	  (setq locs (cons i locs))
	)
      )
      (if locs
	(vla-removeitems
	  asel
	  (vlax-safearray-fill
	    (vlax-make-safearray vlax-vbobject (cons 0 (1- (length locs))))
	    locs
	  )
	)
      )
      (if (zerop (vla-get-count asel))
	(princ "\nНе выбрано подходящих объектов на незаблокированных слоях.")
	(progn
	  (vla-startundomark adoc)
	  (foreach memb	param
	    (setq offdist (car memb))
	    (vlax-for i	asel
	      (if (zerop (setq dz (cadr memb)))
		(setq base i)
		(vla-move (setq base (vla-copy i))
			  (vlax-3d-point '(0 0 0))
			  (vlax-3d-point (list 0 0 dz))
		)
	      )
	      (if (not (zerop offdist))
		(progn (if (vl-catch-all-error-p
			     (setq
			       vl-err (vl-catch-all-apply (function vla-offset) (list base offdist))
			     )
			   )
			 (progn	(setq vl-err-ent (cons i vl-err-ent))
				(princ (strcat "\n" (vl-catch-all-error-message vl-err)))
			 )
		       )
		       (if (not (zerop dz))
			 (vla-erase base)
		       )
		)
	      )
	    )
	  )
	  (vla-endundomark adoc)
	  (if (not (zerop (setq vl-err-cnt (length vl-err-ent))))
	    (progn (vla-removeitems
		     asel
		     (vlax-safearray-fill
		       (vlax-make-safearray vlax-vbobject (cons 0 (1- (length vl-err-ent))))
		       vl-err-ent
		     )
		   )
		   (alert (strcat "При обработке "
				  (rtos vl-err-cnt 2 0)
				  " примитивов возникли ошибки!\nСмотри вывод в текстовом окне."
			  )
		   )
	    )
	  )
	  (if (not (zerop (vla-get-count asel)))
	    (progn
	      (vla-highlight asel :vlax-true)
	      (initget "Д Н _Y N")
	      (if (not (setq isdel (getkword "\nУдалить исходные примитивы [Да/Нет] <Да>: ")))
		(setq isdel "Y")
	      )
	    )
	  )
	  (if (= isdel "Y")
	    (progn (vla-startundomark adoc) (vla-erase asel) (vla-endundomark adoc))
	    (vla-highlight asel :vlax-false)
	  )
	  (if (and (or (= isdel "Y") (zerop (vla-get-count asel))) (not (zerop vl-err-cnt)))
	    (progn (foreach i vl-err-ent (vla-highlight i :vlax-true))
		   (initget "Д Н _Y N")
		   (if (not (setq isdele
				   (getkword
				     "\nУдалить примитивы при обработке которых возникли ошибки [Да/Нет] <Нет>: "
				   )
			    )
		       )
		     (setq isdele "N")
		   )
	    )
	  )
	  (if (= isdele "Y")
	    (progn (vla-startundomark adoc)
		   (foreach i vl-err-ent (vla-erase i))
		   (vla-endundomark adoc)
	    )
	    (foreach i vl-err-ent (vla-highlight i :vlax-false))
	  )
	)
      )
    )
    (alert
      "Не заданы параметры офсета!
Формат задания параметров - (pl:moff '((x1 z1)(x2 z2)(x3 z3)))
где Xn и Zn - смещения относительно исходного объекта"
    )
  )
  (princ)
)

(progn (princ "\nFor button's macro only!\nCalling - (pl:moff '((x1 z1)(x2 z2)(x3 z3))).")
       (princ)
)

Делает "3Д-оффсет". На самом деле, не совсем уже оффсет, но некое подобие. Только для навески на кнопки или для использования с допоболочкой. Оболочку писать не интересно, так что если надо, то 3-и лица. Формат вызова в виде матрицы значений: (pl:moff '((x1 z1)(x2 z2)(x3 z3))). Т.е., это как бы по "X" (смещение в горизонтальной плоскости - собственно оффсет) и по "Z" (высоте). Если задавать нулевой Z, то будет офсетить в плоскости. Допускаются отрицательные значения.

*ВАРНИНГ* - Код очень сырой, могут быть неожиданные косяки!

[dextron3]

Alaspher

Именно то что надо!

:idea: :idea: Скажи только что нужно в макрос или в лиспе подредоктировать,

(pl:moff '((x1 z1)(x2 z2)(x3 z3)))

добавить чтобы не спрашивал:

Удалить исходные примитивы [Да/Нет] <Да>:
Автоматом всегда было нет

• А еще можно четвертую матрицу добавить и получится швеллер!!!
  .....ну это я сам догадался :roll:

[Sleekka]

Сорри за оффтоп, но другую тему открывать для этого смысла нету:
На примере данной темы ярко раскрывается проблема невостребованности лисп-программистов или я ошибаюсь?

[Alaspher]

Сообщение от dextron3 что нужно в макрос или в лиспе подредоктировать, (pl:moff '((x1 z1)(x2 z2)(x3 z3))) добавить чтобы не спрашивал: Удалить исходные примитивы [Да/Нет] <Да>: Автоматом всегда было нет

Так примерно:

Код:

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

(vl-load-com)
(defun pl:moff2 (param         /             adoc          asel          base
                 dz            lays          locs          offdist       seln
                 ssel          vl-err        vl-err-cnt    vl-err-ent
                 pl:obj-filter-select-manual
                )
  (if (= 'list (type param))
    (progn
      (defun pl:obj-filter-select-manual (sel filter)
        (vla-selectonscreen
          sel
          (vlax-safearray-fill
            (vlax-make-safearray vlax-vbinteger (cons 0 (1- (length filter))))
            (mapcar (function car) filter)
          )
          (vlax-safearray-fill
            (vlax-make-safearray vlax-vbvariant (cons 0 (1- (length filter))))
            (mapcar (function cdr) filter)
          )
        )
      )
      (setq adoc (vla-get-activedocument (vlax-get-acad-object))
            lays (vla-get-layers adoc)
            ssel (vla-get-selectionsets adoc)
            seln "pl:ooff-sel"
      )
      (if (vl-catch-all-error-p
            (setq asel (vl-catch-all-apply (function vla-item) (list ssel seln)))
          )
        (setq asel (vla-add (vla-get-selectionsets adoc) seln))
      )
      (vla-clear asel)
      (pl:obj-filter-select-manual asel '((-4 . "<NOT") (0 . "INSERT,*TEXT") (-4 . "NOT>")))
      (vlax-for i asel
        (if (or (= :vlax-true (vla-get-lock (vla-item lays (vla-get-layer i))))
                (not (vlax-method-applicable-p i 'offset))
            )
          (setq locs (cons i locs))
        )
      )
      (if locs
        (vla-removeitems
          asel
          (vlax-safearray-fill
            (vlax-make-safearray vlax-vbobject (cons 0 (1- (length locs))))
            locs
          )
        )
      )
      (if (zerop (vla-get-count asel))
        (princ "\nНе выбрано подходящих объектов на незаблокированных слоях.")
        (progn
          (vla-startundomark adoc)
          (foreach memb param
            (setq offdist (car memb))
            (vlax-for i asel
              (if (zerop (setq dz (cadr memb)))
                (setq base i)
                (vla-move (setq base (vla-copy i))
                          (vlax-3d-point '(0 0 0))
                          (vlax-3d-point (list 0 0 dz))
                )
              )
              (if (not (zerop offdist))
                (progn (if (vl-catch-all-error-p
                             (setq vl-err (vl-catch-all-apply
                                            (function vla-offset)
                                            (list base offdist)
                                          )
                             )
                           )
                         (progn (setq vl-err-ent (cons i vl-err-ent))
                                (princ (strcat "\n" (vl-catch-all-error-message vl-err)))
                         )
                       )
                       (if (not (zerop dz))
                         (vla-erase base)
                       )
                )
              )
            )
          )
          (vla-endundomark adoc)
          (if (not (zerop (setq vl-err-cnt (length vl-err-ent))))
            (alert (strcat "При обработке "
                           (rtos vl-err-cnt 2 0)
                           " примитивов возникли ошибки!\nСмотри вывод в текстовом окне."
                   )
            )
          )
        )
      )
    )
    (alert
      "Не заданы параметры офсета! 
Формат задания параметров - (pl:moff2 '((x1 z1)(x2 z2) ... (xN zN))) 
где Xn и Zn - смещения относительно исходного объекта"
    )
  )
  (princ)
)

(progn
  (princ "\nFor button's macro only!\nCalling - (pl:moff2 '((x1 z1)(x2 z2) ... (xN zN))).")
  (princ)
)

Имя сделал другое, что бы не путалось.

Сообщение от dextron3 А еще можно четвертую матрицу добавить и получится швеллер!!! .....ну это я сам догадался :roll:

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

[Alaspher]

Сообщение от Sleekka Сорри за оффтоп, но другую тему открывать для этого смысла нету: На примере данной темы ярко раскрывается проблема невостребованности лисп-программистов или я ошибаюсь?

А разве не наоборот?

[Аshаs-ка]

;Развели... Давно есть и пользуюсь -
; как с сохранением центральной линии, так и с ее удалением!
;Вот только офсетит в обе стороны симметрично.. Ну, так офсет он и есть офсет...

;Вариант 1 dof.lsp (double offset)
;ВМЕСТО МОРДЫ ДОЛЖНА БЫТЬ ВОСЬМЕРКА И ЗАКРЫВАЮЩАЯ СКОБКА!!!....(< ang 0.78)(> .....

;****************************************************************************
;From the Desk of PAUL STANDING
;
;
;
;
;
; DOUBLE OFFSET DOF.lsp vs 1.0 March 28 1996
; Function creates an offset to either side of the selected entity
; and erases the original.
;
;
;
;
;*****************************************************************************
(defun cOF (/ a b b1 p1 d pckbox)
(setq d 20 p1 nil pee (/ pi 2)e 3 pckbox (getvar "pickbox")line " ")
(if(= #parof nil)(setq #parof(/(getvar "viewsize")10)))
(princ "\nCurrent offset <")(princ #parof)
(setq answer(getstring ">: "))
(if (/= (atof answer) 0.0)(setq #parof(atof answer)))

(princ line)
(setvar "pickbox" pckbox)
(setq ent(entsel "\nPick the line: "))
(setvar "pickbox" 2)
(setq point(cadr ent))
(princ line)
(setq side(getpoint "\nPick an offset side: "))
(setq dist(distance side point))(setq ang(angle side point))
(if(or(or(< ang 0.78)(> ang 5.5))(and(> ang 2.35)(< ang 3.92)))
(setq ang(- 0 ang))(setq ang(- pi ang))
);end if
(setq other(polar point ang dist))
(command "offset" #parof ent side ent other "")
(entdel(car ent))

(setvar "pickbox" pckbox)
(prin1)
)
(Prompt "\nType DOF to envoke the command")



;Вариант 2


;****************************************************************************
;From the Desk of PAUL STANDING
;
;
;
;
;
; DOUBLE OFFSET DOF.lsp vs 1.0 March 28 1996
; Function creates an offset to either side of the selected entity
; wisout delete of ojriginal
;*****************************************************************************
(defun cOF1 (/ a b b1 p1 d pckbox)
(setq d 20 p1 nil pee (/ pi 2)e 3 pckbox (getvar "pickbox")line " ")
(if(= #parof nil)(setq #parof(/(getvar "viewsize")10)))
(princ "\nCurrent offset <")(princ #parof)
(setq answer(getstring ">: "))
(if (/= (atof answer) 0.0)(setq #parof(atof answer)))

(princ line)
(setvar "pickbox" pckbox)
(setq ent(entsel "\nPick the line: "))
(setvar "pickbox" 2)
(setq point(cadr ent))
(princ line)
(setq side(getpoint "\nPick an offset side: "))
(setq dist(distance side point))(setq ang(angle side point))
(if(or(or(< ang 0.78)(> ang 5.5))(and(> ang 2.35)(< ang 3.92)))
(setq ang(- 0 ang))(setq ang(- pi ang))
);end if
(setq other(polar point ang dist))
(command "offset" #parof ent side ent other "")
; (entdel(car ent))

(setvar "pickbox" pckbox)
(prin1)
)
(Prompt "\nType DOF to envoke the command")




;Спасибо Паулю Стэндингу! В 1996 году какой автокад был в ходу?

[VVA]

Вариант Alaspher с допоболочкой

Код:

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

(defun C:MOFF ( / offlst )
  (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 pl:getoffdist ( / shg ret)
(setq shg (getstring T "\nПеречень дистанций подобия через пробел или _ (пример 25 12 -12):")
 shg  (vl-string-translate "_," " ." shg)
ret (str-str-lst shg " ")
ret (vl-remove-if '(lambda(x)(= x "")) ret)
ret (mapcar 'atof ret)
ret (vl-remove-if '(lambda(x)(zerop x)) ret))
  )
  
(vl-load-com) 
(defun pl:moff2 (param         /             adoc          asel          base 
                 dz            lays          locs          offdist       seln 
                 ssel          vl-err        vl-err-cnt    vl-err-ent 
                 pl:obj-filter-select-manual 
                ) 
  (if (= 'list (type param)) 
    (progn 
      (defun pl:obj-filter-select-manual (sel filter) 
        (vla-selectonscreen 
          sel 
          (vlax-safearray-fill 
            (vlax-make-safearray vlax-vbinteger (cons 0 (1- (length filter)))) 
            (mapcar (function car) filter) 
          ) 
          (vlax-safearray-fill 
            (vlax-make-safearray vlax-vbvariant (cons 0 (1- (length filter)))) 
            (mapcar (function cdr) filter) 
          ) 
        ) 
      ) 
      (setq adoc (vla-get-activedocument (vlax-get-acad-object)) 
            lays (vla-get-layers adoc) 
            ssel (vla-get-selectionsets adoc) 
            seln "pl:ooff-sel" 
      ) 
      (if (vl-catch-all-error-p 
            (setq asel (vl-catch-all-apply (function vla-item) (list ssel seln))) 
          ) 
        (setq asel (vla-add (vla-get-selectionsets adoc) seln)) 
      ) 
      (vla-clear asel) 
      (pl:obj-filter-select-manual asel '((-4 . "<NOT") (0 . "INSERT,*TEXT") (-4 . "NOT>"))) 
      (vlax-for i asel 
        (if (or (= :vlax-true (vla-get-lock (vla-item lays (vla-get-layer i)))) 
                (not (vlax-method-applicable-p i 'offset)) 
            ) 
          (setq locs (cons i locs)) 
        ) 
      ) 
      (if locs 
        (vla-removeitems 
          asel 
          (vlax-safearray-fill 
            (vlax-make-safearray vlax-vbobject (cons 0 (1- (length locs)))) 
            locs 
          ) 
        ) 
      ) 
      (if (zerop (vla-get-count asel)) 
        (princ "\nНе выбрано подходящих объектов на незаблокированных слоях.") 
        (progn 
          (vla-startundomark adoc) 
          (foreach memb param 
            (setq offdist (car memb)) 
            (vlax-for i asel 
              (if (zerop (setq dz (cadr memb))) 
                (setq base i) 
                (vla-move (setq base (vla-copy i)) 
                          (vlax-3d-point '(0 0 0)) 
                          (vlax-3d-point (list 0 0 dz)) 
                ) 
              ) 
              (if (not (zerop offdist)) 
                (progn (if (vl-catch-all-error-p 
                             (setq vl-err (vl-catch-all-apply 
                                            (function vla-offset) 
                                            (list base offdist) 
                                          ) 
                             ) 
                           ) 
                         (progn (setq vl-err-ent (cons i vl-err-ent)) 
                                (princ (strcat "\n" (vl-catch-all-error-message vl-err))) 
                         ) 
                       ) 
                       (if (not (zerop dz)) 
                         (vla-erase base) 
                       ) 
                ) 
              ) 
            ) 
          ) 
          (vla-endundomark adoc) 
          (if (not (zerop (setq vl-err-cnt (length vl-err-ent)))) 
            (alert (strcat "При обработке " 
                           (rtos vl-err-cnt 2 0) 
                           " примитивов возникли ошибки!\nСмотри вывод в текстовом окне." 
                   ) 
            ) 
          ) 
        ) 
      ) 
    ) 
    (alert 
      "Не заданы параметры офсета! 
Формат задания параметров - (pl:moff2 '((x1 z1)(x2 z2) ... (xN zN))) 
где Xn и Zn - смещения относительно исходного объекта" 
    ) 
  ) 
  (princ) 
) 
(vl-load-com)
(and (setq offlst (pl:getoffdist))
     (pl:moff2 (mapcar '(lambda(x)(list x 0)) offlst))
)
(princ)  
)

Команда MOFF
Перечень дистанций вводится через пробел (например 25 30 40)
или через _ для кнопок (например 25_30_-40). Можно вводить положительные и отрицательные значения.
Пример кнопки:

Код:

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

^C^CMOFF;25_40_-30;

[dextron3]

VVA, Alaspher,
отдельное спасибо!
[ATTACH]1183876200.JPG[/ATTACH]
:roll: :roll: :roll:
1 кнопка для трубопроводов, или фундаментных лент
2 кнопка уголок 63 левый или нижний
3 кнопка уголок 63 верхний или правый

Уголки как у Василия Кондрата "прокат" только привязку сделал по центру тяжести

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