[原创]：自编的一个给圆自动编号的lisp程序，已增加输出至文件功能

softbird

运行时候提示：列表错误: "Continuous"
命令:
是在cad2006下运行的，不知道是什么问题？

0000

我没爱心币下不了请发给我谢谢
leve0225@163.com

jx2008

运行中还有不少问题，请把源代码贴出来，可以一起修改阿，或者发到我的信箱：
jxphklibin@163.com
谢谢！我在使用中感觉很多问题会出现，不完善。

sjyqzc

程序源码,请大家帮着改改.改完后请都发到这个贴子来.
就不再收币了，大家一起帮着改改，优化一下吧．如果能填加些功能和界面就更好了．众人拾柴火焰高．


;圆自动编号lisp程序
;;2000-9-21
;-----------------------------------
;2007-1-20日修改，增加坐标输出到文件的功能。


(setq         prnNum        nil
        more        nil
        getpt        nil
)

;在pt位置上写值为strHead+intNum的文本
(defun prnNum (pt strHead intNum fileOut / strNum strOut elist tblTextStyle)
        (setq strNum (strcat strHead (itoa intNum)))
          (setq tblTextStyle (tblsearch "style" (getvar 'TEXTSTYLE)))                ;取得字体的符号表实体
         
        ;(command "TEXT" "J" "MC" pt "" strNum)                                        ;原来采用的是命令方式写文本
  
          ;设置桩号文本的实体表
          (setq elist (list (cons '0  "TEXT")                       ; 类型为TEXT
                          (cons '72 1)                            ; 水平对正
                          (cons '73  2)                            ; 垂直对正
                          ;(cons '100 "AcDbText")                    ;子类
                          (cons '1  strNum)                            ;文本内容
                          (cons 10  (list (nth 0 pt) (nth 1 pt) (nth 2 pt)))                      ; Center point
                          (cons 11  (list (nth 0 pt) (nth 1 pt) (nth 2 pt)))                      ; Center point
                          (cons '7 (getvar 'TEXTSTYLE))                                                ;当前字体样式
                          (cons '40 (getvar 'TEXTSIZE))                                                ;当前字体高度
                          (cons '41 (cdr (assoc '41 tblTextStyle)))                                ;取当前字体的宽度比例
                      )
        )

          ;采用entmake 方式写文本
          (entmake elist)

          ;根据是否有打开的文件，将桩号及坐标输出到文件中
        (if (/= fileOut NIL)
          (progn
                   (setq strOut (strcat strNum ", ," (rtos (nth 0 pt) 2 4) "," (rtos (nth 1 pt) 2 4) "," (rtos (nth 2 pt) 2 4)))
                  (write-line strOut fileOut)
                    (write-line (strcat strNum "to File"))                                                ;屏幕提示
          )
          (write-line (strcat strNum))                                                                ;屏幕提示
        )
)

;根据mode模式，比较pt1与pt2两点的大小,pt1<pt2时返回0
(defun more (pt1 pt2 mode / m1)
        (cond
          
                ((= mode "LRUD")
                        (if (> (nth 1 pt1) (nth 1 pt2))
                                (setq m1 0)
                                (if (= (nth 1 pt1) (nth 1 pt2))
                                        (if (< (nth 0 pt1) (nth 0 pt2)) (setq m1 0) (setq m1 1))
                                        (setq m1 1)
                                )
                        )
                )
                ((= mode "LRDU")
                        (if (< (nth 1 pt1) (nth 1 pt2))
                                (setq m1 0)
                                (if (= (nth 1 pt1) (nth 1 pt2))
                                        (if (< (nth 0 pt1) (nth 0 pt2)) (setq m1 0) (setq m1 1))
                                        (setq m1 1)
                                )
                        )
                )
                ((= mode "RLUD")
                        (if (> (nth 1 pt1) (nth 1 pt2))
                                (setq m1 0)
                                (if (= (nth 1 pt1) (nth 1 pt2))
                                        (if (> (nth 0 pt1) (nth 0 pt2)) (setq m1 0) (setq m1 1))
                                        (setq m1 1)
                                )
                        )
                )
                ((= mode "RLDU")
                        (if (< (nth 1 pt1) (nth 1 pt2))
                                (setq m1 0)
                                (if (= (nth 1 pt1) (nth 1 pt2))
                                        (if (> (nth 0 pt1) (nth 0 pt2)) (setq m1 0) (setq m1 1))
                                        (setq m1 1)
                                )
                        )
                )
                ((= mode "UDLR")
                        (if (< (nth 0 pt1) (nth 0 pt2))
                                (setq m1 0)
                                (if (= (nth 0 pt1) (nth 0 pt2))
                                        (if (> (nth 1 pt1) (nth 1 pt2)) (setq m1 0) (setq m1 1))
                                        (setq m1 1)
                                )
                        )
                )
                ((= mode "UDRL")
                        (if (> (nth 0 pt1) (nth 0 pt2))
                                (setq m1 0)
                                (if (= (nth 0 pt1) (nth 0 pt2))
                                        (if (> (nth 1 pt1) (nth 1 pt2)) (setq m1 0) (setq m1 1))
                                        (setq m1 1)
                                )
                        )
                )
                ((= mode "DULR")
                        (if (< (nth 0 pt1) (nth 0 pt2))
                                (setq m1 0)
                                (if (= (nth 0 pt1) (nth 0 pt2))
                                        (if (< (nth 1 pt1) (nth 1 pt2)) (setq m1 0) (setq m1 1))
                                        (setq m1 1)
                                )
                        )
                )
                ((= mode "DURL")
                        (if (> (nth 0 pt1) (nth 0 pt2))
                                (setq m1 0)
                                (if (= (nth 0 pt1) (nth 0 pt2))
                                        (if (< (nth 1 pt1) (nth 1 pt2)) (setq m1 0) (setq m1 1))
                                        (setq m1 1)
                                )
                        )
                )
        )
)

;输入索引，从选择集中找出园心
(defun getpt (sscir index / curname ent enttem pt)
        (setq curname (ssname sscir index))
        (setq ent (entget curname))
        (setq enttem (nth 9 (entget curname)))
        (setq pt (list (nth 1 enttem) (nth 2 enttem) (nth 3 enttem)))
)


;定义函数修改当前编号
(defun setnum (intNum / strpro int)
        (setq strpro (strcat "\nNext number [" (itoa intNum) "]:"))
        (initget (+ 2 4))
        (setq int (getint strpro))
        (if (/= int nil) (setq intNum int) (setq int intNum))
)

;定义函数修改当前编号前缀
(defun SETTEXT (strHead / strpro)
        (setq strpro (strcat "\nHead Text [" strHead "]:"))
        (initget (+ 2 4))
        (setq strHead (getstring strpro))
)


;定义文本中心与圆心的偏移量
(defun SETDIST ( / pt1 pt2)
        (initget (+ 1))
        (setq pt1 (getpoint "\nDisplacement:"))
        (initget (+ 1))
        (setq pt2 (getpoint "Second point:"))
        (setq ptDist (list (- (nth 0 pt2) (nth 0 pt1)) (- (nth 1 pt2) (nth 1 pt1)) 0))
)

;定义函数修改当前输出文件
(defun SETFILENAME ( / strFileName)
        (setq strFileName (getfiled "新建数据文件" "" "dat" 1))                ;打开文件新建对话框
          (if (/= strFileName nil)
          (progn
            (if (/= fileOut nil) (close fileOut))
            (setq fileOut (open strfilename "w"))                        ;打开新建的文件
           )
        )
)

       
;设置mode模式
(defun SETMODE (mode / int strpro)
        (setq strpro (strcat "\nLrUd/LrDu/RlUd/RlDu/UdLr/UdRl/DuLr/DuRl[" mode "]:"))
        (initget (+ 2 4) "LrUd LrDu RlUd RlDu UdLr UdRl DuLr DuRl")
        (setq str (getkword strpro))
        (cond
                ((= str nil) (setq mode mode))
                ((= (strcase str) "LRUD") (setq mode "LRUD"))
                ((= (strcase str) "LRDU") (setq mode "LRDU"))
                ((= (strcase str) "RLUD") (setq mode "RLUD"))
                ((= (strcase str) "RLDU") (setq mode "RLDU"))
                ((= (strcase str) "UDLR") (setq mode "UDLR"))
                ((= (strcase str) "UDRL") (setq mode "UDRL"))
                ((= (strcase str) "DULR") (setq mode "DULR"))
                ((= (strcase str) "DURL") (setq mode "DURL"))
        )
)


;主函数
(defun num (intNum mode ptDist strHead fileOut / sscir namemin ptmin intj namecur ptcur errobj)
  (if (= (setq sscir (ssget '((0 . "CIRCLE")))) nil)                ;当无选择集输出时，退出       
    (progn
        (setq mode "LRUD")
        (setq intNum 1)
        (setq ptDist (list 0 0 0))
        (setq strkey "a")
        (setq strHead "")
        (if (/= fileOut nil)
          (close fileOut)                                                                                ;changed
        )
              (GC)
              (exit)
    )
  )
  
        (repeat (sslength sscir)
                (setq namemin (ssname sscir 0))
                (setq ptmin (getpt sscir 0))
                (setq intj 1)
                (repeat (1- (sslength sscir))
                        (setq namecur (ssname sscir intj))
                        (setq ptcur (getpt sscir intj))
                        (if (= (more ptmin ptcur mode) 1)
                               (setq ptmin ptcur namemin namecur))
                        (setq intj (1+ intj)))
                (setq ptmin (list (+ (nth 0 ptmin) (nth 0 ptDist)) (+ (nth 1 ptmin) (nth 1 ptdist)) (nth 2 ptmin)) )
                (prnNum ptmin strHead intNum fileOut)       
                (ssdel namemin sscir)
                (setq intNum (+ intNum 1))
        )
)

(defun C:COUNT ( / strkey mode intNum ptDist strHead fileOut)
        (setq mode "LRUD")
        (setq intNum 1)
        (setq ptDist (list 0 0 0))
        (setq strkey "a")
        (setq strHead "")
          (setq fileOut nil)                                                                        ;存放要输出的坐标文件的描述符
        (while strkey
                (initget (+ 2 4 128) "Cur Orient proText Place File Select")                        ;changed
                (setq strkey (getkword "\nCur num/pro Text/Orient/text Place/File/[Select]"))        ;changed
                (cond
                        ((= strkey nil) (setq strkey "a") (setq intNum (num intNum mode ptDist strHead fileOut)))
                        ((= (strcase strkey) "CUR") (setq intNum (SETNUM intNum)))
                        ((= (strcase strkey) "ORIENT") (setq mode (SETMODE mode)))
                        ((= (strcase strkey) "PROTEXT") (setq strHead (SETTEXT strHead)))
                        ((= (strcase strkey) "PLACE") (setq ptDist (SETDIST)))
                        ((= (strcase strkey) "FILE") (setq fileOut (SETFILENAME)))        ;changed
                        ((= (strcase strkey) "SELECT") (setq intNum (num intNum mode ptDist strHead)))
                )
         )(GC)

  (close fileOut)                                                                                ;changed
  (setq fileOut nil)
)

hmh888888

存在多余括号

lewis240

楼主 能不能帮忙编个准对封闭的多边形自动付文字的程序???
http://www.xdcad.net/forum/showthread.php?s=&threadid=613163

ft_2008

有给我发个啊,moonjdd-002@163.com.

ft_2008

有给我发个啊,moonjdd-002@163.com.

ft_2008

有给我发个啊,moonjdd-002@163.com.

ft_2008

有给我发个啊,moonjdd-002@163.com.

ji3499222

sjyqzc 朋友你好！
    你的自动编号程序已给我带来了很大的方便，再次表示感谢！可我又遇到了一个新问题：晾水塔（圆）上的桩位能否按顺时针自动编号，并自动生成坐标文件，盼望你的回复！！！

WELLDICK

楼主，我急用，麻烦发我到我的邮箱，谢谢~
liguofeng3909@126.com

hifenr

我也要一个，hifenr@163.com。谢谢！

yhly555

在哪里可以下载，还是有积分限制、

苏小红

给我也发个吧