Внутренний радиус командой fillet

Внутренний радиус командой fillet · 26.10.2009, 19:18

Есть необходимость делать радиуса на оборот (не выпуклым, а сделать впуклым ...)
Как сей момент можно реализовать?
У меня есть идея, но хз наскока реальная, надо чоб кто глянул из спецов по программированию или кто шарит луче меня

В файле вопрос и попытка к решению, только хз как програмно оформить...
Возможно в макросе, или LISP...

Positron · 11.11.2009, 14:03

Юзал и столкнулся с моментом когда скруглял полилинию и линию...
"Создание "вогнутого скругления" с выбранными объектами невозможно"
...
А можно добавить что б оно как у fillet было (но вогнутым естественно) обедняло выделенную линию с полелиниией... ?

Do$ · 11.11.2009, 16:39

Цитата:

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

столкнулся с моментом когда скруглял полилинию и линию

Между двумя полилиниями и во всех возможных сочетаниях "полилиния-любая линия" тоже не сработает.

Предлагаю перед inside_fillet использовать _explode на полилинию или _pl-join на линию и полилинию или _fillet с нулевым радиусом на оба примитива.
P.S.

Цитата:

_fillet с нулевым радиусом на оба примитива...

А ведь это мысль!

Пробуй:

Код:

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

(defun c:inside_fillet
		       (/	 ent1	  ent2	   rad	    obj
			tmp	 pt_lst	  ent_lst  mirror_arc
			mod	 old_cmdecho	   frp
		       )

  (defun mirror_arc (ent)
    (if	(= (cdr (assoc 0 (setq ent (entget ent)))) "ARC")
      (entmod
	(append
	  (list
	    (assoc -1 ent)
	    (cons
	      10
	      (apply
		'(lambda (u v)
		   (polar u (angle u v) (* 2 (distance v u)))
		 ) ;_ end of lambda
		(list
		  (cdr (assoc 10 ent))
		  (apply
		    '(lambda (a b)
		       (mapcar '(lambda (c d) (/ (+ c d) 2)) a b)
		     ) ;_ end of lambda
		    (mapcar
		      '(lambda (m)
			 (polar	(cdr (assoc 10 ent))
				m
				(cdr (assoc 40 ent))
			 ) ;_ end of polar
		       ) ;_ end of lambda
		      (mapcar '(lambda (n) (cdr (assoc n ent)))
			      '(50 51)
		      ) ;_ end of mapcar
		    ) ;_ end of mapcar
		  ) ;_ end of apply
		) ;_ end of list
	      ) ;_ end of apply
	    ) ;_ end of cons
	  ) ;_ end of list
	  (mapcar '(lambda (k) (cons k (+ (cdr (assoc k ent)) pi)))
		  '(50 51)
	  ) ;_ end of mapcar
	) ;_ end of append
      ) ;_ end of entmod
    ) ;_ end of if
  ) ;_  defun
  (vl-load-com)
  (vla-StartUndoMark
    (vla-get-ActiveDocument (vlax-get-acad-object))
  ) ;_ end of vla-StartUndoMark
  (setq old_cmdecho (getvar 'CMDECHO))
  (setvar 'CMDECHO 0)
  (princ (strcat "\nТекущий радиус скругления:"
		 (rtos (getvar 'FILLETRAD) 2 4)
		 ". Текущий режим обрезки:"
		 (if (= (getvar 'TRIMMODE) 1)
		   "\"Обрезать концы\""
		   "\"Не обрезать концы\""
		 ) ;_ end of if
	 ) ;_ end of strcat
  ) ;_ end of princ
;;;  (setq ent1 nil ent2 nil)
  (while (and
	   (/= ent1 "Cancel")
	   (not (vl-catch-all-error-p ent1))
	   (not (vl-catch-all-error-p ent2))
	   (not (vl-catch-all-error-p rad))
	   (not	(and
		  (listp ent1)
		  (listp ent2)
		  (= (type (car ent1)) 'ENAME)
		  (= (type (car ent2)) 'ENAME)
		) ;_ end of and
	   ) ;_ end of not
	 ) ;_ end of and
    (if	ent1
      (progn
	(cond
	  ((and	(= (type ent1) 'STR)
		(= ent1 "Radius")
	   ) ;_ end of and
	   (initget (+ 4 128))
	   (cond
	     ((and (setq
		     ent1 nil
		     rad  (vl-catch-all-apply
			    '(lambda ()
			       (getdist
				 (strcat "\nРадиус внутреннего скругления:<"
					 (rtos (getvar 'FILLETRAD) 2 4)
					 ">"
				 ) ;_ end of strcat
			       ) ;_ end of getdist
			     ) ;_ end of lambda
			  ) ;_ end of vl-catch-all-apply
		   ) ;_ end of setq
		   (not (vl-catch-all-error-p rad))
	      ) ;_ end of and
	      (setvar 'FILLETRAD rad)
	     )
	     ((not rad)
	      (princ (rtos (getvar 'FILLETRAD) 2 4))
	     )
	   ) ;_ end of if
	  )
	  ((and	(= (type ent1) 'STR)
		(= ent1 "Mode")
	   ) ;_ end of and
	   (initget "Да Нет _Yes No")
	   (setq ent1 nil
		 mod  (vl-catch-all-apply
			'(lambda ()
			   (getkword (strcat "Обрезать концы?:<"
					     (if (= (getvar 'TRIMMODE) 1)
					       "Да"
					       "Нет"
					     ) ;_ end of if
					     ">[Да/ Нет]"
				     ) ;_ end of strcat
			   ) ;_ end of getkword
			 ) ;_ end of lambda
		      ) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	   (cond
	     ((or (and (= (type mod) 'STR) (= mod "Yes"))
		  (not mod)
	      ) ;_ end of or
	      (setvar 'TRIMMODE 1)
	     )
	     ((and (= (type mod) 'STR) (= mod "No"))
	      (setvar 'TRIMMODE 0)
	     )
	   ) ;_ end of cond
	  )
	  ((and (listp ent1) (= (type (car ent1)) 'ENAME))
	   (setq ent2
		  (vl-catch-all-apply
		    (function (lambda () (entsel "\nУкажите второй объект:")))
		  ) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	  )
	) ;_ end of cond
      ) ;_ end of progn
      (progn
	(initget "Радиус реЖим Отмена _Radius Mode Cancel")
	(if
	  (or
	    (vl-catch-all-error-p rad)
	    (vl-catch-all-error-p mod)
	    (not
	      (setq
		ent1
		 (vl-catch-all-apply
		   (function
		     (lambda ()
		       (entsel
			 "\nУкажите первый объект, или:<Отмена>[Радиус/ реЖим/ Отмена]"
		       ) ;_ end of entsel
		     ) ;_ end of lambda
		   ) ;_ end of function
		 ) ;_ end of vl-catch-all-apply
	      ) ;_ end of setq
	    ) ;_ end of not
	  ) ;_ end of or
	   (setq ent1 "Cancel")
	) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of while
  (if (and
	(listp ent1)
	(listp ent2)
	(= (type (car ent1)) 'ENAME)
	(= (type (car ent2)) 'ENAME)
      ) ;_ end of and
    (cond
      (
       (or
	 (and (eq (car ent1) (car ent2))
	      (wcmatch (cdr (assoc 0 (entget (car ent1)))) "*POLYLINE")
	      (or c:pl-join (/= (load "pltools" "Not") "Not"))
	 ) ;_ end of and
	 (and
	   (not (eq (car ent1) (car ent2)))
	   (or (wcmatch (cdr (assoc 0 (entget (car ent1)))) "*POLYLINE")
	       (wcmatch (cdr (assoc 0 (entget (car ent2)))) "*POLYLINE")
	   ) ;_ end of or
                (or c:pl-join (/= (load "pltools" "Not") "Not"))
	 ) ;_ end of and
       ) ;_ end of or
       (progn
	 (if
	   (and
	     (not (eq (car ent1) (car ent2)))
	     (or
	       (wcmatch (cdr (assoc 0 (entget (car ent1)))) "*POLYLINE")
	       (wcmatch (cdr (assoc 0 (entget (car ent2)))) "*POLYLINE")
	     ) ;_ end of or
	   ) ;_ end of and
	    (progn
	      (setq frp (getvar 'FILLETRAD))
	      (setvar 'FILLETRAD 0)
	      (vl-cmdf "_.fillet" ent1 ent2)
	      (vl-cmdf)
	      (setvar 'FILLETRAD frp)
	      (if
		(or
		  (not (entupd (car ent1)))
		  (not (entupd (car ent2)))
		) ;_ end of or
		 (if (not (entupd (car ent1)))
		   (setq ent1 (list (car ent2) (cadr ent1)))
		 ) ;_ end of if
		 (progn
		   (princ
		     "\nСоздание скругления с выбранными объектами невозможно"
		   ) ;_ end of princ
		   (setq ent1 nil)
		 ) ;_ end of progn
	      ) ;_ end of if
	    ) ;_ end of progn
	 ) ;_ end of if
	 (if ent1
	   (progn
	     (setq pt_lst  (mapcar
			     '(lambda (x)
				(vlax-curve-getclosestpointto
				  (setq
				    obj	(vlax-ename->vla-object (car ent1))
				  ) ;_ end of setq
				  x
				) ;_ end of vlax-curve-getclosestpointto
			      ) ;_ end of lambda
			     (list (cadr ent1) (cadr ent2))
			   ) ;_ end of mapcar
		   ent_lst (vlax-safearray->list
			     (vlax-variant-value (vla-explode obj))
					;!!!
			   ) ;_ end of vlax-safearray->list
		   ent1	   (progn
			     (entdel (car ent1))
			     (list (vlax-vla-object->ename
				     (car
				       (vl-remove-if
					 '(lambda (x)
					    (not
					      (vlax-curve-getParamAtPoint
						x
						(car pt_lst)
					      ) ;_ end of vlax-curve-getParamAtPoint
					    ) ;_ end of not
					  ) ;_ end of lambda
					 ent_lst
				       ) ;_ end of vl-remove-if
				     ) ;_ end of car
				   ) ;_ end of vlax-vla-object->ename
				   (car pt_lst)
			     ) ;_ end of list
			   ) ;_ end of progn
		   ent2	   (list (vlax-vla-object->ename
				   (car
				     (vl-remove-if
				       '(lambda	(x)
					  (not (vlax-curve-getParamAtPoint
						 x
						 (cadr pt_lst)
					       ) ;_ end of vlax-curve-getParamAtPoint
					  ) ;_ end of not
					) ;_ end of lambda
				       ent_lst
				     ) ;_ end of vl-remove-if
				   ) ;_ end of car
				 ) ;_ end of vlax-vla-object->ename
				 (cadr pt_lst)
			   ) ;_ end of list
	     ) ;_ end of setq
	     (vl-catch-all-apply
	       (function
		 (lambda (/ ss)
		   (vl-cmdf "_.fillet" ent1 ent2)
		   (if (= (getvar 'FILLETRAD) 0)
		     (setq ss (ssadd))
		     (setq ss (ssadd (cdar (mirror_arc (entlast)))))
		   ) ;_ end of if
		   (while ent_lst
		     (ssadd (vlax-vla-object->ename (car ent_lst))
			    ss
		     ) ;_ end of ssadd
		     (setq ent_lst (cdr ent_lst))
		   ) ;_ end of while
		   (sssetfirst nil ss)
		   (vl-cmdf (c:pl-join))
		 ) ;_ end of lambda
	       ) ;_ end of function
	     ) ;_ end of vl-catch-all-apply
	   ) ;_ end of progn
	 ) ;_ end of if
       ) ;_ end of progn
      )
      ((and
	 (not (eq (car ent1) (car ent2)))
	 (not
	   (wcmatch (cdr (assoc 0 (entget (car ent1)))) "*POLYLINE")
	 ) ;_ end of not
	 (not
	   (wcmatch (cdr (assoc 0 (entget (car ent2)))) "*POLYLINE")
	 ) ;_ end of not
       ) ;_ end of and
       (vl-catch-all-apply
	 '(lambda ()
	    (vl-cmdf "_.fillet" ent1 ent2)
	    ((/= (getvar 'FILLETRAD) 0) (mirror_arc (entlast)))
	  ) ;_ end of lambda
       ) ;_ end of vl-catch-all-apply
      )
      (T
       (princ
	 "\nСоздание скругления с выбранными объектами невозможно"
       ) ;_ end of princ
      )
    ) ;_ end of cond
  ) ;_ end of if
  (setvar 'CMDECHO old_cmdecho)
  (vla-EndUndoMark
    (vla-get-ActiveDocument (vlax-get-acad-object))
  ) ;_ end of vla-EndUndoMark
  (princ)
) ;_ end of defun

Dobrolet · 03.02.2010, 14:02

А возможно ли доработать и для тел (делать на ребрах)

.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Минимальный радиус кривизны пути монорельса	Дмитрий_М	Конструкции зданий и сооружений	23	22.02.2018 14:57
как задать точный радиус полилинии?	uyka	AutoCAD	18	12.10.2009 13:46