[编程交流] 如何创建“name”文本

(defun c:aa () ; V : 13.01.2013 ; 12.01.2013 .
(setvar "cmdecho" 0)
(setq osm (getvar "osmode") )
(setvar "osmode" 0)
(if (setq ht 0.2  lsel 0  ob (car (entsel "\n   Select  an  Object  for  LAYER   :  < Pick >  :  ")) )
 (progn
  (command "zoom" "e")
  (setq str (cdr (assoc 8 (entget ob)) )  sel (ssget "X" (list '(0 . "LWPOLYLINE,POLYLINE") (cons 8 str)) )  ) ;
  (if sel
    (progn
     (command "zoom" "o" sel "") (sssetfirst nil sel) ; Selectare Vizualizare Selectie !
     (if (/= (getstring (strcat "\n   SELECTED objects on LAYER  :  " str " ;\n   Any  =  NO ;   Enter  =  OK  :  ")) "") (setq sel nil))
     (sssetfirst sel) ; DeSelectare Vizualizare Selectie !
  ) ) ; if sel
  (if sel
   (progn  (or (vl-load-com))
    (setq lsel (sslength sel)  cale (strcat (getvar "dwgprefix") (getvar "dwgname") " - " (rtos (getvar "cdate") 2 6) ".csv")
   f (open cale "w")  i 0)
    (write-line "\nLabel, Area\n-------------------------------" f)
    (while (< i lsel)
     (setq nobi (ssname sel i)  nobv (vlax-ename->vla-object nobi)  ar (vla-get-Area nobv)  ars (rtos ar 2 5)  i (1+ i)
    lc (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates nobv)))  llc (length lc)  n (/ llc 2.)  j 0  sx 0  sy 0)
     (while (< j llc) (setq sx (+ (nth j lc) sx)  j (1+ j)  sy (+ (nth j lc) sy)  j (1+ j) )  ) ; wh
     (command "text" "m" (list (/ sx n) (/ sy n) 0) ht 0 (strcat "\n   Area  " (itoa i) " = " ars))
     (princ (strcat "\n   Area  " (itoa i) "  :  " ars))
     (write-line (strcat "Area  " (itoa i) ", " ars) f)
    ) ; wh <
    (if (and cale (findfile cale)) (close f))
  ) ) ; if sel
)) ; if ob
(setvar "osmode" osm)
(setvar "cmdecho" 1)
(princ (strcat "\n   Height  of  Texts  :  " (rtos ht 2 5) 
                   "\n   Number  of  Areas  :  " (itoa lsel) "  ."))
(princ "\n   END  !")(princ)
) ; end defun c:aa

 
(defun C:DXLW (/ acsp adoc ang ar area centpoint col fname inspt n plent plineobj regionobj row
sset thgt tot tst tsz txtobj xldata xlapp xlbook xlbooks xlcells xlsheet xlsheets)
(vl-load-com)
;;;local defun
(defun setcelltext(cells row column value)
(vl-catch-all-apply
'vlax-put-property
(list cells 'Item row column
(vlax-make-variant
(vl-princ-to-string value) ))
)
;;----------------------------- main part ---------------------;; 
(or adoc
(setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(or acsp
(setq acsp (vla-get-block
(vla-get-activelayout adoc))))
(vla-startundomark adoc)
(setq tsz (getvar "textsize"))
(setq tst (getvar "textstyle"))
;; set text style you need:
(setvar "textstyle" "Standard")
;; set text size
(setq thgt (getdist "\nText Height: "))
(if (not thgt)(setq thgt (getvar "dimtxt")))
(setvar "textsize" thgt)
(princ "\n\t---\tSelect contours\t---")
(setq sset
(ssget 
'(
(0 . "LWPOLYLINE")
(8 . "ANNO-AREA"); <-- set layer of polygons
(-4 . "<OR")
(70 . 1);flag for closed curve, linetype generation disabled
(70 . 129);flag for closed curve, linetype generation enabled
(-4 . "OR>")
)
)
)
(setq n 1 tot 0.0)
(while (setq plent (ssname sset 0))
(setq plineObj (vlax-ename->vla-object plent)
ar (vla-get-area plineObj)
tot (+ tot ar)
area (rtos ar 2 2)
)
(setq regionObj (car (vlax-invoke acsp 'addregion (list plineObj))))
(setq centPoint (trans (vlax-get regionObj 'centroid) 1 0)) 
(setq inspt (vlax-3d-point centPoint))
(setq txtobj (vla-addtext acsp (strcat "Label-"(itoa n)) inspt thgt))
(vla-put-alignment txtobj acAlignmentMiddleCenter)
(vla-put-textalignmentpoint txtobj inspt)
(vla-put-insertionpoint txtobj inspt)
(setq xldata (append xldata (list (list (strcat "Label-"(itoa n)) area))))
(vl-catch-all-apply '(lambda()
(progn (vla-delete regionObj)
(vlax-release-object regionObj)
)))
(setq n (1+ n))
(ssdel plent sset)
)
(print xldata)
(princ "\nTotal: ")
(print tot)
;;------------------------ Excel part ----------------------------;;
(setq xlapp (vlax-get-or-create-object "Excel.Application")
xlbooks (vlax-get-property xlapp 'Workbooks)
xlbook (vlax-invoke-method xlbooks 'Add)
xlsheets (vlax-get-property xlbook 'Sheets)
xlsheet (vlax-get-property xlsheets 'Item 1)
xlcells (vlax-get-property xlsheet 'Cells)
)
(vla-put-visible xlapp :vlax-true)
(vla-put-name xlsheet "Plan1")
(setq row 1)
(foreach label xldata
(setq col 1)
(foreach item label
(setcelltext xlcells row col item)
(setq col (1+ col)
)
)
(setq row (1+ row)
)
)
(setcelltext xlcells row 1 "Total:")
(setcelltext xlcells row 2 (rtos tot 2 2));<-- precision 2 decimal
(vlax-invoke-method
(vlax-get-property xlsheet 'Columns)
'AutoFit)
(setq fname (strcat (getvar "dwgprefix")(vl-string-right-trim ".dwg" (getvar "dwgname")) ".xls"))
(vlax-invoke-method
xlbook
'SaveAs
fname 
nil
nil
nil
:vlax-false
:vlax-false
1
2
)
(vlax-invoke-method
xlbook 'Close)
(gc)
(vlax-invoke-method
xlapp 'Quit)
(mapcar '(lambda (x)
(vl-catch-all-apply
'(lambda ()
(vlax-release-object x)
)
)
)
(list xlcells xlsheet xlsheets xlbook xlbooks xlapp)
)
(setq xlapp nil)
(gc)(gc)
(alert (strcat "File saved as:\n" fname))
(setvar "textsize" tsz)
(setvar "textstyle" tst)
(vla-endundomark adoc)
(princ)
)
(princ "\n\t---\tStart command with DXLW ...\t---")
(prin1)
(or (vl-load-com)(princ))