乐筑天下

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

[编程交流] lisp帮助-添加（ssget）

[复制链接]
iconeo

12

主题

152

帖子

140

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
60
发表于 2022-7-5 17:48:27 | 显示全部楼层 |阅读模式
lisp只需获取一个对象并将其发送到“现有”层。
 
我希望能够通过选择单个对象或一组对象来运行此lisp，但我不确定一旦有了对象，如何浏览对象列表。感谢您的帮助。
 
附加：我想如果可以通过选择对象然后运行lisp或运行lisp然后选择对象来运行lisp，那将是一件好事。。。这有意义吗？
 
  1. ;;load the visual lisp extensions
  2. (vl-load-com)
  4. (defun c:sendtoexisting        (/ object)
  6.  ;;check for selection
  7.  (while
  8.    (setq
  9.      sset
  10.       (car (entsel "\nSelect object to move to existing layer:")
  11.       )
  12.    )
  14.     ;;convert to vl object
  15.     (setq sset (vlax-ename->vla-object sset))
  16.     ;;get current layer of object
  17.     (setq clayer (vla-get-layer sset))
  18.     (if (= nil (vl-string-search "EXST" clayer))
  19.       (progn
  21.  ;;set existing layer
  22.  (setq elayer (strcat "S-EXST" (substr clayer 2)))
  24.  ;;create the existing layer
  25.  (_createlayer
  26.    elayer
  27.    155
  28.    (cdr (assoc 6 (tblsearch "LAYER" clayer)))
  29.  )
  31.  ;;move the object to the existing layer       
  32.  (vla-put-layer sset elayer)
  34.  ;;set the object's color to ByLayer
  35.  (vla-put-color sset 256)
  37.       )
  38.       (princ "\nObject is already on an EXISTING layer.")
  39.     )
  40.  )
  41. )
  43. (defun _createlayer (name colour linetype)
  44.  (if (null (tblsearch "LAYER" name))
  45.    (entmake
  46.      (list
  47. '(0 . "LAYER")
  48. '(100 . "AcDbSymbolTableRecord")
  49. '(100 . "AcDbLayerTableRecord")
  50. '(70 . 0)
  51. (cons 2 name)
  52. (cons 6 linetype)
  53. (cons 62 colour)
  54.      )
  55.    )
  56.  )
  57. )
回复

使用道具 举报

Tharwat

63

主题

6297

帖子

6283

银币

后起之秀

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

铜币
358
发表于 2022-7-5 18:03:35 | 显示全部楼层
你好
 
试试这个未经测试的快速mods。
  2. (vl-load-com)
  3. (defun c:sendtoexisting  (/ ss i obj clay nlay)
  4.  (princ "\nSelect objects to move to existing layer:")
  5. (if (setq ss (ssget "_:L"))
  6.   (repeat (setq i (sslength ss))
  7.     (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i))))
  8.           clayer (vla-get-layer obj)
  9.           )
  10.     (if (not (vl-string-search "EXST" clay))
  11.       (progn
  12.         (setq nlay (strcat "S-EXST" (substr clay 2)))
  13.         (_createlayer nelayer 155 (cdr (assoc 6 (tblsearch "LAYER" clay))))
  14.         (vla-put-layer obj nlay)
  15.         (vla-put-color obj 256)
  16.         )
  17.       (princ "\nObject is already on an EXISTING layer.")
  18.       )
  19.     )
  20.  )
  21.  (princ)
  22.  )
  24. (defun _createlayer  (name colour linetype)
  25.  (if (null (tblsearch "LAYER" name))
  26.    (entmake
  27.      (list
  28.        '(0 . "LAYER")
  29.        '(100 . "AcDbSymbolTableRecord")
  30.        '(100 . "AcDbLayerTableRecord")
  31.        '(70 . 0)
  32.        (cons 2 name)
  33.        (cons 6 linetype)
  34.        (cons 62 colour)
  35.        )
  36.      )
  37.    )
  38.  )
回复

使用道具 举报

David Bethel

26

主题

1495

帖子

20

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
118
发表于 2022-7-5 18:19:38 | 显示全部楼层
或者在vanilla AutoLisp中使用更强大的力量：
 
  2. [b][color=BLACK]([/color][/b]defun c:exlayer [b][color=FUCHSIA]([/color][/b]/ ln ss i en ed vn vd[b][color=FUCHSIA])[/color][/b]
  4.  [b][color=FUCHSIA]([/color][/b]setq ln [color=#2f4f4f]"EXISTING"[/color][b][color=FUCHSIA])[/color][/b]
  6.  [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]not [b][color=MAROON]([/color][/b]tblsearch [color=#2f4f4f]"LAYER"[/color] ln[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
  7.      [b][color=NAVY]([/color][/b]command [color=#2f4f4f]"_.LAYER"[/color] [color=#2f4f4f]"_N"[/color] ln [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
  9.  [b][color=FUCHSIA]([/color][/b]princ [b][color=NAVY]([/color][/b]strcat [color=#2f4f4f]"\nSelect Entities To Change To Layer "[/color] ln[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
  10.  [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not ss[b][color=NAVY])[/color][/b]
  11.         [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
  13.  [b][color=FUCHSIA]([/color][/b]setq i 0[b][color=FUCHSIA])[/color][/b]
  14.  [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq en [b][color=MAROON]([/color][/b]ssname ss i[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
  15.         [b][color=NAVY]([/color][/b]setq ed [b][color=MAROON]([/color][/b]entget en[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
  16.         [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]= 1 [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 66 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
  17.             [b][color=MAROON]([/color][/b]progn
  18.               [b][color=GREEN]([/color][/b]setq vn [b][color=BLUE]([/color][/b]entnext en[b][color=BLUE])[/color][/b]
  19.                     vd [b][color=BLUE]([/color][/b]entget vn[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
  20.               [b][color=GREEN]([/color][/b]while [b][color=BLUE]([/color][/b]/= [color=#2f4f4f]"SEQEND"[/color] [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 0 vd[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
  21.                      [b][color=BLUE]([/color][/b]entmod [b][color=RED]([/color][/b]subst [b][color=PURPLE]([/color][/b]cons 8 ln[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]assoc 8 vd[b][color=PURPLE])[/color][/b] vd[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
  22.                      [b][color=BLUE]([/color][/b]setq vn [b][color=RED]([/color][/b]entnext vn[b][color=RED])[/color][/b]
  23.                            vd [b][color=RED]([/color][/b]entget vn[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
  24.               [b][color=GREEN]([/color][/b]entupd en[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
  25.            [b][color=MAROON]([/color][/b]entmod [b][color=GREEN]([/color][/b]subst [b][color=BLUE]([/color][/b]cons 8 ln[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]assoc 8 ed[b][color=BLUE])[/color][/b] ed[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
  26.         [b][color=NAVY]([/color][/b]setq i [b][color=MAROON]([/color][/b]1+ i[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
  28.  [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 
-大卫
回复

使用道具 举报

iconeo

12

主题

152

帖子

140

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
60
发表于 2022-7-5 18:35:59 | 显示全部楼层
谢谢你们俩的帮助。最后一个问题。
 
我添加了只选择一个对象或整个层的选项，但是在我处理对象的情况下，如何将初始entsel从initget添加到ss选择集。基本上，我必须双击我现在想要选择的第一个项目，这是我想要避免的。
 
谢谢
 
  1. ;; by Chau Huh 2015-10-21
  3. ;;load the visual lisp extensions
  4. (vl-load-com)
  6. (defun c:sendtoexisting
  7.       (/ ss i obj clayer nlayer ans TargEnt TargLayer)
  8. ;;;  (princ "\nSelect objects to move to existing layer:")
  10.  (initget 1 "Object lAyer")
  11.  (setq ans (entsel (strcat "Select by [Object/lAyer] <Object>: ")))
  13.  (if (= ans "lAyer")
  14.    (progn
  15.      (princ "\nSelect layer to move to existing: ")
  16.      (setq TargEnt (car (entsel "\nSelect object on layer: ")))
  17.      (setq TargLayer (assoc 8 (entget TargEnt)))
  18.      (sssetfirst nil (ssget "_X" (list TargLayer)))
  19.      (princ)
  20.    )
  21.  )
  23.  (if (setq ss (ssget "_:L"))
  24.    (repeat (setq i (sslength ss))
  25.      (setq obj           (vlax-ename->vla-object (ssname ss (setq i (1- i))))
  26.     clayer (vla-get-layer obj)
  27.      )
  28.      (if (not (vl-string-search "EXST" clayer))
  29. (progn
  30.   (setq nlayer (strcat "S-EXST" (substr clayer 2)))
  31.   (_createlayer
  32.     nlayer
  33.     155
  34.     (cdr (assoc 6 (tblsearch "LAYER" clayer)))
  35.   )
  36.   (vla-put-layer obj nlayer)
  37.   (vla-put-color obj 256)
  38. )
  39. (princ "\nObject is already on an EXISTING layer.")
  40.      )
  41.    )
  42.  )
  44.  (princ)
  45. )
  47. (defun _createlayer (name colour linetype)
  48.  (if (null (tblsearch "LAYER" name))
  49.    (entmake
  50.      (list
  51. '(0 . "LAYER")
  52. '(100 . "AcDbSymbolTableRecord")
  53. '(100 . "AcDbLayerTableRecord")
  54. '(70 . 0)
  55. (cons 2 name)
  56. (cons 6 linetype)
  57. (cons 62 colour)
  58.      )
  59.    )
  60.  )
  61. )
回复

使用道具 举报

broncos15

95

主题

477

帖子

383

银币

后起之秀

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

铜币
475
发表于 2022-7-5 18:46:40 | 显示全部楼层
利用ssadd功能。
回复

使用道具 举报

David Bethel

26

主题

1495

帖子

20

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
118
发表于 2022-7-5 18:59:29 | 显示全部楼层
您要更改的图层上是否已经选择了实体？
回复

使用道具 举报

返回列表 发帖

发表回复

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

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-13 00:03 , Processed in 0.543422 second(s), 64 queries .

© 2020-2025 乐筑天下

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