乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
查看： 98|回复： 7

[编程交流] 此Lisp pl有问题

[复制链接]
nafees

1

主题

3

帖子

2

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-5 17:53:04 | 显示全部楼层 |阅读模式
亲爱的朋友们
我试图制作这个lisp来制作xyz坐标系，但在z级别有一些问题，请在这方面帮助我，以下是lisp
 
  1. (defun c:cott()
  2. (princ "\nthis lsp to type the coordinate x,y.& z make table")
  3. ;(command "osnap" "none" )  
  4. (command "osnap" "node,inter" )  
  6. (setq p(getpoint "\n Enter First Point :")
  7.      pp(getpoint "\n Enter Second Point :")      
  8.      u(getint "\n Enter start point number:")
  9.      tab(getpoint "\n Enter Upper Left Corner of Table:")            
  10.      u1 (+ 1 u)
  11.      x(car p)
  12.      y(cadr p)
  13.      z(caddr p)
  14.      x1(car pp)
  15.      y1(cadr pp)
  16.      z1(caddr pp)
  17.      text(strcat "(" (rtos x 2 3) "," (rtos y 2 3)")")
  18.      text1(strcat "(" (rtos x1 2 3) "," (rtos y1 2 3) ")") 
  19.      p1(mapcar '+ p (list 0.35 0.45))
  20.      p2(mapcar '+ pp (list 0.35 0.45))
  21.      p10(mapcar '+ p (list 0.35 -0.45))      
  22.      p11(mapcar '+ pp (list 0.35 -0.45))      
  23.      tab1(mapcar '+ tab (list 2 0 ))
  24.      tab2(mapcar '+ tab (list 4 0 ))
  25.      tab3(mapcar '+ tab (list 6 0 ))
  26.      tab4(mapcar '+ tab (list 8 0 ))
  27.      tab5(mapcar '+ tab (list 0 -1 ))
  28.      tab6(mapcar '+ tab1 (list 0 -1 ))
  29.      tab7(mapcar '+ tab2 (list 0 -1 ))
  30.      tab8(mapcar '+ tab3 (list 0 -1 ))
  31.      tab9(mapcar '+ tab4 (list 0 -1 ))
  32.      tab10(mapcar '+ tab5 (list 0 -1))
  33.      tab11(mapcar '+ tab6 (list 0 -1))
  34.      tab12(mapcar '+ tab7 (list 0 -1))
  35.      tab13(mapcar '+ tab8 (list 0 -1))
  36.      tab14(mapcar '+ tab9 (list 0 -1))
  37.      tab15(mapcar '+ tab10 (list 0 -1))
  38.      tab16(mapcar '+ tab11 (list 0 -1))
  39.      tab17(mapcar '+ tab12 (list 0 -1))
  40.      tab18(mapcar '+ tab13 (list 0 -1))
  41.      tab19(mapcar '+ tab14 (list 0 -1))
  42.      POIN(mapcar '+ tab (list 0.45 -0.7))
  43.      POIN1(mapcar '+ tab1 (list 0.35 -0.7))
  44.      POIN2(mapcar '+ tab2 (list 0.35 -0.7))
  45.      POIN3(mapcar '+ tab3 (list 0.35 -0.7))
  46.      POIN4(mapcar '+ tab5 (list 0.68 -0.7))
  47.      POIN5(mapcar '+ tab6 (list 1 -0.5))
  48.      POIN6(mapcar '+ tab7 (list 1 -0.5))
  49.      POIN7(mapcar '+ tab8 (list 1 -0.5))
  50.      POIN8(mapcar '+ poin4 (list 0 -1))
  51.      POIN9(mapcar '+ poin5 (list 0 -1))
  52.      POIN10(mapcar '+ poin6 (list 0 -1))
  53.      POIN11(mapcar '+ poin7 (list 0 -1))
  54.      uu(strcat "" (itoa u) )
  55.      uu1(strcat "" (itoa u1) )
  56. )
  57. (command "osnap" "none" )  
  58. ;         (command "Style" n "" "" "" "" "" "" "")
  59. (command "style" "ahmedn" "txt" "0.2" "1" "0" "n" "n" "n" "")
  60. ;(command "line" p pp "")
  61. (command "line" tab tab4 "")
  62. (command "line" tab5 tab8 "")
  63. (command "line" tab10 tab13 "")
  64. (command "line" tab15 tab18 "")
  65. (command "line" tab tab15 "")
  66. (command "line" tab1 tab16 "")
  67. (command "line" tab2 tab17 "")
  68. (command "line" tab3 tab18 "")
  69. (command "line" tab4 tab19 "")
  70. ;(command "text" P1 "0"  text "")
  71. ;(command "text" P2 "0"  text1 "")
  72. (command "text" P10 "0"  uu "")
  73. (command "text" P11 "0"  uu1 "")
  74. (command "text" poin "0"  "REF.#" "")  
  75. (command "text" poin1 "0"  "EASTING" "")
  76. (command "text" poin2 "0"  "NORTHING" "")
  77. (command "text" poin3 "0"  "LEVEL" "")
  78. (command "text" poin4 "0" uu "")
  79. (command "text" poin8 "0" uu1 "")
  80. (command "text" "j" "mc" poin5 "0" (rtos x 2 3) "")
  81. (command "text" "j" "mc" poin6 "0" (rtos y 2 3) "")
  82. (command "text" "j" "mc" poin7 "0" (rtos z 2 3) "")
  83. (command "text" "j" "mc" poin9 "0" (rtos x1 2 3) "")
  84. (command "text" "j" "mc" poin10 "0" (rtos y1 2 3) "")
  85. (command "text" "j" "mc" poin11 "0" (rtos z1 2 3) "")
  86. (command "osnap" "node,inter" )    
  87.  (command "osnap" "node,inter" )
  88.  (setq  ppp(getpoint "\n Enter Next Point :")       )
  89.  (while ( /= ppp nil )
  90.    (progn
  91.      (setq
  92.        u1 (+ 1 u1)
  93.        x1(car ppp)
  94.        y1(cadr ppp)
  95.        z1(caddr pp)
  96.        text1(strcat "(" (rtos x1 2 3) "," (rtos y1 2 3) ")") 
  97.        p2(mapcar '+ ppp (list 0.35 0.45))
  98.        p11(mapcar '+ ppp (list 0.35 -0.45))      
  99.        uu1(strcat "" (itoa u1) )
  100.        tab15(mapcar '+ tab15 (list 0 -1))
  101.        tab16(mapcar '+ tab16 (list 0 -1))
  102.        tab17(mapcar '+ tab17 (list 0 -1))
  103.        tab18(mapcar '+ tab18 (list 0 -1))
  104.        tab19(mapcar '+ tab19 (list 0 -1))
  105.        POIN8(mapcar '+ poin8 (list 0 -1))
  106.        POIN9(mapcar '+ poin9 (list 0 -1))
  107.        POIN10(mapcar '+ poin10 (list 0 -1))
  108.        POIN11(mapcar '+ poin11 (list 0 -1))
  110.      );setq
  111. (command "osnap," "none" )  
  112. ;    (command "line" pp ppp "")
  113.     ;(command "text" p2 "0"  text1 "")
  115.     (command "text" p11 "0"  uu1 "")
  116. (command "text" poin8 "0" uu1 "")
  117. (command "text" "j" "mc" poin9 "0" (rtos x1 2 3) "")
  118. (command "text" "j" "mc" poin10 "0" (rtos y1 2 3) "")
  119. (command "text" "j" "mc" poin11 "0" (rtos z1 2 3) "")
  120. (command "line" tab15 tab18 "")
  123.     (setq pp ppp
  124.           ;u1 (+ 1 u1)
  125.     );setq
  126.  (command "osnap" "node,inter" )
  127.     (setq  ppp(getpoint "\n Enter Next Point :")  )
  128.     );progn
  129.  )   ;while
  130.  (command "osnap" "none" )
  131. (command "line" tab tab15 "")
  132. (command "line" tab1 tab16 "")
  133. (command "line" tab2 tab17 "")
  134. (command "line" tab3 tab18 "")
  135. (command "line" tab4 tab19 "")
  137. (command "osnap" "node,inter" )  
  138.  );end
回复

使用道具 举报

SLW210

4

主题

2143

帖子

2197

银币

限制会员

铜币
-24
发表于 2022-7-5 18:03:47 | 显示全部楼层
请阅读代码发布指南并编辑您的帖子，将代码包含在代码标签中。[NOPARSE]
  1. Your Code Here
[/NOPARSE]
回复

使用道具 举报

BIGAL

106

主题

1万

帖子

101

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1299
发表于 2022-7-5 18:10:30 | 显示全部楼层
您是否想过使用“Autocad表格”而不是文字周围的线条，这可能会容易得多。下面是一个例子。下面第三个代码中的建议。
 
  2. ; example of creating a table
  3. ; apologise not sure where I got this code
  5. (defun c:sct (/ colwidth numcolumns numrows objtable rowheight sp vgad vgao )
  6. (vl-load-com)
  7. (setq sp (vlax-3d-point '(0 0 0)))
  8. ;(setq vgao (vlax-get-acad-object))
  9. ;(setq vgad (vla-get-activedocument vgao))
  10. ;(setq vgms (vla-get-paperspace vgad))
  11. (setq doc  (vla-get-activedocument (vlax-get-acad-object) ))
  12. (setq vgms (vla-get-paperspace doc))
  13. (setq numrows 5)
  14. (setq numcolumns 5)
  15. (setq rowheight 0.5)
  16. (setq colwidth 30)
  17. (setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
  19. (vla-settext objtable 0 0 "TABLE title")
  20. (vla-settext objtable 1 0 "A") 
  21. (vla-settext objtable 1 1 "B") 
  22. (vla-settext objtable 1 2 "C")
  23. (vla-settext objtable 1 3 "D")
  24. (vla-settext objtable 1 4 "E")
  25. (vla-settext objtable 2 0 "1")
  26. (vla-settext objtable 3 0 "2")
  27. (vla-settext objtable 4 0 "3")
  28. (vla-setcolumnwidth objtable 0 15) ; 0 is first column
  29. (vla-setcolumnwidth objtable 1 30)
  30. (vla-setcolumnwidth objtable 2 60)
  31. (command "_zoom" "e")
  32. (princ)
  33. )
  34. (C:sct)

另一个示例行数未知
  2. ; dwg index to a table
  3. ; by Alan H NOV 2013
  4. (defun AH:dwgindex (/ doc objtable ss1 lay ans ans2 plotabs ss1 tag2 tag3 list1 list2 curlayout colwidth numcolumns numrows INC rowheight )
  6. (vl-load-com)
  7. (setq curlayout (getvar "ctab"))
  8. (if (= curlayout "Model")
  9. (progn
  10. (Alert "You need to be in a layout for this option")
  11. (exit)
  12. ) ; end progn
  13. ) ; end if model
  14. (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  15. (setq curspace (vla-get-paperspace doc))
  16. (setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table:  "))) 
  18. ; read values from title blocks
  20. (setq bname "DA1DRTXT")
  22. (setq tag2 "DRG_NO") ;attribute tag name
  23. (setq tag3 "WORKS_DESCRIPTION") ;attribute tag name
  25. (setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname))))
  27. (if (= ss1 nil) ; for tomkinson jobs
  28. (progn 
  29. (setq bname "COGG_TITLE")
  30. (setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname))))
  31. )
  32. )
  34. (setq INC (sslength ss1))  
  35. (repeat INC
  36. (foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 (SETQ INC (- INC 1)) )) 'getattributes) 
  37.        (if (= tag2 (strcase (vla-get-tagstring att)))
  38.            (progn
  39.            (setq ans (vla-get-textstring att))
  40.            (if (/= ans NIL)
  41.            (setq list1 (cons ans list1))
  42.            ) ; if 
  43.            ); end progn
  44.          ) ; end if
  45.        (if (= tag3 (strcase (vla-get-tagstring att)))
  46.          (progn
  47.          (setq ans2 (vla-get-textstring att))
  48.          (if (/= ans2 NIL)
  49.              (setq list2 (cons ans2 list2)) 
  50.           ) ; end if
  51.           ) ; end progn
  52.  ) ; end if tag3 
  53.    
  54. ) ; end foreach
  56. ) ; end repeat
  57. (setvar 'ctab curlayout)
  58. (command "Zoom" "E")
  59. (command "regen")
  62. (reverse list1)
  63. ;(reverse list2)
  65. ; now do table 
  66. (setq numrows (+ 2 (sslength ss1)))
  67. (setq numcolumns 2)
  68. (setq rowheight 0.2)
  69. (setq colwidth 150)
  70. (setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
  71. (vla-settext objtable 0 0 "DRAWING REGISTER")
  72. (vla-settext objtable 1 0 "DRAWING NUMBER") 
  73. (vla-settext objtable 1 1 "DRAWING TITLE") 
  75. (SETQ X 0)
  76. (SETQ Y 2)
  78. (REPEAT (sslength ss1)
  79.  (vla-settext objtable Y 0 (NTH X LIST1))
  80.  (vla-settext objtable Y 1 (NTH X LIST2))
  81.  (vla-setrowheight objtable y 7)
  83.  (SETQ X (+ X 1))
  84.  (SETQ Y (+ Y 1))
  85. )
  87. (vla-setcolumnwidth objtable 0 55)
  88. (vla-setcolumnwidth objtable 1 170)
  90. (command "_zoom" "e")
  92. ); end AH defun
  94. (AH:dwgindex)
  96. (princ)

 
  2. (setq oldsnap (getvar "osmode"))
  3. (setvar "osmode" 40 ) ;this is int & node ; 0 is non
  4. ..... at end of code 
  5. (setvar "osmode" Oldsnap)
回复

使用道具 举报

SLW210

4

主题

2143

帖子

2197

银币

限制会员

铜币
-24
发表于 2022-7-5 18:19:16 | 显示全部楼层
 
您使用的是引号标记而不是代码标记，我这次为您修复了它，但请下次使用正确的标记。
回复

使用道具 举报

Jef!

28

主题

317

帖子

292

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
140
发表于 2022-7-5 18:34:26 | 显示全部楼层
嗨，nafees。
 
我同意Bigal的观点，在开始时获取osmode变量，并在结束时使用该值恢复它。让lisp例程将变量重置回任意值，而不是将它们恢复到lisp执行之前的状态，这从来都不是一件有趣的事。还应考虑以下因素
-如果用户取消（转义），将变量恢复为初始值的错误处理
-尽量减少使用功能命令（即（setvar“osmode”40）而不是（命令“osnap”“node，inter”）。。
 
此外，就在最后一个while语句之前，您一行有2次（命令“osnap”“node，inter”）
 
要解决您的Z问题，请在您最后的“while”语句中找到以下内容。。。
  1.       (setq
  2.        u1 (+ 1 u1)
  3.        x1(car ppp)
  4.        y1(cadr ppp)
  5.        z1(caddr pp)

 
并将z1替换为z1（caddr ppp）
 
干杯
回复

使用道具 举报

nafees

1

主题

3

帖子

2

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-5 18:42:23 | 显示全部楼层
尊敬的Jef：
我已根据您的建议进行了修改，但不起作用。请检查我再次附加在这里的lisp 185308a2t20f52v77tfzfg.jpg
我无法纠正我的错误，请在这件事上帮助我。。谢谢大家
回复

使用道具 举报

BIGAL

106

主题

1万

帖子

101

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1299
发表于 2022-7-5 18:53:05 | 显示全部楼层
Works为我画了一条3d线，但我认为你的OSNAP已经关闭，Node&inter&也许结束了。（setvar“osmode”41）另外，您的水平线不太正确，但我将把它留给您。如果您希望此表用于放样，则可能需要添加数据的写入文件。
 
正如注释一样，我们以不同的方式创建点编号的气泡，导出为csv文件，然后读取csv文件以制作表格，如果添加点，则只需删除并重新创建。看看这个http://www.cadtutor.net/forum/showthread.php?96174-LISP自动标签编号系统Clint
 
  1. 7
回复

使用道具 举报

nafees

1

主题

3

帖子

2

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-5 18:55:38 | 显示全部楼层
非常感谢BIGAL它现在正在工作。。。谢谢
回复

使用道具 举报

返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-13 00:41 , Processed in 1.518265 second(s), 70 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表