Excel到Autocad帮助我

fixo · 发表于 2022-7-6 11:19:30

我打不开你的画
这是为你的西装编辑的代码，
它将仅用文本绘制点
你的区块PA的标签名是什么？
易于重写以插入块和更改属性
Excel数据值
[code]（vl负载com）；；本地defun（defun read\u excel\u range（FilePath ShtNum Address/ExcelApp ExcData Sht UsdRange Wbk）（setq ExcelApp（vlax get or create object“excel.Application”）（vla put visible ExcelApp:vlax true）（vlax put property ExcelApp“DisplayAlerts:vlax true）（setq Wbk（vl catch all apply”vla open（list（vlax get property ExcelApp“WorkBooks”）FilePath））（setq Sht（vl catch all apply“vlax get property（list（vlax get property Wbk“Sheets”）“Item”ShtNum））（vlax invoke method Sht“Activate”）（setq UsdRange（vlax get property（vlax get property Sht”Cells）“Range”Address）ExcData（vlax safearray->list（vlax variant value（vlax get property UsdRange“Value2））（setq ExcData（函数（lambda（x）（mapcar‘vlax variant value x）））ExcData（setq ExcData（vl remove if（function（lambda（x）（member nil x）））ExcData（vl catch all apply‘vlax invoke method（list Wbk“Close”））（vl catch all apply‘vlax invoke method（list ExcelApp“Quit”））（mapcar（function（lambda（x）（vl catch all apply（function（lambda（））（progn（if（not（vlax-object-released-p x））（progn（vlax release object x）（setq x nil）））（list UsdRange Sht Wbk ExcelApp））（gc）（gc）（gc）ExcData）；；主程序（defun C:Xpoints（/acsp address data\u list fname inspoint sheetnum textheight）（setvar“pdmode”34）（setvar“pdsize”2）（if（and（setq fname（getfield“Select Excel File:”（getvar“dwgprefix”）“XLS”4））（setq sheetnum（getstring T“\n输入表名：”）address“a:C”）（progn（if（zerop（setq textheight（getvar“textsize”）））（progn（initget 7）（setq textheight）“\n指定文字高度：”）；；获取数据（setq data_list（read_excel_range fname sheetnum address））；；从列表中删除标题（setq data_list（vl remove if（function（lambda）（not（numberp（cadr a）Ю）Ю）data_list））（if data_list（progn（setq acsp（vla get block（vla get activelayout）（vla get activedocument（vlax get acad object）Ю）））（foreach item data_list（vlax invoke method acsp’AddPoint（vlax-3d-point（setq inspoint（list（cadr item）（caddr item）0）））（setq textobj（vlax invoke method acsp'AddText（vl princ to string（car item））（setq textpoint（vlax-3d-point（mapcar'+（list 0（/textheight 2）0）inspoint）））textheight））（vlax put property textobj'Alignment acAlignmentBottomCenter）（vlax put property textobj'TextAlignmentPoint textpoint））（vla zoomcenter（vlax get acad object）textpoint（*textheight 12）））（princ））（提示“\n\t\t>>\t键入XPOINTS或XPOINTS以执行\t>>\t键入XBLK或XBLK以执行\t

KAC · 发表于 2022-7-6 11:23:29

我们能更进一步吗？我同样需要将现场数据表中的地下水勘探位置插入现场图纸。Excel数据设置有5列，从左到右-块名、Xcoord、Ycoord、井名和标高。图纸上的最终输出将在x、y坐标处插入区块，井名（区块属性=ID）和地下水高程（区块属性=EL）。

非常感谢！

fixo · 发表于 2022-7-6 11:26:47

例如，在此处上载带有一个插入块的图形
但我现在做不到，还在看世界杯

~'J'~

KAC · 发表于 2022-7-6 11:29:41

谢谢~'J'~！我明天早上上传。我们都要离开办公室去看下半场的比赛了！干杯

fixo · 发表于 2022-7-6 11:31:50

希望这个能满足你的需要

[code]（vl负载com）；；本地defun（defun read\u excel\u range（FilePath ShtNum Address/ExcelApp ExcData Sht UsdRange Wbk）（setq ExcelApp（vlax get or create object“excel.Application”）（vla put visible ExcelApp:vlax true）（vlax put property ExcelApp“DisplayAlerts:vlax true）（setq Wbk（vl catch all apply”vla open（list（vlax get property ExcelApp“WorkBooks”）FilePath））（setq Sht（vl catch all apply“vlax get property（list（vlax get property Wbk“Sheets”）“Item”ShtNum））（vlax invoke method Sht“Activate”）（setq UsdRange（vlax get property（vlax get property Sht”Cells）“Range”Address）ExcData（vlax safearray->list（vlax variant value（vlax get property UsdRange“Value2））（setq ExcData（函数（lambda（x）（mapcar‘vlax variant value x）））ExcData（setq ExcData（vl remove if（function（lambda（x）（member nil x）））ExcData（vl catch all apply‘vlax invoke method（list Wbk“Close”））（vl catch all apply‘vlax invoke method（list ExcelApp“Quit”））（mapcar（function（lambda（x）（vl catch all apply（function（lambda（））（progn（if（not（vlax-object-released-p x））（progn（vlax release object x）（setq x nil）））（list UsdRange Sht Wbk ExcelApp））（gc）（gc）（gc）ExcData）；；主程序（defun C:BEL（/acsp address attcoll blkname blkobj data\u list fname inspoint sheetnum）（setvar“pdmode”34）（setvar“pdsize”2）（if（and（setq fname（getfield“Select Excel File:”（getvar“dwgprefix”）“XLS”4））（setq sheetnum（getstring T“\n输入一个表名：”）address“A1:E1000”；

KAC · 发表于 2022-7-6 11:35:17

早上好，菲索，

非常感谢您的帮助！今天早上我试用你的程序时，收到了一条格式错误的错误消息：

命令：appload
插入探索。lsp已成功加载。
命令：；错误：输入列表格式不正确

我已经按照你昨天的要求附上了测试文件。

再次感谢-科航
EXPLORA公司

ziko · 发表于 2022-7-6 11:37:33

hi KAC,

I tested fixo's code with you dwg and xls because I am also interested in what he wrote for you. Looks like it should work. It worked for me. All I did was cut and paste. You may have an extra or missing closing opening parenthesis. Maybe when you cut and paste you missed out one.

KAC · 发表于 2022-7-6 11:40:22

Yeah, must have mised something, because I just tried again and it works great!!

THANK YOU FIXO!! I truely appreciate all your help!

KC

fixo · 发表于 2022-7-6 11:43:47

Thanks, ziko
Welcome on board

~'J'~

fixo · 发表于 2022-7-6 11:48:40

Glad it that works
And also, please, create the new threads separately for
even of your questions
Btw, this is a huge size work what you want I hope somebody else
from this forum coulde be able to solve your task

~'J'~

[编程交流] Excel到Autocad帮助我

发表回复

精选推荐