список координат центров окружностей

Holon · 12.06.2008, 08:47

Задача получить список координат и соответствующих диаметров отверстий, путем указания базовой точки и последующего выделения региона с несколькими отверстиями, после этого (лисп) должен вернуть список всех координат и диаметров отверстий, пример:

X______Y_____Z____Diametr
*************************
200.0___25.0___0.0____16.0
900.0___25.0___0.0____16.0
100.0___900.0__0.0____14.0
100.0___500.0__0.0____12.0

*************************

rocker · 12.06.2008, 09:23

Цитата:

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

Задача получить список координат и соответствующих диаметров отверстий, путем указания базовой точки и последующего выделения региона с несколькими отверстиями, после этого (лисп) должен вернуть список всех координат и диаметров отверстий, пример:

X______Y_____Z____Diametr
*************************
200.0___25.0___0.0____16.0
900.0___25.0___0.0____16.0
100.0___900.0__0.0____14.0
100.0___500.0__0.0____12.0

*************************

В AutoCAD Mechanical есть команда _amholeChart --это то,что Вам нужно.Как сделать это в классическом ACAD-е где-то уже обсуждалось на этом форуме,поищите,пожалуйста.

Holon · 12.06.2008, 09:38

Да в Механикле это работает, а в обычном АКаде я пока ненашел тему.

rocker · 12.06.2008, 09:57

Цитата:

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

Да в Механикле это работает, а в обычном АКаде я пока ненашел тему.

Посмотрите,пожалуйста,может это поможет:

http://www.caduser.ru/cgi-bin/f1/board.cgi?t=21256GT

http://www.caduser.ru/cgi-bin/f1/board.cgi?t=25434NY

fixo · 12.06.2008, 13:54

Посмотри как у тебя будет работать
Нет времени на лакировку, по мелочи
доделай сам:

Код:

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

(defun sortby (unsorted)
(setq sorted_by_position
       (vl-sort-i unsorted
	 (function
	   (lambda (a b)
	     (< (car a) (car b))))))
(setq sorted_physically
       (mapcar (function (lambda (x)
		(nth x unsorted))) sorted_by_position)
      )
  )
(vl-load-com)
;;;*******************************************************;;
(defun C:OTV (/ acsp ac_table adoc base col col_names col_num cor1 cor2 cp data dia dmz elist en header header_txt_hgt lpc lup max_1_wid max_2_wid max_3_wid max_wid pin row row_hgt row_num ss tbl_data tmp txt_hgt)

(or adoc
    (setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "CVPORT") 1)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc)
)
)
    )
(vla-endundomark
  adoc)  
(vla-startundomark
  adoc)

  (setq lup (getvar "lunits"))
(setvar "lunits" 2); metric units
(setq lpc (getvar "luprec"))
(setvar "luprec" 3);precision
(setq dmz (getvar "dimzin"))  
(setvar "dimzin" 8);suppress zeros for primary unit 

(setq base (getpoint "\nБазовая точка: "))
(setq cor1 (getpoint "\nНижняя левая точка рамки выбора: ")
      cor2 (getcorner cor1 "\nВерхняя правая точка рамки выбора: ")
      )
(if (setq ss (ssget "_W" cor1 cor2 '((0 . "CIRCLE"))))
  (progn
    (while (setq en (ssname ss 0))
      (setq elist (entget en)
	    cp (mapcar '- (cdr (assoc 10 elist)) base)
	    dia (* 2 (cdr (assoc 40 elist)))
	    tmp (list (car cp)(cadr cp)(caddr cp) dia )
	    tbl_data (cons tmp tbl_data))
      (ssdel en ss)
      )
    )
  )

(setq tbl_data (sortby tbl_data))

(setq tbl_data (mapcar (function (lambda(x)
			(list
			  (rtos (car x) 2 3)
			  (rtos (cadr x) 2 3)
			  (rtos (caddr x) 2 3)
			  (rtos (last x) 2 1))))
		       tbl_data
		       )
      )



(setq pin (vlax-3d-point
	      (getpoint "\nТочка вставки таблицы: "))
      row_hgt 12.0
      header_txt_hgt 9.0
      txt_hgt 9.0)
(setq header "Title" col_names (list "X" "Y" "Z" "Diameter"))

(setq max_1_wid (apply 'max (mapcar 'strlen (mapcar 'car tbl_data)))
      max_2_wid (apply 'max (mapcar 'strlen (mapcar 'cadr tbl_data)))
      max_3_wid (apply 'max (mapcar 'strlen (mapcar 'caddr tbl_data)))
      max_wid (* 1.25 (apply 'max (list max_1_wid max_2_wid max_3_wid))))

(setq ac_table (vla-addtable acsp pin 
                    (+ (length (car tbl_data)) 2) 
                    (length col_names)
                    row_hgt
                    (* txt_hgt max_wid))
      )
(vla-put-regeneratetablesuppressed ac_table :vlax-true)
(vla-settext ac_table 0 0 header)
(vla-setcellalignment ac_table 0 0 acmiddlecenter)
(vla-setcelltextheight ac_table 0 0 header_txt_hgt)
(vla-setrowheight ac_table 0 (* header_txt_hgt 2))  
(setq col 0)
  
(foreach item col_names
(vla-settext ac_table 1 col item)
(vla-setcellalignment ac_table 1 col acmiddlecenter)
(vla-setcelltextheight ac_table 1 col txt_hgt)
(setq col (1+ col)))
  
(setq row 2
      col 0
      row_num (length (car tbl_data))
      col_num (length col_names))
(repeat row_num
(setq col 0)
(setq data (car tbl_data))  
(repeat col_num
(vla-settext ac_table row col (car data))
(vla-setcellalignment ac_table row col acmiddlecenter)
(vla-setcelltextheight ac_table row col txt_hgt)
(setq data (cdr data))  
(setq col (1+ col))
)  
(setq row (1+ row))  
(setq tbl_data (cdr tbl_data))  
)
  (vla-put-regeneratetablesuppressed ac_table :vlax-false)
  (setvar "luprec" lpc)
  (setvar "lunits" lup)
  (setvar "dimzin" dmz)     
(vla-endundomark
  adoc)  
(princ)
  )

~'J'~

Holon · 13.06.2008, 09:45

Все работает отлично, спасибо.

fixo · 13.06.2008, 13:10

Рад помочь
Успехов,

~'J'~

Holon · 15.06.2008, 09:02

Я сразу незаметил, лисп выдает только четыре строчки в таблице

fixo · 15.06.2008, 12:51

Цитата:

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

Я сразу незаметил, лисп выдает только четыре строчки в таблице

Ты прав, тут я лоханулся чуток

Исправленная версия:

Код:

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

(defun sortby (unsorted)
(setq sorted_by_position
       (vl-sort-i unsorted
	 (function
	   (lambda (a b)
	     (< (car a) (car b))))))
(setq sorted_physically
       (mapcar (function (lambda (x)
		(nth x unsorted))) sorted_by_position)
      )
  )
(vl-load-com)
;;;*******************************************************;;
(defun C:OTV (/ acsp ac_table adoc base col col_names col_num cor1 cor2 cp data dia dmz elist en header header_txt_hgt lpc lup max_1_wid max_2_wid max_3_wid max_wid pin row row_hgt row_num ss tbl_data tmp txt_hgt)

(or adoc
    (setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "CVPORT") 1)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc)
)
)
    )
(vla-endundomark
  adoc)  
(vla-startundomark
  adoc)

  (setq lup (getvar "lunits"))
(setvar "lunits" 2); metric units
(setq lpc (getvar "luprec"))
(setvar "luprec" 3);precision
(setq dmz (getvar "dimzin"))  
(setvar "dimzin" 8);suppress zeros for primary unit 

(setq base (getpoint "\nБазовая точка: "))
(setq cor1 (getpoint "\nНижняя левая точка рамки выбора: ")
      cor2 (getcorner cor1 "\nВерхняя правая точка рамки выбора: ")
      )
(if (setq ss (ssget "_W" cor1 cor2 '((0 . "CIRCLE"))))
  (progn
    (while (setq en (ssname ss 0))
      (setq elist (entget en)
	    cp (mapcar '- (cdr (assoc 10 elist)) base)
	    dia (* 2 (cdr (assoc 40 elist)))
	    tmp (list (car cp)(cadr cp)(caddr cp) dia )
	    tbl_data (cons tmp tbl_data))
      (ssdel en ss)
      )
    )
  )

(setq tbl_data (sortby tbl_data))

(setq tbl_data (mapcar (function (lambda(x)
			(list
			  (rtos (car x) 2 3)
			  (rtos (cadr x) 2 3)
			  (rtos (caddr x) 2 3)
			  (rtos (last x) 2 1))))
		       tbl_data
		       )
      )



(setq pin (vlax-3d-point
	      (getpoint "\nТочка вставки таблицы: "))
      row_hgt 12.0
      header_txt_hgt 9.0
      txt_hgt 9.0)
(setq header "Title" col_names (list "X" "Y" "Z" "Diameter"))

(setq max_1_wid (apply 'max (mapcar 'strlen (mapcar 'car tbl_data)))
      max_2_wid (apply 'max (mapcar 'strlen (mapcar 'cadr tbl_data)))
      max_3_wid (apply 'max (mapcar 'strlen (mapcar 'caddr tbl_data)))
      max_wid (* 1.25 (apply 'max (list max_1_wid max_2_wid max_3_wid))))

(setq ac_table (vla-addtable acsp pin 
                    (+ (length tbl_data) 2) 
                    (length col_names)
                    row_hgt
                    (* txt_hgt max_wid))
      )
(vla-put-regeneratetablesuppressed ac_table :vlax-true)
(vla-settext ac_table 0 0 header)
(vla-setcellalignment ac_table 0 0 acmiddlecenter)
(vla-setcelltextheight ac_table 0 0 header_txt_hgt)
(vla-setrowheight ac_table 0 (* header_txt_hgt 2))  
(setq col 0)
  
(foreach item col_names
(vla-settext ac_table 1 col item)
(vla-setcellalignment ac_table 1 col acmiddlecenter)
(vla-setcelltextheight ac_table 1 col txt_hgt)
(setq col (1+ col)))
  
(setq row 2
      col 0
      row_num (length tbl_data)
      col_num (length col_names))
  
(repeat row_num
(setq col 0)
(setq data (car tbl_data))  
(repeat col_num
(vla-settext ac_table row col (car data))
(vla-setcellalignment ac_table row col acmiddlecenter)
(vla-setcelltextheight ac_table row col txt_hgt)
(setq data (cdr data))  
(setq col (1+ col))
)  
(setq row (1+ row))  
(setq tbl_data (cdr tbl_data))  
)
  (vla-put-regeneratetablesuppressed ac_table :vlax-false)
  (setvar "luprec" lpc)
  (setvar "lunits" lup)
  (setvar "dimzin" dmz)     
(vla-endundomark
  adoc)  
(princ)
  )

~'J'~

Holon · 15.06.2008, 13:36

Ну теперь совсем другое дело, большее спасибо!

12.06.2008, 08:47		#1
список координат центров окружностей Holon CNC Israel Регистрация: 07.07.2007 Сообщений: 302 Задача получить список координат и соответствующих диаметров отверстий, путем указания базовой точки и последующего выделения региона с несколькими отверстиями, после этого (лисп) должен вернуть список всех координат и диаметров отверстий, пример: X______Y_____Z____Diametr *********************** 200.0___25.0___0.0____16.0 900.0___25.0___0.0____16.0 100.0___900.0__0.0____14.0 100.0___500.0__0.0____12.0 ***********************
Просмотров: 3732

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Округление координат, полилиний, центров окружностей, блоков	MA2	Программирование	44	15.01.2015 15:19
SCAD Office 11.1 Новые возможности	EUDGEN	SCAD	632	20.02.2013 17:13
2 системы координат в одном файле	SStas	AutoCAD	8	20.06.2007 10:22
Помощь по Лире	Серега М	Лира / Лира-САПР	52	28.05.2007 02:47
управление системой координат Автокад из Делфей	Владимир В	Программирование	12	27.04.2005 09:54