[编程申请]：有可以统计图块数量,绘制表格,且可以把图例图块绘制出来的工具吗

WUGUOAN163

有可以统计图块数量,绘制表格,且可以把图例图块绘制出来的工具吗

adisonmaster

2006自带有这个工具！

idchris

我也想要这个程序希望有高手能帮忙

highflybird

你用2005么？这里有一个程序能适合你们。(2005以上版本）
命令为BTT
[php]
(defun make-tablestyle ( name desc txtstyle h1 h2 h3 / tblstyle adoc)
  (or (vl-load-com))
  (setq
    tblstyle (vla-addobject
      (vla-item (vla-get-dictionaries
             (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
             )
           "Acad_Tablestyle"
           )
      name
      "AcDbTableStyle"
      )
    )
  (setq acmCol (vla-getinterfaceobject
               (vlax-get-acad-object)
               (strcat "AutoCAD.AcCmColor."
                       (substr (getvar "ACADVER") 1 2))))  
  (vla-put-name tblstyle name)
  
  (vla-put-headersuppressed tblstyle :vlax-false)
  (vla-put-titlesuppressed tblstyle :vlax-false)
  (vla-put-description tblstyle desc)
  (vla-put-flowdirection tblstyle 0)
  (vla-put-bitflags tblstyle 1)
  (vla-put-horzcellmargin tblstyle (/ h3 5))  
  (vla-put-vertcellmargin tblstyle (/ h3 5))
  (vla-settextstyle tblstyle 7 txtstyle)
;;;  (vla-settextstyle tblstyle 4 txtstyle)
;;;  (vla-settextstyle tblstyle 1 txtstyle)
  (vla-settextheight tblstyle 1 h3)  
  (vla-settextheight tblstyle 4 h2)
  (vla-settextheight tblstyle 2 h1)

  (vla-setrgb acmCol 204 102 0)
;;;  (vla-put-colorindex acmCol 32)
  (vla-setgridcolor tblstyle 63 7 acmCol)
  
  (vla-setgridvisibility tblstyle 63 7 :vlax-true)
  (vla-setgridlineweight  tblstyle 18 7 aclnwt009)
  (vla-setgridlineweight tblstyle 45 7 aclnwt050)

  (vlax-release-object acmCol)
  )


;=========== * prepared part for block table creation * ===========;

(defun C:BTT (/ acmcol acsp adoc objtable axss blkid cnt col
              columns desc desc_wid headers i lst_count
              lst_name nm row rows ss table_data tmp)
  (if (< (atof (getvar "ACADVER")) 16.0)
  (alert "This routine will work\nfor versions A2005 and higher")
  (progn
  (alert "\tBe patience\n\tWorks slowly")
  (vl-load-com)
  (or adoc
    (setq adoc (vla-get-activedocument
  (vlax-get-acad-object))))
  (or acsp (setq acsp (if (= (getvar "TILEMODE") 0)
  (vla-get-paperspace
  adoc)
  (vla-get-modelspace
  adoc))
  )
  )
  (make-tablestyle "Block-Count" "Symbol table" "Standard" 10.0 10.0 12.0)
  (setq acmCol (vla-getinterfaceobject
               (vlax-get-acad-object)
               (strcat "AutoCAD.AcCmColor."
                       (substr (getvar "ACADVER") 1 2))))
  (setq dht (getvar "dimtxt"))
  (setq ss (ssget "_X" '((0 . "INSERT"))))
  (setq axss (vla-get-activeselectionset adoc))
  (vlax-for a axss
    (setq nm (vlax-get a 'Name))       
    (setq lst_name
        (cons nm lst_name))   
           (if (not (member nm lst_count))
             (setq lst_count (cons nm lst_count))))

  (foreach i lst_count
    (setq tmp (length (vl-remove-if-not (function (lambda (x)(eq x i))) lst_name))
          desc (cdr (assoc 4 (entget (tblobjname "BLOCK" i))))
          tmp (list i tmp (if (not desc) "No description for this symbol" desc) "")
          table_data (cons tmp table_data)))
(setq desc_wid (* (getvar "dimtxt")(apply 'max (mapcar 'strlen (mapcar 'caddr table_data)))))
(setq        columns         (length (car table_data))
        rows         (length table_data)
  )
(setq        objtable (vlax-invoke
                 acsp
                 'Addtable
                 (getpoint "\nUpper left table insertion point: \n")
                 (+ 3 rows)
                 columns
                 ;; rows height (change by suit):
                 (* dht 1.667);28
                 ;; columns width (change by suit):
                 (* dht 8.333);50
               )
  )
  (vla-put-regeneratetablesuppressed objtable :vlax-true)
  (vla-put-layer objtable "0")
  (vla-put-titlesuppressed objtable :vlax-false)
  (vla-put-headersuppressed objtable :vlax-false)
  (vla-put-horzcellmargin objtable (* dht 0.5))
  (vla-put-vertcellmargin objtable (* dht 0.5))
  
  (vla-settextstyle objtable 2 "Standard")
  (vla-settextstyle objtable 4 "Standard")
  (vla-settextstyle objtable 1 "Standard")
  
  (vla-setrowheight objtable 2 (* dht 1.5))
  (vla-setrowheight objtable 4 (* dht 1.25))
  (vla-setrowheight objtable 1 (* dht 1.25))
  
  (vla-settextheight objtable 2 (* dht 1.25))
  (vla-settextheight objtable 4 dht)
  (vla-settextheight objtable 1 dht)
  
  (vla-put-colorindex acmcol 256)
  (vla-put-truecolor objtable acmcol)
  
  (vla-setcolumnwidth objtable 0 (* dht 10))
  (vla-setcolumnwidth objtable 1 (* dht 5))
  (vla-setcolumnwidth objtable 2 desc_wid)
  (vla-setcolumnwidth objtable 3 (* dht 12))
  
  (vla-put-colorindex acmcol 2)
  (vla-settext objtable 0 0 "SYMBOL LIST") ;(change by suit)
  (vla-setcelltextheight objtable 0 0 (* dht 1.5))
  (vla-setcellcontentcolor objtable 0 0 acmcol)
  (vla-put-colorindex acmcol 102)
  (setq        headers        '("SYMBOL" "QTY" "EQUIPMENT DESCRIPTION" "REMARKS");(change by suit)
  )
  
  (setq        col 0
        row 1
  )
  (foreach a headers
    (vla-settext objtable row col a)
    (vla-setcelltextheight objtable row col (* dht 1.25))
    (vla-setcellcontentcolor objtable row col acmcol)
    (setq col (1+ col))
  )
(vla-put-colorindex acmcol 40)  
(setq lst_count (acad_strlsort (mapcar 'car table_data)) row 2 col 0)
  
(foreach i lst_count
(setq blkID (vla-get-objectid (vla-item (vla-get-blocks adoc) i)))
(vla-setblocktablerecordid objtable row col blkID :vlax-true)
(vla-setblockscale objtable row col 0.75)
  (vla-setcellalignment objtable row col acMiddlecenter)
  (vla-setcellcontentcolor objtable row col acmcol)
  (setq row (1+ row)))

  (setq cnt 1 row 2)
  (foreach i (mapcar 'cdr table_data)
  (setq col 1)
  (foreach a i
    (vla-settext objtable row col a)
    (if (/= col 1)
    (vla-setcellalignment objtable row col acMiddleLeft)
    (vla-setcellalignment objtable row col acMiddleCenter))
    (vla-setcellcontentcolor objtable row col acmcol)
    (setq col (1+ col)))
    (setq row (1+ row))
    )
  (vla-put-colorindex acmcol 12)
  (vla-settext objtable row 2 "Total:")
  (vla-setcellalignment objtable row 0 acMiddleLeft)
  (vla-setcellcontentcolor objtable row 0 acmcol)
  
  (vla-settext objtable row 3
    (itoa (apply 'max (mapcar 'cadr table_data))))
  (vla-setcellalignment objtable row 1 acMiddleCenter
)
  (vla-setcellcontentcolor objtable row 1 acmcol)
  (vla-put-regeneratetablesuppressed objtable :vlax-false)
  (vl-catch-all-apply
    (function
      (lambda ()
        (progn
          (vla-clear axss)
          (vla-delete axss)
          (mapcar 'vlax-release-object (list axss objtable))
          )
        )
      )
    )
  (vla-regen adoc acactiveviewport)
  (alert "Done")
  )
    )

  (princ)
)

(prompt
  "\n\t\t\t   |-----------------------------|\n"
)
(prompt
  "\n\t\t\t  <|  Start with BTT to execute  |>\n"
)
(prompt
  "\n\t\t\t   |-----------------------------|\n"
)
; TesT : (C:BTT)

(vl-load-com)
(vla-get-SupportPath
  (vla-get-files
    (vla-get-preferences
      (vlax-get-acad-object)
    )
  )
)
[/php]

egos

绘制表格还可以把图例图块绘制出来？2006有这个命令吗

xyp1964

网络u盘下载：tktj(图块统计).VLX

生命练习生

xyp1964 发表于 2007-6-18 22:35
网络u盘下载：tktj(图块统计).VLX

网络U盘在哪里？ 求详细！感谢！