Rак присвоить переменные точкам после деления объекта?

solo123 · 13.11.2009, 08:24

Как присвоить переменные точкам, после деления объекта с помощью (divide),
чтобы использовать их в дальнейшем, например, как точки соединения полилинией.
пример:
(command "_.ellipse" "_A" '(100.0 10.0) '(600.0 10.0) 200.0 180.0 0.0 )
(vl-cmdf "_.divide" (entlast) 6) ;как присвоить переменные x1 x2 x3 x4 x5 x6 этим шести точкам

Profan · 13.11.2009, 08:48

Эти точки можно выбрать опцией "_previous" ("текущий"). А дальше уже дело хозяйское.

solo123 · 13.11.2009, 09:38

а как эту опцию прописывать в лиспе?
например, я далее строю полилинию:
(command "_.PLINE" ???????? "_C")

Do$ · 13.11.2009, 10:44

Как пример:

Код:

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

(defun c:divide_test (/)
  (vl-load-com)
  (vl-cmdf "_.ucs" "_w" "_.divide" pause pause "_.pline")
  (foreach
	    b
	     (mapcar
	       '(lambda	(a)
		  (vlax-safearray->list
		    (vlax-variant-value
		      (vla-get-Coordinates (vlax-ename->vla-object a))
		    ) ;_ end of vlax-variant-value
		  ) ;_ end of vlax-safearray->list
		) ;_ end of lambda
	       (vl-remove-if
		 'listp
		 (mapcar 'cadr (ssnamex (ssget "_P")))
	       ) ;_ end of vl-remove-if
	     ) ;_ end of mapcar
    (vl-cmdf "_none" b)
  ) ;_ end of foreach
  (vl-cmdf "_C" "_.ucs" "_p")
) ;_ end of defun

CB · 13.11.2009, 16:00

Код:

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

(defun test ( / lst c)
 (vl-cmdf "_.ellipse" "_A" '(100.0 10.0) '(600.0 10.0) 200.0 180.0 0.0 )
 (setq c (entlast))
 (vl-cmdf "_.divide" (entlast) 6)
;список координат точек
 (while (setq c (entnext c))
   (setq lst (cons (cdr (assoc 10 (entget c))) lst))
 ) ;_ end of while
 
;;;(command "_pline")
;;;(apply 'command lst)
;;;(command)   
 
 (entmakex
   (append
     (list
       '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbPolyline")
       (cons 90 (length lst))
     ) ;_ end of list
     (mapcar '(lambda (x) (cons 10 x)) lst)
   ) ;_ end of append
 ) ;_ end of entmakex
  (princ)
)

solo123 · 13.11.2009, 18:17

Большое спасибо Do$! Дуга делиться, правда только линии начинаються со второй точки и заканчиваються предпоследней.

Do$ · 13.11.2009, 18:21

Пожалуйста! Ну так _divide начальную и конечную точки не выдает.
А если так:

Код:

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

(defun divid_arc (arc	      num	  /	      difference
		  center_point		  radius      start_angle
		  end_angle   lst
		 )
  (setq
    arc		 (entget arc)
    center_point (cdr (assoc 10 arc))
    radius	 (cdr (assoc 40 arc))
    end_angle	 (if (minusp (-	(setq end_angle (cdr (assoc 51 arc)))
				(setq start_angle (cdr (assoc 50 arc)))
			     ) ;_ end of -
		     ) ;_ end of minusp
		   (+ end_angle (* 2 pi))
		   end_angle
		 ) ;_ end of if
    difference	 (/ (- end_angle start_angle) num)
  ) ;_ end of setq
  (while (or (> end_angle start_angle)
	     (equal end_angle start_angle 1.0e-008)
	 ) ;_ end of or
    (setq lst	    (cons (polar center_point end_angle radius) lst)
	  end_angle (- end_angle difference)
    ) ;_ end of setq
  ) ;_ end of while
  lst
) ;_ end of defun



(defun c:da_test (/ arc num)
  (if (not
	(vl-catch-all-error-p
	  (vl-catch-all-apply
	    '(lambda ()
	       (while (not arc)
		 (setq arc (car (entsel "\nВыберите дугу:")))
		 (if (and arc (/= (cdr (assoc 0 (entget arc))) "ARC"))
		   (progn (princ "\nВыбрана не дуга!") (setq arc nil))
		 ) ;_ end of if
	       ) ;_ end of while
	       (while (not num)
		 (setq num
			(progn (initget 6) (getint "\nКоличество сегментов:"))
		 ) ;_ end of setq
	       ) ;_ end of while
	     ) ;_ end of lambda
	  ) ;_ end of vl-catch-all-apply
	) ;_ end of vl-catch-all-error-p
      ) ;_ end of not
    (entmakex
      (append
	(list
	  (cons 0 "LWPOLYLINE")
	  (cons 100 "AcDbEntity")
	  (cons 100 "AcDbPolyline")
	  (cons 90 (1+ num))
	  (cons 70 1)
	) ;_ end of list
	(mapcar '(lambda (a) (cons 10 a)) (divid_arc arc num))
      ) ;_ end of append
    ) ;_ end of entmakex
  ) ;_ end of if
) ;_ end of defun

Тьфу ты...

Цитата:

Дуга делиться

Не дуга же, а эллипс!
Зря старался...

solo123 · 14.11.2009, 16:10

Огромное спасибо! Дуга отлично делиться, не делиться только дуга эллипса.

Кулик Алексей aka kpblc · 14.11.2009, 21:47

А если так (код особо не гонял, говорю сразу; тестировалось только для 2D-объектов и только в мировой системе координат):

Код:

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

(vl-load-com)

(defun _dwgru-curve-divide (ent      range    /        start
                            end      res      step     len
                            sum_len  tmp_pt   closest_point
                            )
                           ;|
(mapcar '(lambda(x)(entmakex (list (cons 0 "point")(cons 10 x)))) (_dwgru-curve-divide nil nil))
|;
  (cond
    ((not ent)
     (if
       (= (type
            (setq
              ent (vl-catch-all-apply
                    (function
                      (lambda ()
                        (car (entsel "\nУкажите примитив <Отмена> : "))
                        ) ;_ end of lambda
                      ) ;_ end of function
                    ) ;_ end of vl-catch-all-apply
              ) ;_ end of setq
            ) ;_ end of type
          'ename
          ) ;_ end of =
        (setq res (_dwgru-curve-divide ent range))
        ) ;_ end of if
     )
    ((not range)
     (if
       (= (type
            (setq
              range (vl-catch-all-apply
                      (function
                        (lambda ()
                          (initget 7)
                          (getint "\nКоличество участков <Отмена> : ")
                          ) ;_ end of lambda
                        ) ;_ end of function
                      ) ;_ end of vl-catch-all-apply
              ) ;_ end of setq
            ) ;_ end of type
          'int
          ) ;_ end of =
        (setq res (_dwgru-curve-divide ent range))
        ) ;_ end of if
     )
    ((and ent
          range
          (member (type ent) (list 'ename 'vla-object))
          ) ;_ end of and
     (if (= (type ent) 'ename)
       (setq ent (vlax-ename->vla-object ent))
       ) ;_ end of if
     (setq res     (list (vlax-curve-getstartpoint ent))
           step    (/ (setq len (vlax-curve-getdistatpoint
                                  ent
                                  (vlax-curve-getendpoint ent)
                                  ) ;_ end of vlax-curve-getDistAtPoint
                            ) ;_ end of setq
                      (atof (itoa range))
                      ) ;_ end of /
           sum_len 0.
           ) ;_ end of setq
     (while (< sum_len len)
       (if (and (not (vl-catch-all-error-p
                       (vl-catch-all-apply
                         (function
                           (lambda ()
                             (setq tmp_pt (vlax-curve-getpointatdist
                                            ent
                                            (setq sum_len (+ sum_len step))
                                            ) ;_ end of vlax-curve-getpointatdist
                                   ) ;_ end of setq
                             ) ;_ end of lambda
                           ) ;_ end of function
                         ) ;_ end of vl-catch-all-apply
                       ) ;_ end of vl-catch-all-error-p
                     ) ;_ end of not
                (or (equal tmp_pt (vlax-curve-getendpoint ent) 1e-3)
                    (equal tmp_pt
                           (vlax-curve-getclosestpointto ent tmp_pt)
                           1e-3
                           ) ;_ end of equal
                    ) ;_ end of or
                ) ;_ end of and
         (setq res (append res
                           (list tmp_pt)
                           ) ;_ end of append
               ) ;_ end of setq
         ) ;_ end of if
       ) ;_ end of while
     )
    ) ;_ end of cond
  res
  ) ;_ end of defun

Do$ · 14.11.2009, 22:27

Алексей, вот это мастер-класс!

Кулик Алексей aka kpblc · 15.11.2009, 13:06

:?: Ты ж сам вроде подобное что-то писал...

Дима_ · 15.11.2009, 14:12

Для solo123:

Код:

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

(vl-load-com)
(defun c:arka ( / pt mnu tmp obj1 obj2 obj3 obj4 a1 a2 mspace)
(setq mspace (vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'Modelspace))
(if (not hirin) (setq hirin 1000 high 300 dopusk 5 profil 70 section 8))
(while (/= mnu "7")
(setq 
obj1 nil obj2 nil obj3 nil obj4 nil
mnu
(menu "Выберите параметры" (append (mapcar 'strcat '("1 - Ширина " "2 - Высота " "3 - Допуск " 
"4 - Профиль " "5 - Секций ")
(mapcar 'rtos (list hirin high dopusk profil section))) '("6 - Запуск" "7 - Выход"))
));end of menu&setq
(cond 
((= mnu "1") (setq tmp (getint "\nВведите ширину ") hirin (if tmp tmp hirin)))
((= mnu "2") (setq tmp (getint "\nВведите высоту ") high (if tmp tmp high)))
((= mnu "3") (setq tmp (getint "\nВведите допуск ") dopusk (if tmp tmp dopusk)))
((= mnu "4") (setq tmp (getint "\nВведите ширину профиля ") profil (if tmp tmp profil)))
((= mnu "5") (setq tmp (getint "\nВведите количество секций ") section (if tmp tmp section)))
);end of cond
(if (= mnu "6")
(if (and (> section 1) (> high (+ profil dopusk))  (> hirin (* 2 (+ profil dopusk))))
(progn 
(setq pt (getpoint "\nБазавая точка") a1 0 a2 (/ pi section))
(vla-startundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
(repeat section
(setq
obj1 (cons (arka pt hirin high a1 a2) obj1);верхние элипсы
obj2 (cons (arka pt (- hirin (* (+ profil dopusk) 2)) (- high (+ profil dopusk)) a1 a2) obj2);нижние элипсы
a1 a2
a2 (+ a2 (/ pi section))
);end of setq
);end of repeat
(setq
obj1	(mapcar '(lambda (obj / ret)
	(setq ret (vla-addline mspace (vla-get-startpoint obj) (vla-get-endpoint obj)))
	(vla-delete obj) ret);end of lambda
	obj1);end of mapcar - верхние элипсы в линию
obj2	(mapcar '(lambda (obj / ret)
	(setq ret (vla-addline mspace (vla-get-startpoint obj) (vla-get-endpoint obj)))
	(vla-delete obj) ret);end of lambda
	obj2);end of mapcar - нижние элипсы в линию
obj3	(cons
	(vla-addline mspace
			   (vlax-3d-point (cons (- (car pt) (/ hirin 2.0)) (cdr pt)))
			   (vla-get-endpoint (car obj2)));end of list
	(mapcar '(lambda (obj1 obj2)
	(vla-addline mspace (vla-get-startpoint obj1) (vla-get-startpoint obj2))
	);end of lambda
	obj1 obj2);end of mapcar
	);end of cons поперечины
tmp	(vlax-vla-object->ename (arka pt hirin high 0 pi));верхнея арка
);end of setq
(mapcar '(lambda (obj / ent ang)
(setq	ent (vlax-vla-object->ename obj)
	ang (- (angle (cod 10 ent) (cod 11 ent)) (/ pi 2))
);end of setq
(while (intersect ent tmp) 
(vla-move obj (vlax-3d-point '(0 0 0)) (vlax-3d-point (polar '(0 0 0) ang 1)))
);end of while
(vla-move obj (vlax-3d-point '(0 0 0)) (vlax-3d-point (polar '(0 0 0) ang dopusk)))
);end of lambda
obj1);end of mapcar перенос obj1 на точка "нексания" + допуск с шагом 1 мм.
(entdel tmp);удаление верхнией
(mapcar '(lambda (ent1 ent2) (longline ent1 ent2 T))
	(mapcar 'vlax-vla-object->ename obj1)
	(mapcar 'vlax-vla-object->ename (cdr obj3))
);end of mapcar дотягивание до начала поперечин
(mapcar '(lambda (ent1 ent2) (longline ent1 ent2 nil))
	(mapcar 'vlax-vla-object->ename obj1)
	(mapcar 'vlax-vla-object->ename (reverse (cdr (reverse obj3))))
);end of mapcar дотягивание до конца поперечин
(mapcar 'vla-delete obj3)
(setq
obj3	(mapcar '(lambda (obj1 obj2)
	(vla-addline mspace (vla-get-startpoint obj1) (vla-get-startpoint obj2))
	);end of lambda
	obj1 obj2);end of mapcar соединение начала верхнего элипса с нижним
obj4	(mapcar '(lambda (obj1 obj2)
	(vla-addline mspace (vla-get-endpoint obj1) (vla-get-endpoint obj2))
	);end of lambda
	obj1 obj2);end of mapcar соединение конца верхнего элипса с нижним
);end of setq
(mapcar '(lambda (obj1 obj2 obj3 obj4)
(makeregion (mapcar 'vlax-vla-object->ename (list obj1 obj2 obj3 obj4))));end of lambda
obj1 obj2 obj3 obj4);end of mapcar перевод "прямогугольников" в области
(mapcar '(lambda (lst) (mapcar 'vla-delete lst )) (list obj1 obj2 obj3 obj4)); удаление доп. построений
(setq	obj1 (arka pt hirin high 0 pi); верхний элипс
	obj2 (arka pt (- hirin (* 2 profil)) (- high profil) 0 pi); нижний элипс
	obj3 (vla-addline mspace (vla-get-startpoint obj1) (vla-get-startpoint obj2)); соединение 1
	obj4 (vla-addline mspace (vla-get-endpoint obj1) (vla-get-endpoint obj2)); соединение 2
);end of setq
(makeregion (mapcar 'vlax-vla-object->ename (list obj1 obj2 obj3 obj4))); в область
(mapcar 'vla-delete (list obj1 obj2 obj3 obj4)); удаление образующих
(vla-endundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
);end of progn
(alert "Несовместимые параметры")
));end of if*2
);end of while
(princ)
);end of arka 

(defun arka (pt s h a1 a2);элиптическая арка 
(vlax-ename->vla-object (entmakex 
(append
(list (cons 0 "ELLIPSE") (cons 100 "AcDbEntity") (cons 100 "AcDbEllipse") (cons 10 pt)) 
(if (<= (*(/ (float h) (float s)) 2.0) 1.0)
(list
(cons 11 (list (/ s 2.0) 0 0)) (cons 40 (*(/ (float h) (float s)) 2.0)) (cons 41 a1) (cons 42 a2)
);end of list
(list
(cons 11 (list 0 h 0)) (cons 40 (/ (/ (float s) (float h)) 2.0)) (cons 41 (- a1 (/ pi 2.0)))
									 (cons 42 (- a2 (/ pi 2.0))) 
);end of list
);end of if
);end of append
));end of entmakex&vlax-ename
);end of arka

(defun longline (ent1 ent2 st / pt)
(setq	st (if st 10 11)
	pt (inters (cod 10 ent1) (cod 11 ent1) (cod 10 ent2) (cod 11 ent2) nil)
	ent1 (entget ent1)
);end of setq
(entmod (subst (cons st pt) (assoc st ent1) ent1))
);end of longline

(defun cod (cd obj) ; возращает код cd примитива obj.
(if (and obj (= (type obj) 'ename))
(cdr (assoc cd (entget obj)))
));end of cod

(defun makeregion (objlst / sf) ; создает области из объектов списка objlist
(setq sf (vl-catch-all-apply
'(lambda (sf)
(setq sf (vlax-make-safearray vlax-vbobject (cons 0 (1- (length objlst)))))
(vlax-safearray-fill sf (mapcar 'vlax-ename->vla-object objlst))
(mapcar 'vlax-vla-object->ename (vlax-safearray->list (vlax-variant-value (vla-addregion mspace sf))))
);end of lambda
(list sf)
));end of catch&setq
(if (= (type sf) 'list) sf nil)
);end of makeregion

(defun intersect (obj1 obj2 / tmp x y); возращает список точек пересечениея объектов
(setq tmp 
(vlax-variant-value (apply 'vla-intersectwith
(reverse (cons acExtendNone (mapcar 'vlax-ename->vla-object (list obj1 obj2)))))))
(if (> (vlax-safearray-get-u-bound tmp 1) 0)
(vl-remove nil (mapcar '(lambda (z / ret) 
(if y (setq ret (list x y z) x nil y nil) (if x (setq y z) (setq x z))) ret) 
(vlax-safearray->list tmp)))
);end of if
);end of intersect
(princ "\nArka (v1.0) dimons@front.ru")
(princ)

Запускать командой arka (для "нормального" отображения пунктов меню - включи динамический ввод F12).

Do$ · 16.11.2009, 08:24

Цитата:

Сообщение от Кулик Алексей aka kpblc

:?: Ты ж сам вроде подобное что-то писал...

Определение аргументов функции рекурсией - для меня открытие!
Ну и в мелочах...

Offtop: П.С. Поясню маленько

Сидел позавчера вечером, делать было нечего. Думаю: дай-ка напишу эту программу для деления эллипса. Кнешна, сразу решил использовать ActiveX, написал, отладил, проверил и так и сяк - работает. Залез выложить - а тут уже твоя программа лежит

Сравнил и стало стыдно

- я почему-то вместо определения дистанции (getDistAtPoint, getdistatpoint...) пошел через параметр кривой (getstartparam, getparamatpoint...). В итоге получилось, что моя программа с полилиниями не подружилась.
Долго думал как цикл организовать, чтобы все точки оказались в списке... В while 2 или 3 условия прописал... А надо было просто заходить в цикл с уже внесенной в результирующий список первой координатой

Еще пару моментов отметил для себя, сейчас уже не особо помню каких...
Вот вроде мелочи - а чувствуешь, что не дотянул

solo123 · 16.11.2009, 11:03

Да... Мне до этого, как до "Китая", единственное, на что меня хватило в изучении основ лиспа, продемонстрировано далее, а с функциями Active X я, вообще, даже не знакомился. Если бы не Вы, делил бы я эти эллипсы еще неизвесно сколько времени.

Код:

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

( DEFUN c:arka  ( / x1 x2 xpr xdop xsek)
 
(setvar "cmdecho" 0)      ;отключение эха
 
(setvar "osmode" 0)      ;отключение объектной привязки
 
(command "ucs" "")      ;установка МСК
 
(command "ucsicon" "off")     ;выключение пиктограммы ПСК
 
(command "erase" "all" "")     ;очистка экрана
( INITGET 7 ) ; запрет пустого ввода и ввода чисел <=0
(setq x1 (getreal "\nШирина арки: "))
(setq x2 (getreal "\nВысота арки: "))
(setq xpr (getreal "\nШирина профиля арки: "))
(setq xdop (getreal "\nДопуск на обработку: "))
(setq xsek (getint "\nКоличество сегментов: "))
 
(IF(< (/ x1 2) x2) 
(progn(command "_.ellipse" "A" "0.0,0.0" (list x1 0.0) x2 90.0 -90.0 "") 
(command "_.ellipse" "A" (list (+ 0 xdop) 0.0) (list (- x1 xdop) 0.0) (- x2 xdop) 90.0 -90.0 "")
(vl-cmdf "_.divide" (entlast) xsek)
(command "_.ellipse" "A" (list (- 0 xpr) 0.0) (list (+ x1 xpr) 0.0) (+ x2 xpr) 90.0 -90.0 "")
(command "_.ellipse" "A" (list (- 0 xpr xdop) 0.0) (list (+ x1 xpr xdop) 0.0) (+ x2 xpr xdop) 90.0 -90.0 "")
(vl-cmdf "_.divide" (entlast) xsek))
(progn(command "_.ellipse" "A" "0.0,0.0" (list x1 0.0) x2 180.0 0.0 "")
(command "_.ellipse" "A" (list (+ 0 xdop) 0.0) (list (- x1 xdop) 0.0) (- x2 xdop) 180.0 0.0 "")
(vl-cmdf "_.divide" (entlast) xsek)
(command "_.ellipse" "A" (list (- 0 xpr) 0.0) (list (+ x1 xpr) 0.0) (+ x2 xpr) 180.0 0.0 "")
(command "_.ellipse" "A" (list (- 0 xpr xdop) 0.0) (list (+ x1 xpr xdop) 0.0) (+ x2 xpr xdop) 180.0 0.0 "")
(vl-cmdf "_.divide" (entlast) xsek))))

CB · 16.11.2009, 17:05

Практически тоже, что и у Алексея, только рекурсией:

Код:

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

(defun curve-divide (/ range ent)
  (if
    (not
      (vl-catch-all-error-p
        (vl-catch-all-apply
          '(lambda ()
             (initget 7)
             (setq
               range (getint
                       "\nКоличество участков <Отмена> : "
                     ) ;_ end of getint
             ) ;_ end of setq
             (setq ent
                    (vlax-ename->vla-object
                      (car (entsel
                             "\nУкажите примитив <Отмена> : "
                           ) ;_ end of entsel
                      ) ;_ end of car
                    ) ;_ end of vlax-ename->vla-object
             ) ;_ end of setq
           ) ;_ end of lambda
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of vl-catch-all-error-p
    ) ;_ end of not
     ((lambda (sp ep / rec-curve-divide)
        (defun rec-curve-divide (sd ed dd)
          (if (equal sd ed 1e-3)
            (list (vlax-curve-getEndPoint ent))
            (cons (vlax-curve-getPointAtDist ent sd)
                  (rec-curve-divide (+ sd dd) ed dd)
            ) ;_ end of cons
          ) ;_ end of if
        ) ;_ end of defun
        (rec-curve-divide sp ep (/ ep range))
      ) ;_ end of lambda
       0.0
       (vlax-curve-getDistAtParam
         ent
         (vlax-curve-getEndParam ent)
       ) ;_ end of vlax-curve-getDistAtParam
     )
  ) ;_ end of if
) ;_ end of defun
 
;Применение
(command "_pline")
(apply 'command (curve-divide))
(command)

13.11.2009, 08:24		#1
Rак присвоить переменные точкам после деления объекта? solo123 Регистрация: 19.08.2009 Сообщений: 91 Как присвоить переменные точкам, после деления объекта с помощью (divide), чтобы использовать их в дальнейшем, например, как точки соединения полилинией. пример: (command "_.ellipse" "_A" '(100.0 10.0) '(600.0 10.0) 200.0 180.0 0.0 ) (vl-cmdf "_.divide" (entlast) 6) ;как присвоить переменные x1 x2 x3 x4 x5 x6 этим шести точкам
Просмотров: 3622

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Снятие выделения с объекта после использования GRIPS	Torino	AutoCAD	10	19.02.2010 15:59
Экспертиза после постройки объекта	alexhach	Прочее. Архитектура и строительство	6	08.08.2008 19:53