xiagood 发表于 2004-1-6 20:36:00

文字按间距快速排列问题

各位朋友:
      你好!
      我写了一个文字按间距排序的程序:(不过,存在了一些问题,有一些文字怎么重叠在一起了)请各位指点一下小弟。谢谢!
(defun C:Fp(/ soureBj x y destinaBj i obj dims)
(setvar "cmdecho" 0)
(setq soureBj (entget (car (entsel "\n Please select soure text Align:"))))
(setq x (car (cdr (assoc 10 soureBj))))
(setq y (cadr (cdr (assoc 10 soureBj))))
(setq destinaBj (ssget '((0 . "text"))))
(setq i 0)
(setq obj (sslength destinaBj))
(setq dims (getreal "Please input the Distanction/(500):"))
(if (= dims nil)
    (setq dims 500)
)
(setq Tstring (getstring "\n The Aligment follow Axis X (&X)/ Y (&y):")
)
(setq Tstring (strcase Tstring))
(cond
    ((= Tstring "Y")
   (progn
          (while (< i obj)
             (setq Tobj1 (ssname DestinaBj i))
             (setq ListObj (entget Tobj1))
             (setq Dlist (assoc 10 listobj))
             (setq DlistX (car (cdr Dlist)))
             (setq DlistY (car (cdr Dlist)))
             (if (> x Dlistx)
                   (progn
                        (setq x (- x dims))
                        (setq Flist (cons 10 (list x y)))
                        (setq listobj (subst Flist Dlist ListObj))
                        (entMod ListObj)
                   )
                   (progn
                        (setq x (+ x dims))
                        (setq Flist (cons 10 (list x y)))
                        (setq listobj (subst Flist Dlist ListObj))
                        (entMod ListObj)
                   )
            )
            (setq i (1+ i))
             )
      )
    )
    ((= Tstring "X")
   (progn
          (while (< i obj)
             (setq Tobj1 (ssname DestinaBj i))
             (setq ListObj (entget Tobj1))
             (setq Dlist (assoc 10 listobj))
             (setq DlistX (car (cdr Dlist)))
             (setq DlistY (car (cdr Dlist)))
             (if (> y DlistY)
                   (progn
                        (setq y (- y dims))
                        (setq Flist (cons 10 (list x y)))
                        (setq listobj (subst Flist Dlist ListObj))
                        (entMod ListObj)
                   )
                   (progn
                        (setq y (+ y dims))
                        (setq Flist (cons 10 (list x y)))
                        (setq listobj (subst Flist Dlist ListObj))
                        (entMod ListObj)
                   )
            )
            (setq i (1+ i))
             )
      )
    )
(T (alert "enter has some Error,So it Can't finished!"))
)
(setvar "cmdecho" 1)
(prin1)
)

BDYCAD 发表于 2004-1-6 20:53:00

本帖最后由 作者 于 2004-1-6 21:16:32 编辑

樓主的(setq Tstring (getstring "\n The Aligment follow Axis X (&X)/ Y (&y):") 這句不好應用
(initget 1 "x y")
(setq Tstring (GETKWORD "\nThe Aligment follow :"))
具體還沒有看.

還有這方面的程序在運行中會難免碰到排過后出現位置亂了. 因為在循還的(setq Tobj1 (ssname DestinaBj i)) 過程中. 里面的順序是按這實體生成的順序的. 如當先到文件的順序是 1.2.3.4.5.6..用這個程序就很好處理, 但是如用戶的所選的文字生面的順序 3.2.5.1.4...程序運行后返回1.2.3.4.5... 就亂了. , 呵呵. 說了這麼多我表達不出來呢.

xiagood 发表于 2004-1-6 21:53:00

是啦,可是如果我们应用的时候,假设是按一个方向的, 要么从上向下排, 要么从下向上排.
那怎么弄,谢谢>
页: [1]
查看完整版本: 文字按间距快速排列问题