找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 3724|回复: 27

[LISP程序]:终于搞定了"01"COPY成"02""03"这种形式。

[复制链接]
发表于 2003-5-11 21:52:17 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
是不是可用性不太高?
又修改了一些。
lisp为   写字符.lsp
DCL为  写字符.dcl
可以在下边下载。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 145个

财富等级: 日进斗金

发表于 2003-5-11 21:54:37 | 显示全部楼层

Re: [LISP程序]:终于搞定了"01"COPY成"02""03"这种形式。

最初由 张世杰 发布
[B]是不是可用性不太高? [/B]


只要是能解决实际工作需要的,就是有用的,把程序给大家贴上来吧,谢谢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-5-11 23:35:45 | 显示全部楼层
发一个以前写的,要用doslib。当时没考虑补位。


  1. (defun c:szpx(/ A CS D IN P0 P11 SSZ SZ TSZ XYZ-SZPX ZC ZCT ZCW)
  2.   (undo_begin)
  3.   (mapcar 'setvar '("cmdecho""blipmode")'(0 0))
  4.   (setq xyz-szpx (if xyz-szpx xyz-szpx
  5.                    '(("字串头" . "")("头数字" . "1") ("字串尾" . "")("数字升值" . "1")("排列次数" . "10")))
  6.         xyz-szpx(dos_proplist "--by陈勇--" "文字数字排序【数字位数=0表示不补位】" xyz-szpx)
  7.         zct(dxf "字串头" xyz-szpx)zcw(dxf "字串尾" xyz-szpx)
  8.         tsz(distof (dxf "头数字" xyz-szpx))
  9.         ssz(distof (dxf "数字升值" xyz-szpx))
  10.         cs(atoi (dxf "排列次数" xyz-szpx))
  11.         p0(getpoint "\n选择第一个文字的插入点:")
  12.         d(getdist p0 "\n输入文字的排列间距:"))
  13.   (setq a(getangle p0 "\n输入文字的排列角度:")
  14.         in 0)
  15.   (repeat cs
  16.     (setq sz(+ tsz (* in ssz))
  17.           zc(strcat zct (rtos sz 2 0) zcw)
  18.           p11(polar p0 a (* in d))
  19.           in(1+ in))
  20.     (#M_TXT p11 zc "DXFS" (* 3.0 0bl) 0.7 0 0 0 "dim" -1)
  21.   )
  22.   (mapcar 'setvar '("cmdecho""blipmode")'(1 1))
  23.   (undo_end)(princ)
  24. )



增加补位。


  1. (defun c:szpx1(/ A CS D IN P0 P11 SSZ SZ SZ2 SZZ TSZ WS1 WS2 ZC ZCT ZCW)
  2.   (undo_begin)
  3.   (mapcar 'setvar '("cmdecho""blipmode")'(0 0))
  4.   (setq xyz-szpx (if xyz-szpx xyz-szpx
  5.                    '(("字串头" . "")("起始数字" . "1") ("字串尾" . "")("数字升值" . "1")("排列次数" . "10")))
  6.         xyz-szpx(dos_proplist "--by陈勇--" "文字数字排序【数字位数=0表示不补位】" xyz-szpx)
  7.         zct(dxf "字串头" xyz-szpx)zcw(dxf "字串尾" xyz-szpx)
  8.         tsz(atoi (dxf "起始数字" xyz-szpx))
  9.         ssz(atoi (dxf "数字升值" xyz-szpx))
  10.         cs(atoi (dxf "排列次数" xyz-szpx))
  11.         sz2(+ tsz (* ssz cs))
  12.         ws2(strlen (itoa sz2))
  13.         ;;bw(- ws2 ws1)
  14.         p0(getpoint "\n选择第一个文字的插入点:")
  15.         d(getdist p0 "\n输入文字的排列间距:")
  16.         a(pri1 getangle p0 "\n输入文字的排列角度:" 0)
  17.         in 0)
  18.   (repeat cs
  19.     (setq sz(+ tsz (* in ssz))
  20.           ws1(strlen (itoa sz))szz ""
  21.           zc(strcat zct
  22.                     (if (< ws1 ws2)
  23.                       (repeat (- ws2 ws1)
  24.                          (setq szz (strcat szz "0"))
  25.                       )
  26.                       ""
  27.                     )
  28.                     (itoa sz) zcw)
  29.           p11(polar p0 a (* in d))
  30.           in(1+ in))
  31.     (#M_TXT p11 zc "DXFS" (* 3.0 0bl) 0.7 0 0 0 "dim" -1)
  32.   )
  33.   (mapcar 'setvar '("cmdecho""blipmode")'(1 1))
  34.   (undo_end)(princ)
  35. )




拷贝方式,增加补位控制

  1. (defun c:szpx2(/ CS E EB EN IN K-BW P0 P1 SSZ SZ SZ2 SZZ TSZ WS1 WS2 ZC ZCT ZCW)
  2.   (undo_begin)
  3.   (mapcar 'setvar '("cmdecho""blipmode")'(0 0))
  4.   (setq xyz-szpx (if xyz-szpx xyz-szpx
  5.                    '(("字串头" . "")("起始数字" . "1") ("字串尾" . "")("数字升值" . "1")
  6.                      ("数字位数=1表示补位" . "1")))
  7.         xyz-szpx(dos_proplist "--by陈勇--" "文字数字排序" xyz-szpx)
  8.         zct(dxf "字串头" xyz-szpx)zcw(dxf "字串尾" xyz-szpx)
  9.         tsz(atoi (dxf "起始数字" xyz-szpx))
  10.         ssz(atoi (dxf "数字升值" xyz-szpx))
  11.         k-bw(dxf "数字位数=1表示补位" xyz-szpx)
  12.         sz tsz
  13.         p0(getpoint "\n选择第一个文字的插入点:")
  14.         in 0 eb'())
  15.   (while (setq p1(getpoint p0 "\n输入新的插入点:"))
  16.     (setq zc(strcat zct (itoa sz) zcw))
  17.     (#M_TXT p1 zc "DXFS" (* 3.0 0bl) 0.7 0 0 0 "dim" -1)
  18.     (setq e(entlast) eb(cons e eb)sz(+ sz ssz))
  19.   )
  20.   (if (= k-bw "1")(progn
  21.     (setq sz2(- sz ssz)cs(length eb)eb(reverse eb)
  22.           ws2(strlen (itoa sz2)) sz tsz)
  23.     (repeat cs
  24.       (setq e(nth in eb)en(entget e)in(1+ in)
  25.             ws1(strlen (itoa sz))szz ""
  26.             zc(strcat zct
  27.                     (if (< ws1 ws2)
  28.                       (repeat (- ws2 ws1)
  29.                          (setq szz (strcat szz "0"))
  30.                       )
  31.                       ""
  32.                     )
  33.                     (itoa sz) zcw)
  34.             en(subst (cons 1 zc)(assoc 1 en) en)sz(+ sz ssz))
  35.       (entmod en)
  36.     )
  37.   ) )
  38.             
  39.   (mapcar 'setvar '("cmdecho""blipmode")'(1 1))
  40.   (undo_end)(princ)
  41. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 488个

财富等级: 日进斗金

发表于 2003-5-13 23:52:45 | 显示全部楼层
最初由 cy956 发布
[B]发一个以前写的,要用doslib。当时没考虑补位。

[code]
(defun c:szpx(/ A CS D IN P0 P11 SSZ SZ TSZ XYZ-SZPX ZC ZCT ZCW)
  (undo_begin)
  (mapcar 'setvar '("cmdecho""blipmode")'(0 0))
  (setq xyz-s... [/B]


好几个没贴出来.dxf undo_begin...
还要我装doslib:)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 593个

财富等级: 财运亨通

发表于 2003-5-17 11:09:40 | 显示全部楼层
晓东工具葙中有个【中西美化】可以将中西文分开,再进一步应该可以将数字与字母分开,将字串分成一个串表,把最后一个(nemberp (read chr))为真的加 1 ,再(apply 'strcat strlst)或许可以更通用。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-5-20 09:45:16 | 显示全部楼层

写字符lisp.rar写的实在是太臭,建议给其降分,也不知道是怎么写出来的。

首先是变量的命名随心所欲,让别人看的一头雾水。
其次,程序中有一个地方(函数“选择文字”的第一句)只需要隐藏对话框后再显示,但是作者把对话框卸掉了又重新load_dialog,实在没有必要。
第三,函数“qlj”的(cond...)中有一个错误:调用子程序zuihoujidu写成了zuihoujidu1
第四,在取得新TEXT的插入点时不够简练,作者是把前一文本的插入点的x,y值分别取出再与所点取两点的差值相加再做成表,实际上只需用(mapcar '+ ... , ...)即可。
第五,程序只能处理提取出的数字字符串前有两个0的情况,但是只需要作简单的处理就可以做的比较完美,基本算法是:只要加上增量后的数字字符串的长度小于原数字字符串的长度就在新形成的字符串前加字符"0"。
第六,子程序zuihoujidu中取字符串的后部分的代码令人不解,......(- (strlen xieru_value) n00 0),这一表达式不要也罢。形成:(setq xa (substr xieru_value 1 (-n00 1))
xb (substr xieru_value (+ n10 1))
)
第七,(SET_TILE "xieru" xieru_value)
  (set_tile "xierub" xieru_value)       
其中第一句不知道是什么意思,我注释掉它也照常运行。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2003-5-28 19:39:08 | 显示全部楼层
感谢LSJ60912,我按你的要求改了一下,希望多提宝贵建议。
我这个是给高手看的,初学的人只能当作反面教材,尽量减少错误

  1. (defun C:写字符串 ()
  2.   (setq DCL_ID (load_dialog "写字符"))        ;打开DCL文件.
  3.   (setq XIERU_VALUE "01")                ;给第一个字符串赋初值
  4.   (FUZHI_0)                                ;对话框赋初值
  5.   (setq DD 2)
  6.   (while (>= DD 2)
  7.     (if        (null (new_dialog "xiezi" DCL_ID)) ;找到DCL
  8.       (exit)
  9.     )                                        ;endif
  10.     (SETTILE)
  11.     (YUNSUAN)
  12.     (ACTIONTILE)
  13.     (setq DD (start_dialog))
  14.     (cond ((= DD 5) (选择文字))
  15.           ((= DD 1) (点选坐标并完成))
  16.           ((= DD 0) (prompt "\n用户取消了对话框"))
  17.     )                                        ;调打开对话框文件.
  18.   )
  19.   (unload_dialog DCL_ID)
  20.   (princ)
  21. )

  22. (defun FUZHI_0 ()                        ;给对话框赋初值
  23.   (setq        N0_VALUE "1"
  24.         N1_VALUE "2"
  25.         QQ_VALUE "1"
  26.         UU_VALUE "10"
  27.   )                                        ;所选实体赋初值.
  28.   (setq A (substr XIERU_VALUE (atoi N0_VALUE) ))
  29. )

  30. (defun SETTILE ()                        ;给控件赋初值
  31.   (set_tile "n0" N0_VALUE)
  32.   (set_tile "n1" N1_VALUE)
  33.   (set_tile "xierub" XIERU_VALUE)
  34.   (set_tile "geshub" (itoa (strlen XIERU_VALUE)))
  35.   (set_tile "jieguob" A)
  36.   (set_tile "qq" QQ_VALUE)
  37.   (set_tile "uu" UU_VALUE)
  38. )

  39. (defun YUNSUAN ()                        ;运算出XXXA,和XXXZ,和NNN,和数组JJJ
  40.   (setq N0_VALUE (get_tile "n0"))
  41.   (setq N1_VALUE (get_tile "n1"))
  42.   (setq QQ_VALUE (get_tile "qq"))
  43.   (setq UU_VALUE (get_tile "uu"))
  44.   (setq NNN (- (atoi N1_VALUE) (atoi N0_VALUE) -1)) ;判断有多少位
  45.   (if (< NNN 1)
  46.     (setq A "999")
  47.     (setq A (substr XIERU_VALUE (atoi N0_VALUE) NNN))
  48.   )
  49.   (set_tile "jieguob" A)
  50.   (set_tile "xierub" XIERU_VALUE)
  51.   (set_tile "geshub" (itoa (strlen XIERU_VALUE)))
  52.   (ZHOU_0)
  53.   (set_tile "xxxa" (nth 0 JJJ))
  54.   (set_tile "xxxz" (nth (- (length JJJ) 1) JJJ))
  55. )


  56. (defun ZHOU_0 ()
  57.   (setq        XA (substr XIERU_VALUE 1 (- (atoi N0_VALUE) 1)) ;字符串的前部分
  58.         XB (substr XIERU_VALUE
  59.                    (+ (atoi N1_VALUE) 1)
  60.                    (- (strlen XIERU_VALUE) (atoi N0_VALUE) 0)
  61.            )
  62.   )                                        ;字符串的后部分
  63.   (setq XXX 1)
  64.   (setq QQ_VALUE1 (atoi QQ_VALUE))
  65.   (setq ****YOU (atoi A))
  66.   (setq JJJ (list XIERU_VALUE))
  67.   (while (< XXX (atoi UU_VALUE))
  68.     (setq ****YOU (+ ****YOU QQ_VALUE1))
  69.     (setq ****YOU1 (itoa ****YOU))

  70.     (setq LIANG (- NNN (strlen ****YOU1)))
  71.     (setq DU0 "")
  72.     (repeat LIANG
  73.       (setq DU0 (strcat DU0 "0"))
  74.     )
  75.                                         ;字符串的中部分
  76.     (setq AK47 (strcat XA (strcat DU0 ****YOU1) XB))
  77.     (setq JJJ (cons AK47 JJJ))
  78.     (setq XXX (+ XXX 1))
  79.   )
  80.   (setq JJJ (reverse JJJ))
  81. )


  82. (defun ACTIONTILE ()                        ;激活控件
  83.   (action_tile "xieru" "(done_dialog 5)")
  84.   (action_tile "n0" "(yunsuan)")
  85.   (action_tile "n1" "(yunsuan)")
  86.   (action_tile "qq" "(yunsuan)")
  87.   (action_tile "uu" "(yunsuan)")
  88.   (action_tile "select" "(done_dialog 1)")
  89.   (action_tile "accept" "(done_dialog 1)")
  90. )


  91. (defun 选择文字        ()
  92.   (princ "一定要选择带数字的字符串")
  93.   (setq SS (ssget))
  94.   (princ)
  95.   (setq NAME (ssname SS 0))
  96.   (setq AG (entget NAME))
  97.   (if (= (cdr (assoc '0 AG)) "TEXT")
  98.     (progn (setq XIERU_VALUE (cdr (assoc '1 AG)))
  99.            (setq PREP10 (cdr (assoc '10 AG)))
  100.     )
  101.     (setq XIERU_VALUE "01")
  102.   )
  103. )

  104. (defun 点选坐标并完成 ()
  105.   (princ "请输入第一点坐标")
  106.   (setq ASS0 (getpoint))
  107.   (print "请输入第二点坐标")
  108.   (setq ASS1 (getpoint))
  109.   (princ)
  110.   (princ)
  111.   (setq GHJ (getvar "OSMODE"))
  112.   (setvar "OSMODE" 0)
  113.   (setq ASS1-0 (mapcar '- ASS1 ASS0))
  114.   (setq NEW-PREP10 PREP10)
  115.   (setq IOI 1)
  116.   (while (< IOI (atoi UU_VALUE))
  117.     (setq NEW-PREP10 (mapcar '+ NEW-PREP10 ASS1-0))
  118.     (setq ABCD (subst (cons 10 NEW-PREP10) (assoc 10 AG) AG))
  119.     (setq NEW-1 (cons 1 (nth IOI JJJ)))
  120.     (setq ABCD (subst NEW-1 (assoc 1 ABCD) ABCD))
  121.     (setq ABCD (subst (cons 72 0) (assoc 72 ABCD) ABCD))
  122.     (entmake ABCD)
  123.     (setq IOI (+ IOI 1))
  124.   )
  125.   (setvar "OSMODE" GHJ)
  126.   (terpri)
  127.   (print "呵呵")
  128.   (princ)
  129. )

感谢LSJJM,重新写了DCL文件。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-5-31 13:29:02 | 显示全部楼层
有用有用,刚好要给图上几百个单位编号,而且对话框编的挺有意思,呵呵,苦中作乐,心中痒痒,好好学学。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-5-31 14:43:09 | 显示全部楼层
能编一个适用于autocadr14的吗?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-5-31 15:01:12 | 显示全部楼层
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-6-2 08:34:07 | 显示全部楼层
原来不注册不能用啊。你给我20元行吗?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-6-2 12:49:35 | 显示全部楼层
唉!买盗版都至少要花5块钱。再说,注不注册是个人的自由。
不注册只是不能使用连带复制和快内属性,这和论坛主题讨论的问题无关,限制的功能只是根据国外用户的需要加的。要完成论坛讲的过程。不注册的就足够用了。
我提供这些仅是希望在尽可能的条件下对大家有帮助。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-6-3 08:24:46 | 显示全部楼层
请教如何使用
为什么,确定键总是不能点?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-6-3 14:07:45 | 显示全部楼层
水平太高了,我也想学学 lsp编程,大家给推荐一个好的网站或者书可以吗?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2003-6-3 17:45:07 | 显示全部楼层
看看
http://www.xdcad.net/forum/showt ... d=296150#post296150
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-14 21:54 , Processed in 0.512239 second(s), 60 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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