程序工作，但有错误
大家好，我找到了cadalyst发布的“ATT-SELECT.lsp”。
它的作用：
-收集块的一个属性作为输入
-请注意此属性的值
-将属性标记和值与具有相同名称的所有其他块进行比较
-将匹配块放入选择集中
-最后提示一条消息，并告诉用户有多少这种类型的块具有相同的值。
这工作得很完美，速度也很快，因为程序通过ssget过滤器选择解析块名，并循环两次进行比较。
在我的例子中，所有要比较的块都被一条闭合多段线包围。
这使得：
-取选择集，
-提取插入点
-使用此插入点调用bhatch命令
-并对所有匹配的已建立区块进行bhatch。
我将代码中糟糕的部分直接放在最终提示消息之前，因此我确信选择集已经完成，我可以完成我的部分。
令我惊讶的是，所有的工作都很完美——除了少数情况下图案填充会失败（但这是一个小问题）——例程现在运行得相当慢，因为逐点图案填充需要时间，每次绘制图案填充后，我都会收到消息“未知命令”TT
但是我确信程序知道这个命令，因为它被定义为（defun C:TT（）
谁能解释一下为什么会这样？
代码下方：
;;;CADALYST 07/06Tip2128: ATT-SELECT.lspAttribute Filter (c) Raymond Rizkallah
(defun rt1 () ;;; only ATTRIB or NULL will be selected
(setq e1 (nentsel "\nSelect attribute to filter: "))
(if (null e1)
(progn (setq ex_tag nil) (QUIT))
(progn
(while (/= (cdr (assoc 0 (entget (car e1)))) "ATTRIB")
(PRINC "Attribute not found. ") (princ (cdr (assoc 0 (entget (car e1)))))
(RT1)
) ;end while
) ;end progn
) ;end if
)
;__________________________________________________________
(defun C:TT ()
(RT1)
;(setq e1 (nentsel "\nSelect attribute to filter: "))
(setvar "cmdecho" 0)
(setq eget (entget (car e1)))
(setq EX_STR (cdr (assoc 1 EGET))) ;EXISTING TEXTSTRING
(setq ex_tag (cdr (assoc 2 EGET))) ;EXISTING tag
(SETQ PT1 (CADR E1))
(SETQ SS0 (SSGET PT1))
(SETQ BLKNAME (CDR (ASSOC 2 (ENTGET (SSNAME SS0 0)))))
(prompt (strcat "\n Block: " blkname " Attribute tag: " ex_tag " >: " ex_str "\n "))
; +++ added code for new line at the end of prompt, just for better reading
;______________ SELECTING BLOCKS "BLKNAME" _________________
(SETQ LST1 (LIST '(0 . "INSERT") (CONS 2 BLKNAME)) )
(SETQ SS1 (SSGET "X" LST1))
; (SETQ SS1 (SSGET LST1))
; (IF (NULL SS1) (SETQ SS1 (SSGET "X" LST1)) )
(setq SSM (SSADD))
(setq len1 (sslength ss1) n1 0 ssx (ssadd))
(WHILE (< n1 len1) ;WHILE 1
(setq ename1 (ssname ss1 n1) eget1 (entget ename1) CTRL1 nil COUNTER 0 str1 "")
(SETQ en1 ename1)
;____ Find Tag Level
(while (and (null ctrl1) (/= (CDR (ASSOC 0 (ENTGET (setq en1 (ENTNEXT en1))))) "SEQEND"))
(setq tag1 (CDR (ASSOC 2 (ENTGET en1))))
(if (= tag1 ex_tag) (setq str1 (CDR (ASSOC 1 (ENTGET en1))) ctrl1 T))
(setq counter (1+ counter))
) ;end while2
;_____
;(if (= str1 ex_str) (princ str1))
(if (= (STRCASE str1) (STRCASE ex_str)) (setq ssx (ssadd ename1 ssx)))
(setq n1 (1+ n1))
) ; end WHILE1
(setq lenx (sslength ssx))
(command "._select" ssx "")
; +++ from here starts my code +++
(command "_zoom" "_e") ; zoom to extends, neccassary for hatching
(repeat (setq n (sslength ssx)) ; loop till any part of the selection-set is proccessed
(setq en (ssname ssx (setq n (1- n)))) ; get entity-name
(setq p1 (cdr (assoc 10 (entget en)))) ; extract insertion-point
(progn ; force hatch to use solid
(setvar "HPNAME" "SOLID")
(command ".-bhatch" p1 "" "") ; do a hatch, point to the insertion-point of entity
) ; end of progn
) ; end of repeat
; +++ end of my code +++
(PROMPT (strcat "\n Match found : [" (itoa lenx) "]. Selected objects are stored in Previous Selection."))
(setvar "cmdecho" 1)
(princ)
)
;_____________________________________________________________
(prompt "\n Start command with - by Raymond Rizkallah -April 06. ")
(PRINC)
问候
沃尔夫冈 这通常意味着您的代码中有一个额外的“”，它尝试重新调用最后一个命令mid lisp。。。
李 李，
谢谢你的快速回答（像往常一样）！
我在我的中找到了多余的“”-bhatch命令。
改变
(command ".-bhatch" p1 "" "")至
一切都很完美！
亲切的问候
沃尔夫冈 另一种方法：
3 李，
我花了两天零一个晚上的时间在我在万维网上找到的东西上添加了10行代码。
你需要53分钟，包括阅读我的消息，设置你的代码和张贴！
我在许多论坛上搜索了属于autocad lisp的不同主题，有一天我注意到，大约一年前，一个叫“Lee Mac”的人在这里和沼泽地开始了第一篇帖子。
看到你每天都在增长的编程技能真是太棒了！
你给我们的不仅仅是一些善意的建议，这太好了！
我可以建议您对代码做一点小改动吗？
请在其中添加（蓝色的）：
如果孔图不可见，这将确保图案填充功能不会停止。（我建议您始终必须“放大”以选择属性）。
亲切的问候
沃尔夫冈 谢谢Wolfgang
请随意修改我的代码，我张贴它来帮助你学习。
谢谢
李
页:
[1]