需要口齿不清的帮助吗
嗨，peeps。有一个来自autodesk的lisp我已经稍微修改过了，现在做的是删除重复的文本字符串。
我需要你们中的一个好人做的是，不要删除重复的文本字符串，我想把它变成红色。
提前谢谢，非常感谢。
（定义c:deldup1\u txt（/ss ssdup ct len e eb）
pt lay ang sty hgt str obj obj_列表）
（princ“\n选择文本对象。”）；选择对象并过滤除块插入对象之外的所有对象。
（setq ss（ssget（列表（cons 0“TEXT”）））
（如果ss；如果选择了任何有效对象。
（程序
（princ“\n构建对象列表。”）
（setq ssdup（ssadd））；初始化新选择集以保留要删除的对象
（setq len（sslength ss））；找出选择了多少个对象。
（setq ct 0）
（虽然(
（setq e（ssname ss ct））；获取对象名称
（setq eb（entget e））；从对象名称获取实体列表
（setq ct（+ct 1））；将索引增加到选择集中
（setq str（cdr（assoc 1 eb））；访问对象的文本字符串
;列出对象属性
（setq obj（列表pt lay ang sty hgt str））
（如果（不是（成员obj obj_列表））；如果这些属性不在列表中
（setq obj_列表（cons obj obj_列表））；将其添加到列表中
（ssadd e ssdup）；否则，将对象添加到选择集以删除
) ;如果结束
) ;while循环结束
（如果（>（sslength ssdup）0）；如果选择集中有任何要删除的对象
（程序
（原理“\n删除重复对象。”）
（setq len（sslength ssdup））；找出要删除多少个对象。
（setq ct 0）
（虽然(
（setq e（ssname ssdup ct））；获取对象名称
（setq ct（+ct 1））；将索引增加到选择集中
（entdel e）；删除重复对象
) ;while循环结束
（princ；打印删除到命令行的对象数
（strcat“\n已删除”
（itoa len）
“复制对象。”
))
) ;结束程序
（princ“\n未找到重复项。”）；否则没有要删除的重复项。
) ;如果结束
) ;结束程序
（princ“\n未选择文本对象。”）；否则没有选择有效的对象
) ;如果结束
（普林斯）
) 啊哼。代码发布指南。 新来的网站吗？ 是的，我注意到了，这就是为什么我在没有棍子威胁的情况下为你指出了正确的方向 请检查这是否是您想要的（红色变化）：
(defun c:deldup1_txt(/ ss ssdup ct len e eb pt lay ang sty hgt str obj obj_list)
(princ "\nSelect text objects.") ;Select objects and filter all but block insert objects.
(setq ss (ssget (list (cons 0 "TEXT"))))
(if ss ;If any valid objects were selected.
(progn
(princ "\nBuilding list of objects.")
(setq ssdup (ssadd)) ;Initialize new selection set to hold objects to delete
(setq len (sslength ss)) ;Find out how many objects were selected.
(setq ct 0)
(while (< ct len) ;Loop through selected objects
(setq e (ssname ss ct)) ;Get an object name
(setq eb (entget e)) ;Get the entity list from the object name
(setq ct (+ ct 1)) ;Increment index into selection set
(setq str (cdr (assoc 1 eb))) ;Access object's text string
;Make list of object properties
(setq obj (list pt lay ang sty hgt str))
(if (not (member obj obj_list)) ;If these properties are not already in list
(setq obj_list (cons obj obj_list)) ;Add them to the list
(ssadd e ssdup) ;Else add object to selection set to delete
) ;End if
) ;End of while loop
(if (> (sslength ssdup) 0) ;If there are any objects in the selection set to delete
(progn
(princ "\nMarking duplicate objects.")
(setq len (sslength ssdup)) ;Find out how many many objects to delete.
(setq ct 0)
(while (< ct len) ;Loop through objects and delete.
(setq e (ssname ssdup ct)) ;Get object name
(setq ct (+ ct 1)) ;Increment index into selection set
; (entdel e) ;Delete duplicate object
(command "_CHPROP" e "" "_C" 1 "")
) ;End of while loop
(princ ;Print the number of objects deleted to command line
(strcat "\n"
(itoa len)
" duplicate objects colored in RED."
))
) ;End progn
(princ "\nNo duplicates found.") ;Else no there were no duplicates to delete.
) ;End if
) ;End progn
(princ "\nNo text objects selected.") ;Else there were no valid objects selected
) ;End if
(princ)
)
当做
米尔恰 很好吃谢谢 欢迎你！
此外，请编辑您的第一篇文章，添加这些代码括号，它会看起来更好。
当做
米尔恰 不管好坏
(defun C:dupsamestr(/ ss e lst str)
(vl-load-com)
(if (setq lst nil
ss(ssget ":L" '((0 . "TEXT"))))
(repeat (setq i (sslength ss))
(setq e (ssname ss 0))
(if (setq f (member (setq str(cdr (assoc
1
(entget e))))
lst))
(vla-put-color (vlax-ename->vla-object e) 1)
(setq lst (cons str lst))
)
(ssdel e ss)
)
)
(princ (strcat "\nFound "
(itoa (- i (length lst) ))
" Duplicate String"))
(princ)
)
很好的解决方案pBe。
如果你不介意的话，请发表一条评论；恐怕您的复制件柜台有问题：
(itoa (- i (length lst) (length lst)))
当做
米尔恰
[代码更新]
抓得好Mircea。我复制粘贴过多。
干杯
页:
[1]
2