[SNIIP]

Как в lisp программно создать и заполнить таблицу?

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

Создаешь таблицу, подавляешь ей регенерацию, потом заполняешь данными, форматируешь ячейки, восстанавливаешь регенерацию и обновляешь ее. В чем сложность?
P.S. Насколько я помню, коды по созданию таблиц на форуме были не раз и не два...

[Alexeipost]

Зачем регенерацию подавлять?

[Do$]

Без этого на больших таблицах обработка длится гораздо дольше. Реально, без подавления - минуты, с подавлением - секунды.

[SNIIP]

А вы не подскажете где эти коды? я что то искал но не могу найти.:-(

[Alexeipost]

Код:

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

 Set TableObj = ThisDrawing.ModelSpace.AddTable(BasePoint, 5, 13, 50, 25)
With TableObj
    .SetTextHeight 3, 300
    .SetTextHeight 4, 300
    .SetAlignment 1, acMiddleCenter
    .RowHeight = 800
    .SetRowHeight 2, 1200
    .Width = 39500
    .SetColumnWidth 0, 2500
    .SetColumnWidth 1, 2000
    .SetColumnWidth 2, 2000
    .SetColumnWidth 3, 3500
    .SetColumnWidth 4, 3500
    .SetColumnWidth 5, 2000
    .SetColumnWidth 6, 2000
    .SetColumnWidth 7, 3500
    .SetColumnWidth 8, 3500
    .SetColumnWidth 9, 2000
    .SetColumnWidth 10, 4000
    .SetColumnWidth 11, 2000
    .SetColumnWidth 12, 6500
    .MergeCells 1, 1, 2, 5
    .MergeCells 1, 1, 6, 9
    .MergeCells 1, 2, 0, 0
    .MergeCells 1, 2, 1, 1
    .MergeCells 1, 2, 10, 10
    .MergeCells 1, 2, 11, 11
    .MergeCells 1, 2, 12, 12
    .SetCellValue 1, 0, "Ïîðÿäêîâûé íîìåð"
    .SetCellValue 1, 1, "Íîìåð êàáåëÿ"
    .SetCellValue 1, 2, "Îòêóäà"
    .SetCellValue 2, 2, "Íîìåð ïîìåùåíèÿ"
    .SetCellValue 2, 3, "Íîìåð øêàôà"
    .SetCellValue 2, 4, "Êîììóòàòîð óð.äîñòóïà"
    .SetCellValue 2, 5, "Íîìåð  ïîðòà"
    .SetCellValue 1, 6, "Êóäà"
    .SetCellValue 2, 6, "Íîìåð ïîìåùåíèÿ"
    .SetCellValue 2, 7, "Íîìåð øêàôà"
    .SetCellValue 2, 8, "Ïàò÷-ïàíåëü"
    .SetCellValue 2, 9, "Íîìåð  ïîðòà"
    .SetCellValue 1, 10, "Òèï êàáåëÿ"
    .SetCellValue 1, 11, "Äëèíà, ì"
    .SetCellValue 1, 12, "Ïðèìå÷àíèå"
    
End With

TableObj.InsertRows 3, 800, 3

Как тоже самое будет выглядеть на ЛИСПе?

[Do$]

Да так же. Пишу без проверки, возможны мелкие неточности

Код:

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

(vl-load-com)
(setq basepoint '(0.0 0.0 0.0)) ;точка вставки 0,0,0

(setq table (vla-addTable (vla-get-modelspace  (vla-get-activedocument (vlax-get-acad-object)))) (vlax-3d-point basepoint) 5 13 50 25))
(vla-settextheight table 3 300)
(vla-settextheight table 4 300)
...
(vla-insertrows table 3 800 3)

[skkkk]

Как тоже самое будет выглядеть на ЛИСПе?

Не тоже самое, но для примера, думаю, сойдет, по аналогии можно разобраться

Код:

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

(vl-load-com)
(setq vltable (vlax-ename->vla-object (handent "581"))) ;;;581 - handle конкретной таблицы, выяснить (vlax-dump-object (vlax-ename->vla-object (car (entsel))))
    (vla-SetTextHeight vltable acDataRow 300) ;;; ячейки с данными
    (vla-SetTextHeight vltable acTitleRow 300) ;;; ячейка с заголовком таблицы
    (vla-SetRowHeight vltable 2 1200) ;;; 2 - номер строки
    (vla-SetColumnWidth vltable 0 2500) ;;; 0 - номер столбца (первый)
    (vla-MergeCells vltable 1 1 2 5)
    (vla-settext vltable  1 0 "Текст") ;;; 1 - второй столбец, 0 - первая строка

[sdv79]

Код:

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

 

;--------------------------- работа с таблицей НАЧАЛО


 (cond     ; если нет слоя то создаем его
  ((null (tblsearch    "layer"
               "EOM_выноски_размеры_текст"
     ) ;/ tblsearch
   ) ;/ null
   (c:createLayer    "EOM_выноски_размеры_текст"
                 230
                 1
                 0.13
                 "Style 1"
   ) ;/ c:createLayer
 )) ;/ cond
(setvar "CLAYER" "EOM_выноски_размеры_текст")    ; сделать слой текущим

  
(setq column    3    ; кол. столбцов
      line    (+    ; кол. рядов
                (/    
                  (length t_prt)
          2  ; делим т.к список состоит "Лист" "Наименование"
         ) ;/ /
         2 ; добавляем 2 т. к шапка занимает две строки
        ) ;/ +
      tbl     (vla-addtable 
                (vla-get-modelspace(vla-get-activedocument (vlax-get-acad-object))) 
                 (vlax-3d-point (getpoint "\nУкажите точку вставки таблицы: ")) 
               line
                 column 
               8      ;  высота строк
                 75     ;  ширина таблицы (любое, далее правим)
                ) ;/ vla-addtable
) ;/ setq

  ; формируем шапку порядок СТРОКА СТОЛБЕЦ
  (vla-settext    tbl
            0 ; строка
            0 ; столбец
            "Ведомость рабочих чертежей основного комплекта"
  ) ;/ vla-settext
  (vla-settext    tbl
            1
            0
                "Лист"
  ) ;/ vla-settext
  (vla-settext    tbl
            1
                1
                "Наименование"
  ) ;/ vla-settext
  (vla-settext    tbl
            1
                2
                "Примечание"
  ) ;/ vla-settext

  ; формируем высоту, ширину
  (vla-setColumnWidth    tbl ; ширина первого столбца
                0
                15
  ) ;/ vla-setColumnWidth
  (vla-setColumnWidth    tbl ; ширина второго столбца
                1
                140
  ) ;/ vla-setColumnWidth
  (vla-setColumnWidth    tbl ; ширина третьего столбца
                2
                30
  ) ;/ vla-setColumnWidth
  (vla-setRowHeight    tbl; высота шапки на этом месте
                1
                15
  ) ;/ vla-setColumnWidth


 (setq count 1)
 (repeat (- line 2)
  (vla-settext         tbl  ; заполняем Лист
                (1+ count)
                0
                (car t_prt)
  ) ;/ vla-settext
  (vla-setCellAlignment tbl ; выравниваем по центру
                (1+ count)
                0
                acMiddleCenter
  ) ;/ vla-setCellAlignment
  
  (setq t_prt (cdr t_prt)) 
  (vla-settext    tbl ; заполняем Наименование
            (1+ count)
            1
            (car t_prt)
  ) ;/ vla-settext
  (setq count (1+ count)
      t_prt (cdr t_prt)
  ) ;/ setq
 ) ;/ repeat

 (terpri) 
 (princ "Ведомость рабочих чертежей сформирована ")