设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [编程申请]：请高手看看这段代码
返回列表 发新帖
查看: 641|回复: 8

[编程申请]：请高手看看这段代码

[复制链接]
pipi002004
发表于 2005-11-29 12:15:39 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
(DEFUN C:CCYZT (/ TXTSS L_TXTSS CT MY_ALL TXT FY TH MY MY_ALL CT INDEX Y_MIN
               Y_MAX KEY CT NUM TXTENT TXT GC72 GC73 U_O U_FX U_FY U_FZ W_O
               NEWFP TXT
            )
  (PRINC "\n请选择需要排列的文字:")
  (SETQ TXTSS (SSGET '((0 . "TEXT")))
        L_TXTSS (SSLENGTH TXTSS)
        CT 0
        MY_ALL NIL
  )
  (WHILE (< CT L_TXTSS)
    (SETQ TXT (ENTGET (SSNAME TXTSS CT))
          FY (CADR (TRANS (CDR (ASSOC 10 TXT)) 0 1))
          TH (CDR (ASSOC 40 TXT))
          MY (+ FY (/ TH 2))
          MY_ALL (APPEND
                   MY_ALL
                   (LIST MY)
                 )
          CT (1+ CT)
    )
  )
  (SETQ INDEX (VL-SORT-I MY_ALL '<)
        Y_MIN (NTH (NTH 0 INDEX) MY_ALL)
        Y_MAX (NTH (NTH (1- L_TXTSS) INDEX) MY_ALL)
  )
  (INITGET 128 "S I")
  (SETQ KEY (GETKWORD "\n[输入行间距(I)/根据所选文字确定行间距(S)]<S>: "))
  (IF (/= KEY NIL)
    (SETQ KEY (STRCASE KEY))
  )
  (IF (OR
        (= KEY "S")
        (= KEY NIL)
      )
    (SETQ DETA_Y (/ (- Y_MAX Y_MIN) (1- L_TXTSS)))
    (IF (= KEY "I")
      (PROGN
        (PRINC "请输入行间距:")
        (SETQ DETA_Y (GETDIST))
      )
    )
  )
  (SETQ CT 1)
  (WHILE (< CT L_TXTSS)
    (SETQ NUM (NTH CT INDEX)
          TXTENT (SSNAME TXTSS NUM)
          TXT (ENTGET TXTENT)
          GC72 (CDR (ASSOC 72 TXT))
          GC73 (CDR (ASSOC 73 TXT))
    )
    (SETQ Y_Y (- (NTH NUM MY_ALL) (+ Y_MIN (* CT DETA_Y)))

    )
    (IF (AND
          (= 0 GC72)
          (= 0 GC73)
        )
      (PROGN
        (SETQ U_O (TRANS (CDR (ASSOC 10 TXT)) 0 1)
              U_FX (CAR U_O)
              U_FY (- (CADR U_O) Y_Y)
              U_FZ (CADDR U_O)
              W_O (TRANS (LIST U_FX U_FY U_FZ) 1 0)
              NEWFP (LIST 10 (CAR W_O) (CADR W_O) (CADDR W_O))
              TXT (SUBST
                    NEWFP
                    (ASSOC 10 TXT)
                    TXT
                  )
        )
        (ENTMOD TXT)
        (ENTUPD TXTENT)
      )
      (PROGN
        (SETQ U_O (TRANS (CDR (ASSOC 11 TXT)) 0 1)
              U_FX (CAR U_O)
              U_FY (- (CADR U_O) Y_Y)
              U_FZ (CADDR U_O)
              W_O (TRANS (LIST U_FX U_FY U_FZ) 1 0)
              NEWFP (LIST 11 (CAR W_O) (CADR W_O) (CADDR W_O))
              TXT (SUBST
                    NEWFP
                    (ASSOC 11 TXT)
                    TXT
                  )
        )
        (ENTMOD TXT)
        (ENTUPD TXTENT)
      )
    )
    (SETQ CT (1+ CT))
  )
  (PRINC)
)
怎么运行不了啊，哪个大哥帮忙改改！
谢谢
TXT, SETQ, TXTSS

相关帖子

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

使用道具 举报

david96007
发表于 2005-11-29 13:10:34 | 显示全部楼层
怎么这么眼熟呢？！好像是我的！
程序在r14下没什么问题呀！


  3. (defun c:Td (/ TxtSS  L_TxtSS            ct           MY_ALL txt         FY        TH
  4.                MY     MY_ALL ct            index  Y_min  Y_max         key        ct
  5.                num    txtEnt txt    gc72   gc73          U_O         U_FX        U_FY
  6.                U_FZ   W_O    NewFP  txt
  7.               )
  8.   (princ "\n请选择需要排列的文字:")
  9.   (setq        TxtSS        (ssget '((0 . "TEXT")))
  10.         L_TxtSS        (sslength TxtSS)
  11.         ct        0
  12.         MY_ALL        nil
  13.   ) ;_ end of setq
  14.   (while (< ct L_TxtSS)
  15.     (setq txt         (entget (ssname TxtSS ct))
  16.           FY         (cadr (trans (cdr (assoc 10 txt)) 0 1))
  17.           TH         (cdr (assoc 40 txt))
  18.           MY         (+ FY (/ Th 2))
  19.           MY_ALL (append MY_ALL (list MY))
  20.           ct         (1+ ct)
  21.     )
  22.   ) ;_ end of while
  23.   (setq        index (vl-sort-i MY_ALL '<)
  24.         Y_min (nth (nth 0 index) MY_ALL)
  25.         Y_max (nth (nth (1- L_TxtSS) index) MY_ALL)
  26.   )
  27.   (initget 128 "S I")
  28.   (setq
  29.     key        (getkword "\n[输入行间距(I)/根据所选文字确定行间距(S)]<S>: "
  30.         ) ;_ end of getkword
  31.   ) ;_ end of setq
  32.   (if (/= key nil)
  33.     (setq key (strcase key))
  34.   ) ;_ end of if
  35.   (if (or (= key "S") (= key nil)) ;_ end of or
  36.     (setq deta_y (/ (- Y_max Y_min) (1- L_TxtSS)))
  37.     (if        (= key "I")
  38.       (progn (princ "请输入行间距:") (setq deta_y (getdist))) ;_ end of progn
  39.     ) ;_ end of if
  40.   ) ;_ end of if
  41.   (setq ct 1)
  42.   (while (< ct L_TxtSS)
  43.     (setq num         (nth ct index)
  44.           txtEnt (ssname TxtSS num)
  45.           txt         (entget txtEnt)
  46.           gc72         (cdr (assoc 72 txt))
  47.           gc73         (cdr (assoc 73 txt))
  48.     ) ;_ end of setq
  49.     (setq Y_Y (- (nth num MY_ALL) (+ y_min (* ct deta_y))) ;_ end of -
  50.     ) ;_ end of setq
  51.     (if        (and (= 0 gc72) (= 0 gc73))
  52.       (progn (setq U_O         (trans (cdr (assoc 10 txt)) 0 1)
  53.                    U_FX         (car U_O)
  54.                    U_FY         (- (cadr U_O) Y_Y)
  55.                    U_FZ         (caddr U_O)
  56.                    W_O         (trans (list U_FX U_FY U_FZ) 1 0)
  57.                    NewFP (list 10 (car W_O) (cadr W_O) (caddr W_O))
  58.                    txt         (subst NewFP (assoc 10 txt) txt)
  59.              )
  60.              (entmod txt)
  61.              (entupd txtent)
  62.       ) ;_ end of progn
  63.       (progn (setq U_O         (trans (cdr (assoc 11 txt)) 0 1)
  64.                    U_FX         (car U_O)
  65.                    U_FY         (- (cadr U_O) Y_Y)
  66.                    U_FZ         (caddr U_O)
  67.                    W_O         (trans (list U_FX U_FY U_FZ) 1 0)
  68.                    NewFP (list 11 (car W_O) (cadr W_O) (caddr W_O))
  69.                    txt         (subst NewFP (assoc 11 txt) txt)
  70.              )
  71.              (entmod txt)
  72.              (entupd txtent)
  73.       ) ;_ end of progn
  74.     ) ;_ end of if
  75.     (setq ct (1+ ct))
  76.   ) ;_ end of while
  77.   (princ)
  78. ) ;_ end of defun



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

使用道具 举报

841594
发表于 2005-11-29 13:17:37 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
运行正常
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

pipi002004
 楼主| 发表于 2005-11-29 16:30:59 | 显示全部楼层
大哥r14下运行错误啊，
请选择需要排列的文字:
Select objects: Other corner: 2 found

Select objects:
出错:null function
nil*Cancel*
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

841594
发表于 2005-11-29 17:02:24 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
r14, 好老啊。
大约是不支持vl-sort-i函数。程序前面加个（vl-load-com）试试。不行就只有改写程序了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

david96007
发表于 2005-11-29 19:52:43 | 显示全部楼层
忘了说了，在r14要在vlisp环境下加载或编译成arx文件！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

pipi002004
 楼主| 发表于 2005-11-29 21:42:46 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
大哥可不可以上传一个给我啊,我是用r14的
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

david96007
发表于 2005-11-30 12:13:27 | 显示全部楼层
调整文字间距的命令是：ct
里面还有一个命令：add
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

nigma
发表于 2005-11-30 13:35:26 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 841594 发布
[B]r14, 好老啊。
大约是不支持vl-sort-i函数。程序前面加个（vl-load-com）试试。不行就只有改写程序了。 [/B]

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

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2025-9-28 20:45 , Processed in 0.472893 second(s), 49 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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