需要帮助从R1获取LiSP

x3ro · 发表于 2022-7-6 14:50:39

在我工作的地方，我们有在Autocad R12中使用的LISP文件。。

它用于命名闭合多段线，并在该多段线内插入文本。

我试图在AutoCAD 2007中使用它，但似乎无法使其工作。我一直在接近尾声时出现“lentyp nil”错误。。。

代码如下：

有人能帮忙吗？

Lee Mac · 发表于 2022-7-6 14:54:00

快速看一下，我认为创建者的意思是用于多段线，而不是LWMOLYLINES，因为它包含“entnext”来获取顶点。

我可能会重写它以用于LWD多段线，但目前没有时间

李

x3ro · 发表于 2022-7-6 14:59:14

六羟甲基三聚氰胺六甲醚。

使用LwPolyline需要什么？

Lee Mac · 发表于 2022-7-6 15:01:35

我认为整个LISP需要重新编写tbh，错误捕捉的方式不多，而且LISP似乎有点不稳定。

看看我能做什么

Lee Mac · 发表于 2022-7-6 15:05:41

好的，试一试——我不确定你到底想要什么，但如果你需要修改什么，请告诉我

copy

我注意到的一件事是，将其设置为检查它是否为多段线。所有部分都将始终是多段线，我们正在尝试这样做。我真的不认为你需要检查并制作多段线。

知道它为什么停止了吗？

x3ro · 发表于 2022-7-6 15:09:36

我的道歉伙计-我的愚蠢错误

[code]；；；============姓名。lsp=============；；；；；；函数：；；；将使用工件代码标记曲线，；；；模块、方向、材料和说明；；；；；；平台：；；；无限制，仅在ACAD 2004上测试；；；；；；曲线兼容性：；；；圆弧、圆、椭圆、*多段线、，；；；区域和样条。；；；；；；作者：；；；版权所有（c）04.2009 Lee McDonnell；；；（联系CADTutor.net的李·麦克）；；；；；；版本：；；；1.0 02.04.09;;;;;; ======================================（defun c:namer（/*error*ptxt deText cEnt cObj Area motxt dtxt mtxt tStr tBox tWid tHgt ClsPt btPt tpPt pt1 pt2 pt3 pt4 tAngl tObj）（vl load com）（defun*error*（msg）（redraw）（if tObj（entdel tObj））（if ovar（mapcar‘setvar vlst ovar））（if（not（member msg’（“函数已取消”“退出/退出中止”））（princ（strcat”\n错误：“（strcase msg）））（princ））（setq vlst’（“CLAYER”“OSMODE”“CMDECHO”）ovar（mapcar'getvar vlst））（mapcar'setvar（cdr vlst）'（0 0））（if（not（tblsearch“LAYER”“NAME”）（命令“_-LAYER”“\u M”“NAME”“\u C”“2”“NAME”“）（或mo:def（setq mo:def“BK”）（或d:def（setq d:def“R”）（或M:def（setq M:def“L”））（setq ptxt”“detxt”“）（if（和（setq cEnt（car（entsel“\n选择要标签的曲线：”）））（成员（cdr（assoc 0（entget cEnt）））“（“ARC”“CIRCLE”“ELLIPSE”“LWPOLYLINE”“POLYLINE”“REGION”“SPLINE”））（progn（setq cObj（vlax ename->vla object cEnt）Area（rtos（vla get Area cObj）2 0））（while（=ptxt“”）（setq ptxt（getstring“\n输入段代码：”）（setq ptxt（substr ptxt 1 3））（while（not（member motxt’（“BK”“DK”“SC”“BC”“AR”“AC”）））（setq motxt（strcase（getstring（strcat“\n输入模块[bK/DK/SC/BC/AR/AC]：”）（or（and（eq-motxt”“）（setq-motxt-mo:def））（setq-mo:def-motxt））（while（not（member-dtxt”“（“R”“L”“S”））（setq-dtxt（strcat“\n输入方向[R/L/S]：”））（or（and（eq-dtxt”“）（setq-dtxt d:def-dtxt）））（while（not（member-mtxt”“（“R”“L”“S”）））））（而L“S”P“d”Q“E”））（setq mtxt（strcase（getstring（strcat”\n输入材料[L/S/P/D/Q/E]：”）（或（和（eq mtxt“”）（setq mtxt m:def））（setq m:def mtxt））（while（=detxt“”）（setq detxt（getstring t”\n输入说明：））（setq detxt（substr detxt 1 20）tStr（strcat ptxt（chr 45）motxt（chr 45）dtxt（chr 45）mtxt（chr 45）区域（chr 45）45）文字）tBox（textbox（list（cons 1 tStr）））tWid（-（caadr tBox）（caar tBox））tHgt（-（cadadr tBox）（cadar tBox））（while（=5（car（setq grdat（grread t 1））））（redraw）（if（='list（type（setq sPt（cadr grdat）））（progn（setq ClsPt（vlax curve getclosestpoint to cObj sPt）cAngl（angle ClsPt sPt）btPt（polar ClsPt cAngl（/（getvar“TEXTSIZE”）2.0））tpPt（极性ClsPt cAngl（+（/（getvar“TEXTSIZE”）2.0）tHgt）midPt（极性btPt cAngl（/（距离btPt tpPt）2.0））pt1（极性btPt（+cAngl（/pi 2））（/tWid 2.0））pt2（极性btPt（-cAngl（/pi 2））（/tWid 2.0））pt3（极性tpPt（+cAngl（/pi 2））（/tWid 2.0））pt4（极性tpPt（-cAngl（/pi 2））（/tWid 2.0））（grvecs（列出51 pt1 pt2 51 pt2 pt4 51 pt1 pt3 51 pt3 pt4 щ））（setq tAngl（-cAngl（/pi 2））（if（and（>tAngl 0）（

Lee Mac · 发表于 2022-7-6 15:10:44

哇！

这很有效。太棒了。

只有几个问题：

1.我们可以不用连字符把文本放在一起吗？

2.我们可以这样做，而不是平方英寸，它把平方英尺的文字行？

3.我们能把它变成普通文本而不是多行文字吗？

非常感谢你的工作！这真的会帮上大忙。我试着看一下代码，看看你做了什么来修改它以满足我的需要，但我记不清了。哈哈，我对LISP代码知之甚少。在过去，我能够在较新版本的CAD中使用一些东西，但我不是这方面的专家。

x3ro · 发表于 2022-7-6 15:14:41

谢谢

在新版本中排序-现在使用空格。

排序后，根据平方英尺调整面积。

创建的文本应为单行DTEXT，而不是多行文字

新版本：

[code]；；；============姓名。lsp=============；；；；；；函数：；；；将使用工件代码标记曲线，；；；模块、方向、材料和说明；；；；；；平台：；；；无限制，仅在ACAD 2004上测试；；；；；；曲线兼容性：；；；圆弧、圆、椭圆、*多段线、，；；；区域和样条。；；；；；；作者：；；；版权所有（c）04.2009 Lee McDonnell；；；（联系CADTutor.net的李·麦克）；；；；；；版本：；；；1.0 02.04.09;;; 2.0 03.04.09;;;;;; ======================================（defun c:namer（/*error*ptxt deText cEnt cObj Area motxt dtxt mtxt tStr tBox tWid tHgt ClsPt btPt tpPt pt1 pt2 pt3 pt4 tAngl tObj）（vl load com）（defun*error*（msg）（redraw）（if tObj（entdel tObj））（if ovar（mapcar‘setvar vlst ovar））（if（not（member msg’（“函数已取消”“退出/退出中止”））（princ（strcat”\n错误：“（strcase msg）））（princ））（setq vlst’（“CLAYER”“OSMODE”“CMDECHO”）ovar（mapcar'getvar vlst））（mapcar'setvar（cdr vlst）'（0 0））（if（not（tblsearch“LAYER”“NAME”）（命令“_-LAYER”“\u M”“NAME”“\u C”“2”“NAME”“）（或mo:def（setq mo:def“BK”）（或d:def（setq d:def“R”）（或M:def（setq M:def“L”））（setq ptxt”“detxt”“）（if（和（setq cEnt（car（entsel“\n选择要标签的曲线：”）））（成员（cdr（assoc 0（entget cEnt）））“（“ARC”“CIRCLE”“ELLIPSE”“LWPOLYLINE”“POLYLINE”“REGION”“SPLINE”））（progn（setq cObj（vlax ename->vla object cEnt）Area（rtos（/（vla get Area cObj）144.0）2 0））（while（=ptxt“”）（setq ptxt（getstring“\n输入段代码：”）（setq ptxt（substr ptxt 1 3））（while（not（member motxt’（“BK”“DK”“SC”“BC”“AR”“AC”）））（setq motxt（strcase（getstring（strcat“\n输入模块[bK/DK/SC/BC/AR/AC]：”）（or（and（eq-motxt”“）（setq-motxt-mo:def））（setq-mo:def-motxt））（while（not（member-dtxt”“（“R”“L”“S”））（setq-dtxt（strcat“\n输入方向[R/L/S]：”））（or（and（eq-dtxt”“）（setq-dtxt d:def-dtxt）））（while（not（member-mtxt”“（“R”“L”“S”）））））（而L“S”P“d”Q“E”））（setq mtxt（strcase（getstring（strcat”\n输入材料[L/S/P/D/Q/E]：”）（或（和（eq mtxt“”）（setq mtxt m:def））（setq m:def mtxt））（while（=detxt“”）（setq detxt（getstring t”\n输入说明：））（setq detxt（substr detxt 1 20）tStr（strcat ptxt（chr 32）motxt（chr 32）dtxt（chr 32）mtxt（chr 32）区域（chr 32）32）文字）tBox（文本框（列表（cons 1 tStr）））tWid（-caadr tBox）（caar tBox））tHgt（-cadadr tBox）（cadar tBox））（提示“\n空间文本…”）（while（=5（car（setq grdat（grread t 1）））（redraw）（if（='list（type（setq sPt（cadr grdat）））（progn（setq ClsPt（vlax curve getClosestPointto cObj sPt）cAngl（angle ClsPt sPt）btPt（polar ClsPt cAngl（/（getvar“TEXTSIZE”）2.0））tpPt（polar ClsPt cAngl（+（/（getvar“TEXTSIZE”）2.0）tHgt））midPt（polar btPt cAngl（/（distance btPt tpPt）2.0））pt1（极性btPt（+cAngl（/pi 2））（/tWid 2.0））pt2（极性btPt（-cAngl（/pi 2））（/tWid 2.0））pt3（极性tpPt（+cAngl（/pi 2））（/tWid 2.0））pt4（极性tpPt（-cAngl（/pi 2））（/tWid 2.0））（grvecs（列表51 pt1 pt2 51 pt2 51 pt4 51 pt1 pt3 51 pt3 51 pt3 pt4 k））（setq tAngl（-cAngl（/pi 2））（if（和（>tAngl 0）（

Lee Mac · 发表于 2022-7-6 15:18:12

伙计，你真快！

一切都很好！

我在多行文字上发了个屁。事实上这已经是我需要的了！

我不想强加于人，但有没有办法让平方英尺始终位于小数点后两位，即使是整数？例如，1将是1.00？这很难做到吗？或者我可以改变自己？

x3ro · 发表于 2022-7-6 15:21:51

天哪，李。

这就是我所说的检修和老Lisp程序。很不错的。

编辑：不是拼写纳粹，但这是“兼容性”，而不是“兼容性”

[编程交流] 需要帮助从R1获取LiSP

发表回复

精选推荐