sailorcwx
发表于 2008-7-13 22:18:00
<p>那个是你的操作错误，当你的回车次数等于查找的文字的个数的时候，程序结束退出了。而你此时再按回车，就是重复上一次命令，就再度启动程序。</p>
phoenixdjq
发表于 2008-7-14 21:21:00
<p>我的程序仅用于这样的编号<1> <2> <3>.......</p><p>(defun zhao()<br/>(setq nn (nth 0 zuixiao))<br/>(setq jg (strcat "您所选择的最小杆件号是" (itoa nn)))<br/>(alert jg)<br/>(setq xunhuan (nth 0 zuida))<br/>(setq jg1 (strcat "您所选择的最大杆件号是" (itoa xunhuan)))<br/>(alert jg1)<br/>(while (<= nn xunhuan)<br/>(setq len2 (vl-list-length biao))<br/>(setq biao1 (vl-remove nn biao))<br/>(setq len3 (vl-list-length biao1))<br/>(setq jieguo (- len2 len3))<br/>(cond </p><p>((= jieguo 0) <br/>(progn<br/>(setq mm (strcat "件号" (itoa nn) "是空号"))<br/>(prompt "\n" )<br/>(prompt mm )</p><p>) ;end progn</p><p><br/>)</p><p></p><p><br/>((= jieguo 1) (princ))</p><p>(t<br/>(progn<br/>(setq mm (strcat "件号" (itoa nn) "有" (itoa jieguo) "件重号" )) <br/>(prompt "\n" )<br/>(prompt mm )<br/>) ;end progn<br/>) ;end </p><p>) ;end cond<br/>(setq nn (+ 1 nn))<br/>) ;end repeat<br/>(princ)</p><p>)</p><p></p><p>;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br/>(defun zhao1()<br/>(setq nn (nth 0 zuixiao))<br/>(setq jg (strcat "您所选择的最小杆件号是" "PG" (itoa nn)))<br/>(alert jg)<br/>(setq xunhuan (nth 0 zuida))<br/>(setq jg1 (strcat "您所选择的最大杆件号是" "PG" (itoa xunhuan)))<br/>(alert jg1)<br/>(while (<= nn xunhuan)<br/>(setq len2 (vl-list-length biao))<br/>(setq biao1 (vl-remove nn biao))<br/>(setq len3 (vl-list-length biao1))<br/>(setq jieguo (- len2 len3))<br/>(cond </p><p>((= jieguo 0) <br/>(progn<br/>(setq mm (strcat "件号" "PG" (itoa nn) "是空号"))<br/>(prompt "\n" )<br/>(prompt mm )</p><p>) ;end progn<br/>)</p><p></p><p><br/>((= jieguo 1) (princ))</p><p>(t<br/>(progn<br/>(setq mm (strcat "件号" "PG" (itoa nn) "有" (itoa jieguo) "件重号" )) <br/>(prompt "\n" )<br/>(prompt mm )<br/>) ;end progn<br/>) ;end </p><p>) ;end cond<br/>(setq nn (+ 1 nn))<br/>) ;end repeat<br/>(princ)<br/>)</p><p></p><p>(defun c:chpgl()<br/>(vl-load-com)<br/>(setq ss (ssget '((0 . "TEXT,MTEXT"))))<br/>(setq len (sslength ss))<br/>(setq n 0)</p><p>(if (/= biao nil)<br/>(setq biao nil)<br/>)<br/>(repeat len<br/>(setq ent (ssname ss n))<br/>(setq dxf (entget ent))<br/>(setq wenzi (cdr (assoc 1 dxf)))<br/>(setq zitou (substr wenzi 1 3))<br/>(if (= zitou "<PG")<br/>(progn <br/>(setq zifu (substr wenzi 4))<br/>(setq shishu (atoi zifu))<br/>(setq biao (cons shishu biao))<br/>) ;end progn<br/>) ;end if</p><p>(setq n (+ 1 n))<br/>) ;end repeat<br/>(setq zuixiao (vl-sort biao '<))<br/>(setq zuida (vl-sort biao '>))<br/>(setq len1 (vl-list-length biao))<br/>(zhao1)<br/>(textscr)<br/>(princ)<br/>)</p><p></p><p></p><p><br/>;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</p><p><br/>(defun c:ch()<br/>(vl-load-com)<br/>(prompt "请选择您要查询的杆件号,但不要选择说明中的文字:")<br/>(setq ss (ssget '((0 . "TEXT,MTEXT"))))<br/>(setq len (sslength ss))<br/>(setq n 0)</p><p>(if (/= biao nil)<br/>(setq biao nil)<br/>)<br/>(repeat len<br/>(setq ent (ssname ss n))<br/>(setq dxf (entget ent))<br/>(setq wenzi (cdr (assoc 1 dxf)))<br/>(setq zitou (substr wenzi 1 1))<br/>(setq dier (substr wenzi 2 1))<br/>(setq shishu1 (atoi dier))<br/>(setq pg (substr wenzi 1 3))<br/>(if (and (= zitou "<") (/= shishu1 0))<br/>(progn <br/>(setq zifu (substr wenzi 2))<br/>(setq shishu (atoi zifu))<br/>(setq biao (cons shishu biao))<br/>) ;end progn<br/>) ;end if</p><p>(setq n (+ 1 n))<br/>) ;end repeat<br/>(setq zuixiao (vl-sort biao '<))<br/>(setq zuida (vl-sort biao '>))<br/>(setq len1 (vl-list-length biao))<br/>(zhao)<br/>(textscr)<br/>(princ)</p><p>)<br/>(prompt "\n 查询普通杆件用ch命令,查询组合梁用chpgl")<br/>(prompt "\n 普通梁杆件号仅限<*>格式,组合梁仅限<PG*>格式, *为任意数字")<br/>(prompt "\n 本程序作者:窦俊强,如有问题请与作者联系qq :53124174")<br/></p>
dengken204
发表于 2008-7-14 23:05:00
<p>我选择了“KLA9-2(1)”</p><p>结果是：</p><p>命令: CH 请选择您要查询的杆件号,但不要选择说明中的文字:<br/>选择对象: 找到 1 个</p><p>选择对象: ; 错误: 参数类型错误: consp nil</p><p></p><p>问题出在哪里？</p>
phoenixdjq
发表于 2008-7-15 22:28:00
<p>当然是文字特性的问题了</p><p>我的程序是因为我工作中需要而为自己编的</p><p>仅用于<1> <2> <3>....这样的类型的</p><p>我的程序不适合你这样的类型</p>
sailorcwx
发表于 2008-7-16 00:45:00
;find扩展 by weltion chen
;全选输入all
;*匹配模糊查找
;查找字符a，输入a
;查找字符a开头的字符串，输入a*
;查找字符a结尾的字符串,输入*a
;查找带字符a的字符串,输入*a*
(defun c:finde( / ACADAPP ACADDOC ENT FINDSTR INDEX LEFTDOWNPOINT NEWSTR OBJ RIGHTUPPOINT SLTOPL SLTSET)
;加载Vlisp函数
(vl-load-com)
(setq
;AutoCAD
acadapp (vlax-get-acad-object)
;当前文档
acaddoc (vla-get-activedocument acadapp)
)
;定义关键字
(initget "I")
;带选项的选择
(setq SltOpl (entsel "\n选择查找的文字对象或[手工输入(I)]："))
;是否空选
(if SltOpl
;进行操作判断
(progn
(if (= SltOpl "I")
;手工输入
(setq findstr (getstring "\n输入查找字符串，输入*匹配搜索: "))
;拾取TEXT
(progn
;图元名称
(setq ent (car SltOpl)
;转化成VLA对象名称
obj (vlax-ename->vla-object ent)
)
;判断是否为TEXT对象
(if (= (vla-get-objectname obj) "AcDbText")
;OK，把字符串提出来吧
(setq findstr (vla-get-textstring obj))
)
)
)
;不管哪种方式取值，只要有值就执行查找
(if findstr
(progn
;获取满足条件的TEXT选集
(setq sltset (ssget (list '(0 . "TEXT") (cons 1 findstr)))
;定义一个索引号
index 0
)
;遍历选集一个个显示或修改
(repeat (sslength sltset)
;提取图元对象
(setq ent (ssname sltset index)
;转化为VLA对象名称
obj (vlax-ename->vla-object ent)
)
;获取外框
(vla-getboundingbox obj 'leftdownpoint 'rightuppoint)
;锁定目标
(vla-zoomwindow acadapp leftdownpoint rightuppoint)
;扩大视图范围
(vla-zoomscaled acadapp 0.5 acZoomScaledRelative)
;修改内容
(setq newstr (getstring 0 "\n输入修改内容或<回车查找下一个,ESC退出>: "))
(if (/= newstr "")
;替换文字内容
(vla-put-textstring obj newstr)
)
;next one
(setq index (1+ index))
)
)
)
)
)
;静默退出
(princ)
)
sailorcwx
发表于 2008-7-16 01:08:00
<p> 默认全选把<br/>(setq sltset (ssget (list '(0 . "TEXT") (cons 1 findstr)))<br/>改成<br/>(setq sltset (ssget "X" (list '(0 . "TEXT") (cons 1 findstr)))</p>