乐筑天下

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

[编程交流] 块交换器lisp-请求

[复制链接]
sinnerboy

5

主题

18

帖子

13

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-5 23:39:22 | 显示全部楼层 |阅读模式
我非常喜欢lisps，但对其语言和结构一无所知。
 
任何人都可以用柚木帮助这个Lisp程序请-
 
目前，它允许您交换特定的块实例，方法是选择它们，然后键入要替换它们的块的名称。
 
我需要能够在屏幕上选择替换块。
 
 
  1. (defun c:blkreplacer (/ answr ent idx newname obj ss)
  2.  (vl-load-com)
  3.  ;;setup default on first run
  4.  (if (not jmm-replaceall)
  5.    (setq jmm-replaceall "Single")
  6.    )
  7.  (command ".undo" "be")
  8.  ;;if the user selects something, inputs a ne block name AND it exists in the dwg...
  9.  (if (and (setq ss (ssget '((0 . "INSERT"))));;REMOVED THE :S           
  10.             (progn
  11.      (initget "Single Global")
  12.      (if (setq answr (getkword "\nReplace just this Single selection or Globally replace?[single/Global]: "))
  13.        (setq jmm-replaceall answr)
  14.        (setq answr jmm-replaceall)
  15.        )
  16.      )
  17.    (setq newname (getstring "\nBlock name to replace with: "))
  18.    (tblobjname "BLOCK" newname)
  19.    )
  20.    (progn
  21.      (if (eq jmm-replaceall "Global");;get ALL occurances if it's Global, else use the original ss
  22. (setq ss (ssget "x" (list '(0 . "INSERT") (assoc 2 (entget (ssname ss 0))))))
  23. )
  24.      (setq idx -1)
  25.      (while (setq ent (ssname ss (setq idx (1+ idx))))
  26. (setq obj (vlax-ename->vla-object ent))
  27. (vla-put-name obj newname);;change the name
  28. (vla-update obj)
  29. )
  30.      )
  31.    )
  32.  (command ".undo" "end")
  33.  (princ (strcat "\nReplaced " (itoa idx) " blocks......"))
  34.  (princ)
  35.  )
回复

使用道具 举报

MSasu

35

主题

2471

帖子

2447

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
174
发表于 2022-7-5 23:47:45 | 显示全部楼层
尝试添加洋红色的代码；未测试：
  1. ...
  2. [color=magenta];[/color](setq newname (getstring "\nBlock name to replace with: "))
  3. [color=magenta](not (prompt "\nBlock name to replace with: "))[/color]
  4. [color=magenta](if (setq ssTemp (ssget ":S" '((0 . "INSERT"))))[/color]
  5. [color=magenta] (cdr (assoc 2 (entget (ssname ssTemp 0))))[/color]
  6. [color=magenta])[/color]
  7. (tblobjname "BLOCK" newname)
  8. ...
回复

使用道具 举报

pBe

32

主题

2722

帖子

2666

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
211
发表于 2022-7-5 23:55:12 | 显示全部楼层 
  1. (defun c:blkreplacer (/ [color="blue"]blcks a[/color] answr ent idx newname obj ss) 
  2.  (vl-load-com)
  3. [color="blue"] (setq blcks nil)
  4.  (while (setq a (tblnext "BLOCK" (null a)))
  5.                      (setq blcks (cons (cdr (assoc 2 a)) blcks)))[/color]
  6.  ;;setup default on first run 
  7.  (if (not jmm-replaceall) 
  8.    (setq jmm-replaceall "Single") 
  9.    ) 
  10.  (command ".undo" "be") 
  11.  ;;if the user selects something, inputs a ne block name AND it exists in the dwg... 
  12.  (if (and (setq ss (ssget '((0 . "INSERT"))));;REMOVED THE :S        
  13.             (progn 
  14.         (initget "Single Global") 
  15.         (if (setq answr (getkword "\nReplace just this Single selection or Globally replace?[single/Global]: ")) 
  16.           (setq jmm-replaceall answr) 
  17.           (setq answr jmm-replaceall) 
  18.           ) 
  19.         )
  20.    
  21. [color="#a0522d"];;;       (setq newname (getstring "\nBlock name to replace with: ")) 
  22. ;;;       (tblobjname "BLOCK" newname)[/color]
  23.   [color="blue"](setq newname (car (LM:ListBox "Select an Item" blcks n)))[/color]
  24.       ) 
  25.    (progn 
  26.      (if (eq jmm-replaceall "Global");;get ALL occurances if it's Global, else use the original ss 
  27.    (setq ss (ssget "x" (list '(0 . "INSERT") (assoc 2 (entget (ssname ss 0)))))) 
  28.    ) 
  29.      (setq idx -1) 
  30.      (while (setq ent (ssname ss (setq idx (1+ idx)))) 
  31.    (setq obj (vlax-ename->vla-object ent)) 
  32.    (vla-put-name obj newname);;change the name 
  33.    (vla-update obj) 
  34.    ) 
  35.      ) 
  36.    ) 
  37.  (command ".undo" "end") 
  38.  (princ (strcat "\nReplaced " (itoa idx) " blocks......")) 
  39.  (princ) 
  40.  )
  41. [color="blue"]
  42. ;;-----------------------=={ List Box }==---------------------;;
  43. ;;                                                            ;;
  44. ;;  Displays a List Box allowing the user to make a selection ;;
  45. ;;  from the supplied data.                                   ;;
  46. ;;------------------------------------------------------------;;
  47. ;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
  48. ;;------------------------------------------------------------;;
  49. ;;  Arguments:                                                ;;
  50. ;;  title    - List Box Dialog title                          ;;
  51. ;;  lst      - List of Strings to display in the List Box     ;;
  52. ;;  multiple - Boolean flag to determine whether the user     ;;
  53. ;;             may select multiple items (T=Allow Multiple)   ;;
  54. ;;------------------------------------------------------------;;
  55. ;;  Returns:  List of selected items, else nil.               ;;
  56. ;;------------------------------------------------------------;;
  58. (defun LM:ListBox ( title lst multiple / dch des tmp res )
  59.    (cond
  60.        (   (not
  61.                (and
  62.                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
  63.                    (setq des (open tmp "w"))
  64.                    (write-line
  65.                        (strcat
  66.                            "listbox : dialog { label = ""
  67.                            title
  68.                            ""; spacer; : list_box { key = "list"; multiple_select = "
  69.                            (if multiple "true" "false")
  70.                            "; } spacer; ok_cancel; }"
  71.                        )
  72.                        des
  73.                    )
  74.                    (not (close des))
  75.                    (< 0 (setq dch (load_dialog tmp)))
  76.                    (new_dialog "listbox" dch)
  77.                )
  78.            )
  79.            (prompt "\nError Loading List Box Dialog.")
  80.        )
  81.        (   t     
  82.            (start_list "list")
  83.            (foreach item lst (add_list item))
  84.            (end_list)
  85.            (setq res (set_tile "list" "0"))
  86.            (action_tile "list" "(setq res $value)")
  87.            (setq res
  88.                (if (= 1 (start_dialog))
  89.                    (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" res ")")))
  90.                )
  91.            )
  92.        )
  93.    )
  94.    (if (< 0 dch)
  95.        (unload_dialog dch)
  96.    )
  97.    (if (and tmp (setq tmp (findfile tmp)))
  98.        (vl-file-delete tmp)
  99.    )
  100.    res
  101. )[/color]
回复

使用道具 举报

sinnerboy

5

主题

18

帖子

13

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-6 00:00:02 | 显示全部楼层
谢谢MSasu
 
  1. (defun c:blkchang (/ answr ent idx newname obj ss)
  2.  (vl-load-com)
  3.  ;;setup default on first run
  4.  (if (not jmm-replaceall)
  5.    (setq jmm-replaceall "Single")
  6.    )
  7.  (command ".undo" "be")
  8.  ;;if the user selects something, inputs a ne block name AND it exists in the dwg...
  9.  (if (and (setq ss (ssget '((0 . "INSERT"))));;REMOVED THE :S       
  10.             (progn
  11.         (initget "Single Global")
  12.         (if (setq answr (getkword "\nReplace just this Single selection or Globally replace?[single/Global]: "))
  13.           (setq jmm-replaceall answr)
  14.           (setq answr jmm-replaceall)
  15.           )
  16.         )
  17.       ;(setq newname (getstring "\nBlock name to replace with: "))
  18. (not (prompt "\nBlock name to replace with: "))
  19. (if (setq ssTemp (ssget ":S" '((0 . "INSERT"))))
  20. (cdr (assoc 2 (entget (ssname ssTemp 0))))
  21. )
  22. (tblobjname "BLOCK" newname)
  23.       )
  24.    (progn
  25.      (if (eq jmm-replaceall "Global");;get ALL occurances if it's Global, else use the original ss
  26.    (setq ss (ssget "x" (list '(0 . "INSERT") (assoc 2 (entget (ssname ss 0))))))
  27.    )
  28.      (setq idx -1)
  29.      (while (setq ent (ssname ss (setq idx (1+ idx))))
  30.    (setq obj (vlax-ename->vla-object ent))
  31.    (vla-put-name obj newname);;change the name
  32.    (vla-update obj)
  33.    )
  34.      )
  35.    )
  36.  (command ".undo" "end")
  37.  (princ (strcat "\nReplaced " (itoa idx) " blocks......"))
  38.  (princ)
  39.  )
给出此错误消息
 
回复

使用道具 举报

sinnerboy

5

主题

18

帖子

13

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-6 00:08:16 | 显示全部楼层
pBe-也谢谢你。
 
这更好-但是，这会为您提供一个列表，其中有一个块名可供选择，用于替换块。希望修复它，因此只需指向并单击所需的块，而无需知道块名。
回复

使用道具 举报

MSasu

35

主题

2471

帖子

2447

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
174
发表于 2022-7-6 00:12:26 | 显示全部楼层
对不起，我错过了一些东西：
  1. ...
  2. [color=magenta];[/color](setq newname (getstring "\nBlock name to replace with: "))
  3. [color=magenta](not (prompt "\nBlock name to replace with: "))
  4. (if (setq ssTemp (ssget ":S" '((0 . "INSERT"))))
  5. [color=red](setq newname [/color](cdr (assoc 2 (entget (ssname ssTemp 0))))[color=red])[/color]
  6. )
  7. [/color](tblobjname "BLOCK" newname)
  8. ...
回复

使用道具 举报

sinnerboy

5

主题

18

帖子

13

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-6 00:16:05 | 显示全部楼层
 
完美的非常感谢你们两位。
 
我只是为了其他读者的利益张贴完整的lisp，他们可能会被lisp挑战像我一样
 
 
  1. (defun c:blkchang (/ answr ent idx newname obj ss)
  2.  (vl-load-com)
  3.  ;;setup default on first run
  4.  (if (not jmm-replaceall)
  5.    (setq jmm-replaceall "Single")
  6.    )
  7.  (command ".undo" "be")
  8.  ;;if the user selects something, inputs a ne block name AND it exists in the dwg...
  9.  (if (and (setq ss (ssget '((0 . "INSERT"))));;REMOVED THE :S       
  10.             (progn
  11.         (initget "Single Global")
  12.         (if (setq answr (getkword "\nReplace just this Single selection or Globally replace?[single/Global]: "))
  13.           (setq jmm-replaceall answr)
  14.           (setq answr jmm-replaceall)
  15.           )
  16.         )
  17.       ;(setq newname (getstring "\nBlock name to replace with: "))
  18. (not (prompt "\nBlock name to replace with: "))
  19. (if (setq ssTemp (ssget ":S" '((0 . "INSERT"))))
  20. (setq newname (cdr (assoc 2 (entget (ssname ssTemp 0)))))
  21. (cdr (assoc 2 (entget (ssname ssTemp 0))))
  22. )
  23. (tblobjname "BLOCK" newname)
  24.       )
  25.    (progn
  26.      (if (eq jmm-replaceall "Global");;get ALL occurances if it's Global, else use the original ss
  27.    (setq ss (ssget "x" (list '(0 . "INSERT") (assoc 2 (entget (ssname ss 0))))))
  28.    )
  29.      (setq idx -1)
  30.      (while (setq ent (ssname ss (setq idx (1+ idx))))
  31.    (setq obj (vlax-ename->vla-object ent))
  32.    (vla-put-name obj newname);;change the name
  33.    (vla-update obj)
  34.    )
  35.      )
  36.    )
  37.  (command ".undo" "end")
  38.  (princ (strcat "\nReplaced " (itoa idx) " blocks......"))
  39.  (princ)
  40.  )
回复

使用道具 举报

pBe

32

主题

2722

帖子

2666

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
211
发表于 2022-7-6 00:25:19 | 显示全部楼层
 
我知道这一点。我刚刚给了你一个选择，但我可以修改它来选择一个块或从列表中选择。你想要吗？
回复

使用道具 举报

sinnerboy

5

主题

18

帖子

13

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-6 00:27:30 | 显示全部楼层
不，我现在很好，但非常感谢
回复

使用道具 举报

pBe

32

主题

2722

帖子

2666

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
211
发表于 2022-7-6 00:38:35 | 显示全部楼层
 
嗯，我想你是对的。anyhoo公司
在选择匿名名称的块时请考虑这一点
 
  1. (while (not (progn (prompt "\nBlock name to replace with: ")
  2.                  (setq ssTemp (ssget ":S:E" '((0 . "INSERT"))))))
  3.                              (princ "\nInvalid Selection"))
  4.    (setq newname (vla-get-effectivename (vlax-ename->vla-object (ssname ssTemp 0))))
回复

使用道具 举报

12下一页
返回列表 发帖

发表回复

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

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-11 00:26 , Processed in 0.705540 second(s), 83 queries .

© 2020-2025 乐筑天下

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