[分享]：【实用程序汇总】test000系列！

xxming

再次提问，xyp1964,给你添麻烦了，我有一个问题,就是你的第65个程序："多义线顶点序号及坐标"我想其中的多义线编号能够有这样的功能：随意选实体任一点就能作为编号的起点，进行编号。  
是个比较实用的主意，有空了会琢磨琢磨！现在怎么样了？？

ycwjf

很多实用的程序，谢谢

xxxyzxx

好久没来了，感谢xyp1964 老大汇总常用工具：）～～～

xyp1964

最初由 xxming 发布
[B]再次提问，xyp1964,给你添麻烦了，我有一个问题,就是你的第65个程序："多义线顶点序号及坐标"我想其中的多义线编号能够有这样的功能：随意选实体任一点就能作为编号的起点，进行编号。  
是个比较实用的主意，有空?.. [/B]

对于“随意选实体任一点就能作为编号的起点”的要求，如果遇到线段不闭合会出错。

xxming

谢谢你xyp1964还记得这件事， 这几天比较有空自已已经编了一个“随意选实体任一点就能作为编号的起点”的程序，在明经中也有人提这个问题我回复了。现请你验收，我没有LISP这方面书籍，刚刚起步，只能通过网络学习，希望能多多向你学习，附我的代码：再次感谢
(defun c:bh()
;编号高度
(if (null h)
   (setq h (getvar "textsize"))
)
(setq input (getreal(strcat"\n\t输入编号高度<" (rtos h) ">")))
(if (/= input nil)
   (setq h input)
)
-------------------------------------                     
(initget "1 2")
(setq key (getkword"\n\t1-正向编号/2-反向编号<1>:"))
(setq s1 (entsel"\n\t选择对象<退出>"))
(setq ent (entget(car s1)))
(redraw (car s1) 3)
(setq pt0 (getpoint "\n选择编号起号位置"))
(setq x (car pt0))
(setq y (cadr pt0))
(redraw (car s1) 4)
(setq n (cdr(assoc 90 ent)))

;正向编号
(if (or (= key 1) (= key nil))
(progn
(command "text" pt0 h "0" 1)
(setq plist (member (list 10 x y) ent))
(SETQ pplist (member(assoc 10 ent) ent))
(setq count 1)
(setq d (cdr plist))
(setq plist (member (assoc 10 d) d))
(while (/= plist nil)
  (setq count (1+ count))
  (setq pp_t (car plist))
  (setq pp (cdr pp_t))
  (command "text" pp h "0" (itoa count))
  (setq d (cdr plist))
  (setq plist (member (assoc 10 d) d))
)  
(while (/= pplist nil)
  (setq count (1+ count))
(setq pp_t (car pplist))
(setq pp (cdr pp_t))
(setq pp_x (car pp))
(setq pp_y (cadr pp))
(if (and (= pp_x  x) (= pp_y y))
  (exit)
(progn
(command "text" pp h "0" (itoa count))
(setq d (cdr pplist))
(setq pplist (member (assoc 10 d) d))
);end progn
);end if
);end while
);end progn
;反向编号
(progn
(command "text" pt0 h "0" (itoa n))
(setq plist (member (list 10 x y) ent))
(SETQ pplist (member(assoc 10 ent) ent))
(setq d (cdr plist))
(setq plist (member (assoc 10 d) d))
(setq n (1- n))
(while (/= plist nil)
  (setq pp_t (car plist))
  (setq pp (cdr pp_t))
  (command "text" pp h "0" (itoa n))
  (setq d (cdr plist))
  (setq plist (member (assoc 10 d) d))
  (setq n (1- n))
)

(while (/= pplist nil)
(setq pp_t (car pplist))
(setq pp (cdr pp_t))
(setq pp_x (car pp))
(setq pp_y (cadr pp))
(if (and (= pp_x  x) (= pp_y y))
  (exit)
(progn
(command "text" pp h "0" (itoa n))
(setq d (cdr pplist))
(setq pplist (member (assoc 10 d) d))
(setq n (1- n))
);end progn
);end if
);end while
);end progn
);end if
);end defun
(prompt"\n多义线角点自动编号程序,键入：bh执行,程序设计：小谢")
(princ)

xyp1964

我验收不了，没有“验收规范”，结果只出来一个“1”！
最好提供一个图片或dwg文件供参考。

xxming

奇怪可以用啊(多义线)，支持正向、反向、任意起点

xyp1964

能用就好，恭喜了！

liyunlong

还是不够钱啊.

xiaochongcn

怎么我加载了
xyp_lib.fas
test000.lsp
和菜单文件test000.mns后，在cad菜单中没有出现相应的菜单呢。

xyp1964

最初由 xiaochongcn 发布
[B]怎么我加载了
xyp_lib.fas
test000.lsp
和菜单文件test000.mns后，在cad菜单中没有出现相应的菜单呢。 [/B]

其他朋友没提这样的问题啊，估计对cad还是不精，呵呵……
方法：把以上三个文件放到cad路径下，在command下键入menu，选择test000.mns。

★新增随机数函数
格式：(sjs Maxnum)
说明：Maxnum为随机数的最大值
实例：
[php]
(defun c:test ()
  (repeat 30
    (setq nn (sjs 100000))
    (princ"\n")(princ nn)
  )
  (princ)
)
[/php]
命令: test
21579
62447
27159
88856
6980
15090
35495
7615
87897
7041
37665
73441
31000
51728
44471
73653
53277
61929
47897
55729
25423
85244
7139
60713
10519
25073
75229
14773
38079
35035

xiaochongcn

hehe，cad确实掌握的不怎么好。
不过如果“在command下键入menu，选择test000.mns”这样的话，其余的cad，理正，express等菜单就没了阿。我需要你的菜单和它们共存。。。
我用“menuload”加载test000.mns后，还是没有出来。
（图为用menu加载的test000.mns菜单）

xyp1964

可以将test000.mns的内容移植到其他菜单内。

lengliqun

其中经典程序不能用啊。

xyp1964

最初由 lengliqun 发布
[B]其中经典程序不能用啊。 [/B]

你得先花点“银子”下载签名栏下的所谓“经典程序”，呵呵……