如何创建“name”文本
大家好，我是这个论坛的新成员，非常感谢大家的帮助。我需要做以下例行工作：--添加文本以表示闭合多段线标签。
--然后例程应该获取多段线区域，并将标签和区域数据导出到Excel文件，如图所示。
http://imageshack.us/photo/my-images/339/imagemxqb.png/
http://img339.imageshack.us/img339/7136/imagemxqb.png
我真的需要一些帮助，因为这份重复的工作快把我累死了。我有900条多段线来给一个标签并提取区域。
谢谢 如何创建文本以“命名”闭合多段线，并将“名称”和区域导出到活动单元格excel
iam mohmed fawzy
邮寄
mo70no70@yahoo.com 程序搜索选定图层上的所有多段线。
对于初学者，请尝试以下方法：
(defun c:aa () ; V : 13.01.2013 ; 12.01.2013 .
(setvar "cmdecho" 0)
(setq osm (getvar "osmode") )
(setvar "osmode" 0)
(if (setq ht 0.2lsel 0ob (car (entsel "\n SelectanObjectforLAYER :< 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 0sx 0sy 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 HeightofTexts:" (rtos ht 2 5)
"\n NumberofAreas:" (itoa lsel) "."))
(princ "\n END!")(princ)
) ; end defun c:aa
该程序不直接在Excel中编写，但您可以打开结果文件。带Excel的CSV。CSV文件保存到DWG路径。
要在Excel中编写内容，需要一个函数来打开并写入Excel，这更为复杂。
简单明了。仅处理选定层。不检查不同：
-如果多段线有2个顶点，面积为0；
-不要检查多段线是否闭合；
-高度文本；
-开始写标签；
-等等。
Lisp程序大约用了30分钟。 您可以在此处找到满足您需求的解决方案
李·麦克的精彩节目
http://www.lee-mac.com/arealabel.html gS7，和往常一样很难。
我在短时间内想到了一个简单的变体，帮助scremin快速处理900条多段线。他们补充说，因为你需要其他设施。 这是我的2美分
(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))
对不起，你的照片不好
如何在这个单元格中写入X，Y坐标？
请告诉我，你想在每个单元格中添加什么
如果没有好的屏幕截图，试试这个，非常有限的测试
（defun C:ARXL（/acsp adoc ar area centpoint col epar fname inspt leg leg\u list n perim plent pline\u data plineobj regionobjrow spar sset thgt tot tst tsz txtobj xlapp xlbook xlbooks xlcells xldata xlsheet xlsheets）（vl load com）；；；局部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）））；；-------------------------------主要部分-------------------------------；；（或adoc（setq adoc（vla get activedocument（vlax get acad object）））（或acsp（setq acsp（vla get block（vla get activelayout adoc）））（vla startundomark adoc）（setq tsz（getvar“textsize”））（setq tst（getvar“textsyle”）；；设置所需的文字样式：（setvar“textstyle”“Standard”）；；设置文本大小（setq thgt（getdist“\nText Height:”）（if（not thgt）（setq thgt（getvar“dimtxt”）））（setvar“textsize”thgt）（princ“\n\t----\t选择等高线\t---”）（setq sset（ssget’（（0。“LWPOLYLINE”）（8。“ANNO-AREA”）；vla object plent））（setq spar（vlax curve getstartparam plineObj）epar（vlax curve getendparam plineObj））（while（<spar epar）（setq leg（-vlax curve getdistatparam plineObj（+spar 1））（vlax curve getdistatparam plineObj spar））leg\u list（cons（rtos leg 2）leg\u list））（setq spar（1+spar））（setq leg\u list（reverse leg\u list））（setq ar（vla get area plineObj）perim（rtos（vla get length plineObj）2 2）tot（+tot ar）区域（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”标签-（itoa n））inspt thgt））（vla put alignment txtobj ACALIGNMENTMIDLECENT）（vla put textalignmentpoint txtobj inspt）（vla put insertionpoint txtobj inspt）（setq pline\U data nil）（setq pline\U data（append pline\U data（append（list（strcat）Label-（itoa n））area）（list perim）leg\U list））（setq xldata（append xldata（list pline\U data））（vl catch all apply’（lambda（）（progn（vla delete REGIONOBJECT）（vlax release object regionObj）））（setq n（1+n））（ssdel plent sset））（打印xldata）（princ“\n总计：”）（打印tot）；---------------------------Excel部分-------------------------------；；（setq xlapp（vlax get or create object“Excel.Application”）xlbook（vlax get property xlapp”工作簿）xlbook（vlax invoke method xlbook’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）（每个项目标签（setcelltext xlcells row col item）（setq col（1+col））（setq row（1+row）））（setcelltext xlcells row 1“总计：）（setcelltext xlcells row 2（rtos tot 2 2））； 但是这段代码没有选择任何对象！！！！
当我拖动并尝试选择对象时，命令行中将显示什么：选择对象：找到0！！！ 自行更改选择过滤器中的层“ANNO-AREA” 你真厉害
页:
[1]
2