明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 11045|回复: 58

[已解答] 请代写“点选图元更改图层名称”程序

  [复制链接]
发表于 2015-6-5 18:08 | 显示全部楼层 |阅读模式
1明经币
平时处理外来dxf格式文件较多,因为图层较多且图层名称很乱,在图层管理器里改很费时,还得狂点击鼠标查看一个层包含的图元,本人lisp刚入门,所以请帮忙代写一段程序。小弟是新手,悬赏有点少,请勿见怪!!!谢谢
希望实现的功能:1,碰选任意图元,该图元所在层的全部图元亮显
                         2,屏幕显示(注意是屏显,不是命令行)原图层名称,并提示输入新图层名称
                         3,输入新图层名击右键后,该图层关闭,此时命令循环

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2015-6-5 19:17 | 显示全部楼层
  1. ;; tt1: 点选任意图元,该图元所在层的全部图元亮显
  2. (defun c:tt1 ()
  3.   (if (setq s1 (car (entsel "\n选择: ")))
  4.     (sssetfirst nil (ssget "x" (list (assoc 8 (cdr (entget s1))))))
  5.   )
  6.   (princ)
  7. )
回复

使用道具 举报

 楼主| 发表于 2015-6-5 19:22 | 显示全部楼层
xyp1964 发表于 2015-6-5 19:17

老大,好人做到底高抬贵手写个完整的呗,这个程序对我很重要,忙活一下午了,光去改图层名称了。

点评

剩下的给别人玩玩……  发表于 2015-6-5 19:50
回复

使用道具 举报

 楼主| 发表于 2015-6-5 20:35 | 显示全部楼层
冒个烟圈 发表于 2015-6-5 19:22
老大,好人做到底高抬贵手写个完整的呗,这个程序对我很重要,忙活一下午了,光去改图层名称了。

差一点就完成了,会弄的伙计们出手帮帮忙呀。。明天加班等着用呢。。
回复

使用道具 举报

 楼主| 发表于 2015-6-6 08:00 | 显示全部楼层
不能沉啊。。来个帮忙的啊。
回复

使用道具 举报

 楼主| 发表于 2015-6-6 21:05 | 显示全部楼层
高手们都去哪了。。这个程序是不是很麻烦?还是悬赏少的原因啊
回复

使用道具 举报

发表于 2015-6-7 01:25 | 显示全部楼层
冒个烟圈 发表于 2015-6-6 21:05
高手们都去哪了。。这个程序是不是很麻烦?还是悬赏少的原因啊

一点都不麻烦,其实是我们希望你加班多挣点钱
回复

使用道具 举报

 楼主| 发表于 2015-6-7 07:19 | 显示全部楼层
荒野孤行 发表于 2015-6-7 01:25
一点都不麻烦,其实是我们希望你加班多挣点钱

加班不给钱。。只有少许的补助
请出手发招!!!
回复

使用道具 举报

发表于 2015-6-7 13:49 | 显示全部楼层
本帖最后由 荒野孤行 于 2015-6-7 13:51 编辑

如果输入的图层名与已有图层名重复,这种情况未排除,所以写的不是很完美,但可满足你的基本要求吧!

(defun c:t1 ()
  (setvar "cmdecho" 0)
  (vl-load-com)
  (princ "\n★功能:点选图元更改其所在图层的名字。")
  (command "undo" "be")
  (while
    (progn (setq sel
                  (entsel
                    "\n请点选直线、多段线、样条曲线、标注、圆弧、圆、椭圆(不支持选图块)\n"
                  )
           )
           (wcmatch (cdr (assoc 0 (entget (car sel))))
                    "*LINE,*TEXT,ARC,CIRCLE,ELLIPSE,DIMENSION"
           )
    )
    ;|    (setq atcad     (vlax-get-acad-object)
           doc             (vla-get-activedocument atcad)
           layers    (vla-get-layers doc)
           layerlist nil
     )
(vlax-for each layers
       (setq nam       (vla-get-name each)
             layerlist (cons (list nam) layerlist)
       )
     )|;
     (setq laynam (cdr (assoc 8 (entget (car sel)))))
     (princ (strcat "\n提示:您选中的图元所在图层为:" laynam))
     (if (setq newlaynam (getstring "\n请输入新的图层名:"))
       (command "rename" "LA" laynam newlaynam)
       (princ "\n输入的图层名为空或与现已有图层名相同。\n")
     )
  )
  (command "undo" "e")
  (princ)
)

评分

参与人数 1明经币 +1 收起 理由
USER2128 + 1 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2015-6-7 16:52 | 显示全部楼层
回复瞧瞧。。。。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 19:20 , Processed in 0.224064 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表