> 1 <
Автор | Сообщение |
Doub1ejW
1 сообщений |
#7892 2018-07-09 16:30 GMT+3 часа(ов) |
Добрый день. Необходимо немного изменить лисп, а именно формат таблицы в xls. Сам в лиспах полный 0. прошу помочь.
(vl-load-com) (defun *error* (msg) (princ) ) (defun c:geo_table () (initget 1 "Полилиния Точки") (setq x (getkword "\nПостроить ведомость по [Полилиния/Точки]: ")) (if (= x "Полилиния") (ExportInExcel) (geo_point_table)) );_end defun (defun geo-create-object (AppString) (vlax-create-object AppString) );_end defun (defun geo_get_distance (pnt1 pnt2) (setq pnt1 (list (car pnt1) (cadr pnt1))) (setq pnt2 (list (car pnt2) (cadr pnt2))) (distance pnt1 pnt2) );_end defun (defun geo_get_angle (pnt1 pnt2) (setq pnt1 (list (car pnt1) (cadr pnt1))) (setq pnt2 (list (car pnt2) (cadr pnt2))) (angle pnt1 pnt2) );_end defun (defun geo-add-text (TextString InsertionPoint Height Alignment Rotation / obj) (if (null Alignment) (setq Alignment acAlignmentLeft)) (setq obj (vla-addtext (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))) TextString (if (or (= Alignment acAlignmentAligned) (= Alignment acAlignmentFit)) (vlax-3d-point (car InsertionPoint)) (vlax-3d-point InsertionPoint) ) Height)) (cond ((= Alignment acAlignmentLeft) (vla-put-rotation obj Rotation)) ((or (= Alignment acAlignmentAligned) (= Alignment acAlignmentFit)) (vla-put-alignment obj Alignment) (vla-put-textalignmentpoint obj (vlax-3d-point (cadr InsertionPoint))) ) (T (vla-put-alignment obj Alignment) (vla-put-textalignmentpoint obj (vlax-3d-point InsertionPoint)) (vla-put-rotation obj Rotation) ) (vla-update obj) );_end cond );_end defun (defun geo-add-line (StartPoint EndPoint Lineweight / obj) (setq obj (vla-addline (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object))) (vlax-3d-point StartPoint) (vlax-3d-point EndPoint))) (cond ((vlax-write-enabled-p obj) (if Lineweight (vla-put-lineweight obj Lineweight)) (vla-update obj) )) );_end defun (defun list-massoc (key alist) (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist)) ) (defun pline-list-vertex (ent / list_vertex tmp_ent type_ent) (setq tmp_ent ent ent (entget ent) type_ent (cdr (assoc 0 ent)) ) ;_ end of setq (cond ((= "LWPOLYLINE" type_ent) (list (list-massoc 10 ent) (= 1 (logand 1 (cdr (assoc 70 ent))))) ) ((= "POLYLINE" type_ent) (reverse (cons (= 1 (logand 1 (cdr (assoc 70 ent)))) (while (and (setq tmp_ent (entnext tmp_ent)) (/= (cdr (assoc 0 (setq ent (entget tmp_ent)))) "SEQEND" ) ;_ end of = ) ;_ end of and (setq list_vertex (cons (cdr (assoc 10 ent)) list_vertex)) ) ;_ end of while ) ;_ end of cons ) ;_ end of reverse ) ((= "LINE" type_ent) (list (cons (cdr (assoc 10 ent)) (cons (cdr (assoc 11 ent)) nil)) nil) ) (t nil) ) ;_ end of cond ) ;_ end of defun (defun ExportInExcel () (setq ent (car (entsel "\nУкажите полилинию: "))) (setq lst (car (pline-list-vertex ent))) (setq point_count (length lst)) (setq point_number 0) ;(vl-load-com) (setq g_oex (vlax-get-or-create-object "Excel.Application")) (vlax-put-property g_oex "UseSystemSeparators" :vlax-false) ;_не использовать системные установки (vlax-put-property g_oex "DecimalSeparator" ".") ;_разделитель дробной и целой части (vlax-put-property g_oex "ThousandsSeparator" " ") ;_разделитель тысячей (vlax-put-property g_oex 'SheetsInNewWorkbook 1) (vlax-put-property g_oex 'Visible :vlax-true) (setq g_wbs (vlax-get-property g_oex 'Workbooks)) (setq g_cb (vlax-invoke-method g_wbs 'Add)) (setq g_shs (vlax-get-property g_cb 'Sheets)) (setq g_csh (vlax-get-property g_shs 'Item 1)) (vlax-put-property g_csh 'Name "Координаты") (repeat point_count (setq pt (nth point_number lst));координаты текущей узловой точки (setq pt_next (nth (rem (1+ point_number) point_count) lst));координаты следующей узловой точки (по кругу) (setq X (car pt));координата X точки (setq Y (cadr pt));кооордината Y точки (setq X_next (car pt_next));координата X следующей точки (setq Y_next (cadr pt_next));координата Y следующей точки (setq Dist (geo_get_distance pt pt_next));расстояние между двумя координатами (setq Ang (geo_get_angle (list Y X) (list Y_next X_next)));угол между двумя координатами (setq StAng (angtos ang 1 3));Преобразовываем в строку (setq StAng (vl-string-subst "° " "d" StAng));Заменяем символ d(град) на символ '° ' (setq StAng (vl-string-subst "' " "'" stang));Заменяем символ '(мин) на символ '' ' (setq RangeN (strcat "A" (itoa (1+ point_number))));Диапазон ячеек для номера точки (setq RangeX (strcat "B" (itoa (1+ point_number))));Диапазон ячеек для координаты X (setq RangeY (strcat "C" (itoa (1+ point_number))));Диапазон ячеек для координаты Y (setq RangeD (strcat "D" (itoa (1+ point_number))));Диапазон ячеек для расстояния (setq RangeA (strcat "E" (itoa (1+ point_number))));Диапазон ячеек для угла (setq g_r0 (vlax-get-property g_oex "Range" RangeN)) (setq g_r1 (vlax-get-property g_oex "Range" RangeX)) (setq g_r2 (vlax-get-property g_oex "Range" RangeY)) (setq g_r3 (vlax-get-property g_oex "Range" RangeD)) (setq g_r4 (vlax-get-property g_oex "Range" RangeA)) (vlax-put-property g_r0 "value2" (1+ point_number)) (vlax-put-property g_r1 "value2" (rtos Y 2 2)) (vlax-put-property g_r2 "value2" (rtos X 2 2)) (vlax-put-property g_r3 "value2" (rtos Dist 2 2)) (vlax-put-property g_r4 "value2" StAng) (setq point_number (1+ point_number)) );end of repeat (vlax-put-property g_oex "UseSystemSeparators" :vlax-true) ;_использовать системные установки (if (and g_r0 (not (vlax-object-released-p g_r0))) (vlax-release-object g_r0)) (if (and g_r1 (not (vlax-object-released-p g_r1))) (vlax-release-object g_r1)) (if (and g_r2 (not (vlax-object-released-p g_r2))) (vlax-release-object g_r2)) (if (and g_r3 (not (vlax-object-released-p g_r3))) (vlax-release-object g_r3)) (if (and g_r4 (not (vlax-object-released-p g_r4))) (vlax-release-object g_r4)) (if (and g_csh (not (vlax-object-released-p g_csh))) (vlax-release-object g_csh)) (if (and g_shs (not (vlax-object-released-p g_shs))) (vlax-release-object g_shs)) (if (and g_cb (not (vlax-object-released-p g_cb))) (vlax-release-object g_cb)) (if (and g_wbs (not (vlax-object-released-p g_wbs))) (vlax-release-object g_wbs)) (if (and g_oex (not (vlax-object-released-p g_oex))) (vlax-release-object g_oex)) ;Обнуление использованных глобальных переменных (setq g_r0 nil g_r1 nil g_r2 nil g_r3 nil g_r3 nil g_csh nil g_shs nil g_cb nil g_wbs nil g_oex nil) ;Сборка мусора (gc) ) (defun geo_point_table () (setq pnt nil) (setq nline 0) (setq rows nil);список для всех координат типа: ((x,y,z)(x,y,z)...) ;Запрос на ввод точек (while (setq pnt (getpoint "\nУкажите координату: ")) (setq nline (1+ nline));увеличиваем количество строк на 1 ;формируем список с координатами (setq row pnt);списку row присваеваем список pnt с координатами выбранной точки (setq rows (append rows (list row) ));добавляем список row c коорд. выбранной точки в список со всеми коорд. rows );while ;Запрос на ввод коорд. левого верхнего угла таблицы (setq InsertionPoint nil) (setq InsertionPoint (getpoint "\nУкажите координаты левого верхнего угла таблицы: ")) ;Запоминаем значения сист.переменных (setq ORT (getvar "ORTHOMODE"));ORTHO (setq SN (getvar "SNAPMODE"));SNAP (setq OSN (getvar "OSMODE"));OSNAP (setq DIMZ (getvar "DIMZIN"));DIMZIN (setq TEXT (getvar "TEXTSTYLE"));TEXTSTYLE (setq COLOR(getvar "CECOLOR"));CECOLOR ;Задаём значения сист.переменным (setvar "ORTHOMODE" 0);ORTHO (setvar "SNAPMODE" 0);SNAP (setvar "OSMODE" 0);OSNAP (setvar "DIMZIN" 0);DIMZIN (setvar "CECOLOR" "251");CECOLOR (DrawLines InsertionPoint nline);создаём линии таблицы (setvar "CECOLOR" COLOR);CECOLOR (DrawText InsertionPoint nline 2.0 rows);создаём текст в таблице ;возвращаем знач. сист.переменных в начальное состояние (setvar "ORTHOMODE" ORT);ORTHO (setvar "SNAPMODE" SN);SNAP (setvar "OSMODE" OSN);OSNAP (setvar "DIMZIN" DIMZ);DIMZIN (setvar "TEXTSTYLE" TEXT);TEXTSTYLE );_end defun geo-draw-table ( defun DrawLines(InsertionPoint nline) ;InsertionPoint - точка вставки ;nline - количество строк (setq width 104 h 4);ширина таблицы\высота строк\ ;чертим гор.линии шапки таблицы (setq xx (car InsertionPoint) yy (cadr InsertionPoint)) (geo-add-line (list xx yy) (list (+ xx width) yy) acLnWtByLayer);первая линия, с началом в точке InsertionPoint (geo-add-line (list (+ xx 13) (- yy h)) (list (+ xx 57) (- yy h)) acLnWtByLayer);вторая линия (geo-add-line (list xx (- yy ![]() ![]() ;чертим гор. линии таблицы (setq yy (- yy 12)) (repeat nline (geo-add-line (list xx yy) (list (+ xx width) yy) acLnWtByLayer) (setq yy (- yy h)) );_end repeat ;чертим вертикальные линии таблицы (setq xx (car InsertionPoint) yy (cadr InsertionPoint)) (geo-add-line (list xx yy) (list xx (- yy 8 (* h nline))) acLnWtByLayer);первая линия (geo-add-line (list (+ xx 13) yy) (list (+ xx 13) (- yy 8 (* h nline))) acLnWtByLayer);вторая линия (geo-add-line (list (+ xx 35) (- yy h)) (list (+ xx 35) (- yy 8 (* h nline))) acLnWtByLayer);третья линия (geo-add-line (list (+ xx 57) yy) (list (+ xx 57) (- yy 8 (* h nline))) acLnWtByLayer);четвёртая линия (geo-add-line (list (+ xx 74) yy) (list (+ xx 74) (- yy 8 (* h nline))) acLnWtByLayer);пятая линия (geo-add-line (list (+ xx 91) yy) (list (+ xx 91) (- yy 8 (* h nline))) acLnWtByLayer);шестая линия (geo-add-line (list (+ xx 104) yy) (list (+ xx 104) (- yy 8 (* h nline))) acLnWtByLayer);седьмая линия );_end defun DrawLines ( defun DrawText(InsertionPoint nline h rows) ;InsertionPoint - коорд. левого верхнего угла таблицы ;nline - количество строк ;h - высота текста ;rows - список со всеми координатами типа: ((x,y,z)(x,y,z)...) ;Шапка таблицы ;(command "_STYLE" "Table(Geocad)" "Times New Roman" 0.0 1.0 0.0 "N" "N");создаём новый текст.стиль "Table(Geocad)" ;(setvar "TEXTSTYLE" "Table(Geocad)");TEXTSTYLE (setq xx (car InsertionPoint) yy (cadr InsertionPoint)) (geo-add-text "Номер" (list (+ xx 2.5) (- yy 3)) h acAlignmentLeft 0) (geo-add-text "точки" (list (+ xx 3) (- yy 6)) h acAlignmentLeft 0) (geo-add-text "К О О Р Д И Н А Т Ы" (list (+ xx 21) (- yy 3)) h acAlignmentLeft 0) (geo-add-text "X" (list (+ xx 23) (- yy 7)) h acAlignmentLeft 0) (geo-add-text "Y" (list (+ xx 44.5) (- yy 7)) h acAlignmentLeft 0) (geo-add-text "Дир.углы" (list (+ xx 60) (- yy 4.5)) h acAlignmentLeft 0) (geo-add-text "Меры" (list (+ xx 79) (- yy 3)) h acAlignmentLeft 0) (geo-add-text "линий,м" (list (+ xx 77.5) (- yy 6)) h acAlignmentLeft 0) (geo-add-text "На" (list (+ xx 96) (- yy 3)) h acAlignmentLeft 0) (geo-add-text "точку" (list (+ xx 94) (- yy 6)) h acAlignmentLeft 0) ;Таблица (setq i 1);счётчик (setq nlist 0);список с коорд.(x,y,z) в списке со всеми коорд. (repeat nline ;номера точек (geo-add-text (rtos i 2 0) (list (+ xx 6.5) (- yy 11)) h acAlignmentCenter 0);выводим в перв. столбец номер точки (if (= i nline) (setq i 0));если последняя точка, в последнем столбце для точек пишем начальную точку (geo-add-text (rtos (1+ i) 2 0) (list (+ xx 97.5) (- yy 11)) h acAlignmentCenter 0);выводим в последний столбец номер точки ;координаты X и Y (setq kx (nth 0 (nth nlist rows)));коорд. X (setq ky (nth 1 (nth nlist rows)));коорд. Y (geo-add-text (rtos ky 2 2) (list (+ xx 24) (- yy 11)) h acAlignmentCenter 0);выводим X\переворачиваем координаты (geo-add-text (rtos kx 2 2) (list (+ xx 46) (- yy 11)) h acAlignmentCenter 0);выводим Y\переворачиваем координаты ;Дир.углы (setq a1 (nth nlist rows));первая координата (setq a2 (nth (rem (1+ nlist) nline) rows));вторая координата (setq x1 (car a1) y1 (cadr a1));выбираем из списка координат а1 x и y (setq x2 (car a2) y2 (cadr a2));выбираем из списка координат а2 x и y (setq k1 (list y1 x1));меняем x и y и заносим в список (setq k2 (list y2 x2));меняем x и y и заносим в список (setq ang (geo_get_angle k1 k2));вычисляем угол\переворачиваем координаты (setq stang (angtos ang 1 3));преобразуем угол в стороку с точностью 3 (setq stang (vl-string-subst "° " "d" stang));заменяем символ d(град) на символ '° ' (setq stang (vl-string-subst "' " "'" stang));заменяем символ '(мин) на символ '' '(c пробелом) (geo-add-text stang (list (+ xx 65.5) (- yy 11)) h acAlignmentCenter 0);выводим угол в град,мин,сек. ;Расстояние (setq pnt1 (nth nlist rows));первая координата (setq pnt2 (nth (rem (1+ nlist) nline) rows));вторая координата (setq dist (geo_get_distance pnt1 pnt2)) (geo-add-text (rtos dist 2 2) (list (+ xx 82.5) (- yy 11)) h acAlignmentCenter 0);выводим расстояние (setq i (1+ i));увеличиваем i на 1 (setq yy (- yy 4));уменьшаем yy на 4 (setq nlist (1+ nlist));увеличиваем nlist на 1 ) );_end defun DrawText ;---------------------------------------------------------------------------------------------------------------------------- |
|
> 1 <