[编程申请]：给每一条竖线上加上序号，程序应该怎样写？

ihqu

给每一条竖线上加上序号，从左到右，编号1到n，程序应该怎样写？

cy956

1.会求点.
2.会排序.
3.会写字.
能用lisp写这三段,你就会写.:)

f5612140

最初由 cy956 发布
[B]1.会求点.
2.会排序.
3.会写字.
能用lisp写这三段,你就会写.:) [/B]

"123我都會,所以我會寫",邏輯上不通,應該是"我會寫,所以我會123"
以上玩笑話,弄個程序吧

zhynt

先选择，再排序，然后求点，最后写字。
选择很简单：
(setq se (ssget '((0 . "LINE"))))
排序嘛，复杂一点：

2. 
   
3. (defun zhy_sort_se (se xory)
   
4.   (setq newse nil)
   
5.   (setq n (sslength se))
   
6.   (setq index 0)
   
7.   (setq aal '())
   
8.   (repeat n
   
9.     (setq name (ssname se index))
   
10.     (setq lp (entget name))
    
11.     (if        (or (= xory "y") (= xory "Y"))
    
12.       (setq coy (caddr (assoc 10 lp)))
    
13.     )
    
14.     (if        (or (= xory "x") (= xory "X"))
    
15.       (setq coy (cadr (assoc 10 lp)))
    
16.     )
    
17.     (if        (or (= xory "xy") (= xory "XY"))
    
18.       (setq coy (+ (cadr (assoc 10 lp)) (caddr (assoc 10 lp))))
    
19.     )
    
20.     (setq item (list coy (cdr (assoc 5 lp))))
    
21.     (setq aal (cons item aal))
    
22.     (setq index (1+ index))
    
23.   )
    
24.   (setq        newsort
    
25.          (vl-sort aal
    
26.                   (function (lambda (e1 e2)
    
27.                               (> (car e1) (car e2))
    
28.                             )
    
29.                   )
    
30.          )
    
31.   )
    
32.   (setq n1 (length newsort))
    
33.   (setq ind 0)
    
34.   (repeat n1
    
35.     (setq ntt (nth ind newsort))
    
36.     (setq ind (1+ ind))
    
37.     (setq ty (handent (cadr ntt)))
    
38.     (if        (/= ty nil)
    
39.       (if (= newse nil)
    
40.         (setq newse (ssadd ty))
    
41.         (setq newse (ssadd ty newse))
    
42.       )
    
43.     )
    
44.   )
    
45. )
    

<br /> (defun zhy_sort_se (se xory)<br />   (setq newse nil)<br />   (setq n (sslength se))<br />   (setq index 0)<br />   (setq aal '())<br />   (repeat n<br />     (setq name (ssname se index))<br />     (setq lp (entget name))<br />     (if        (or (= xory "y") (= xory "Y"))<br />       (setq coy (caddr (assoc 10 lp)))<br />     )<br />     (if        (or (= xory "x") (= xory "X"))<br />       (setq coy (cadr (assoc 10 lp)))<br />     )<br />     (if        (or (= xory "xy") (= xory "XY"))<br />       (setq coy (+ (cadr (assoc 10 lp)) (caddr (assoc 10 lp))))<br />     )<br />     (setq item (list coy (cdr (assoc 5 lp))))<br />     (setq aal (cons item aal))<br />     (setq index (1+ index))<br />   )<br />   (setq        newsort<br />          (vl-sort aal<br />                   (function (lambda (e1 e2)<br />                               (> (car e1) (car e2))<br />                             )<br />                   )<br />          )<br />   )<br />   (setq n1 (length newsort))<br />   (setq ind 0)<br />   (repeat n1<br />     (setq ntt (nth ind newsort))<br />     (setq ind (1+ ind))<br />     (setq ty (handent (cadr ntt)))<br />     (if        (/= ty nil)<br />       (if (= newse nil)<br />         (setq newse (ssadd ty))<br />         (setq newse (ssadd ty newse))<br />       )<br />     )<br />   )<br /> )<br />

其中se为前面的选集，XorY为排序方式，X为按x坐标值的大小排序（用于竖线的排序）Y为安Y坐标值的大小排序（用于横线）
当然这也是一个通用函数，不光是用来排线的哟。
最后的newse就是排序后的新选集啦。
至于求点嘛，就简单啦，依次取出newse选集中的线，取出其端点坐标，再依次次写上1~n ，程序嘛，因为不知道你的具体要求，就不太好写啦，自己发挥吧。

lsjjm

REFER TO:

2. 
   
3. (defun c:test ()
   
4.   (prompt "\nSelect Lines: ")
   
5.   (setq ss (ssget '((0 . "LINE"))))
   
6.   (setq ss (sortsets ss))
   
7.   (setq s (getvar "dimscale"))
   
8.   (setq n 0)
   
9.   (while (< n (sslength ss))
   
10.     (pt (ssname ss n))
    
11.     (if (> (cadr pt2)(cadr pt1))(setq pt1 pt2))
    
12.     (setq pe (polar pt2 (/ pi 3) 1))
    
13.     (command "leader" pt2 (polar pe (angle pe pt2)(* s 0.32)) "" "" "n")
    
14.     (vl-cmdf "circle"  pe (* s 0.32))
    
15.     (vl-cmdf "text" "j" "m" pe (* s 1.5 0.18) 0 (1+ n) "")
    
16.     (setq n (1+ n))
    
17.   )
    
18. )
    
19. (defun pt (ent)
    
20.   (setq entd (entget ent))
    
21.   (setq pt1 (cdr (assoc 10 entd)))
    
22.   (setq pt2 (cdr (assoc 11 entd)))
    
23.   (if (< (car pt2)(car pt1))(setq pt0 pt1 pt1 pt2 pt2 pt0))
    
24.   (if (and (equal (car pt1)(car pt2) 0.001)
    
25.            (< (cadr pt2)(cadr pt1)))
    
26.     (setq pt0 pt1 pt1 pt2 pt2 pt0)
    
27.   )
    
28. )
    
29. (defun sortsets (ents)
    
30.   (setq ee (ssadd))
    
31.   (setq n 0)
    
32.   (while (< n (sslength ents))
    
33.     (pt (ssname ents n))
    
34.     (setq slist (append slist (list (list (ssname ents n) pt1 pt2))))
    
35.     (setq n (1+ n))
    
36.   )
    
37.   (setq slist (vl-sort slist '(lambda (x1 x2)
    
38.     (if (equal (car (cadr x1))(car (cadr x2)) 0.001)
    
39.       (< (car (last x1))(car (last x2)))
    
40.       (< (car (cadr x1))(car (cadr x2)))
    
41.     )
    
42.   )))
    
43.   (foreach i slist (setq ee (ssadd (car i) ee)))
    
44.   ee
    
45. )

<br /> (defun c:test ()<br />   (prompt "\nSelect Lines: ")<br />   (setq ss (ssget '((0 . "LINE"))))<br />   (setq ss (sortsets ss))<br />   (setq s (getvar "dimscale"))<br />   (setq n 0)<br />   (while (< n (sslength ss))<br />     (pt (ssname ss n))<br />     (if (> (cadr pt2)(cadr pt1))(setq pt1 pt2))<br />     (setq pe (polar pt2 (/ pi 3) 1))<br />     (command "leader" pt2 (polar pe (angle pe pt2)(* s 0.32)) "" "" "n")<br />     (vl-cmdf "circle"  pe (* s 0.32))<br />     (vl-cmdf "text" "j" "m" pe (* s 1.5 0.18) 0 (1+ n) "")<br />     (setq n (1+ n))<br />   )<br /> )<br /> (defun pt (ent)<br />   (setq entd (entget ent))<br />   (setq pt1 (cdr (assoc 10 entd)))<br />   (setq pt2 (cdr (assoc 11 entd)))<br />   (if (< (car pt2)(car pt1))(setq pt0 pt1 pt1 pt2 pt2 pt0))<br />   (if (and (equal (car pt1)(car pt2) 0.001)<br />            (< (cadr pt2)(cadr pt1)))<br />     (setq pt0 pt1 pt1 pt2 pt2 pt0)<br />   )<br /> )<br /> (defun sortsets (ents)<br />   (setq ee (ssadd))<br />   (setq n 0)<br />   (while (< n (sslength ents))<br />     (pt (ssname ents n))<br />     (setq slist (append slist (list (list (ssname ents n) pt1 pt2))))<br />     (setq n (1+ n))<br />   )<br />   (setq slist (vl-sort slist '(lambda (x1 x2)<br />     (if (equal (car (cadr x1))(car (cadr x2)) 0.001)<br />       (< (car (last x1))(car (last x2)))<br />       (< (car (cadr x1))(car (cadr x2)))<br />     )<br />   )))<br />   (foreach i slist (setq ee (ssadd (car i) ee)))<br />   ee<br /> )

ihqu

其实就是排序比较难，你们的程序了都用了Vlisp的命令，
在R14下用不了，如果不用Vlisp的命令，是不是很麻烦？应该怎么做？

f5612140

5樓程序不錯,若橫向由下到上可改為A.B.C更佳

aeo

r14没办法排序:-)
网上找找很多的.
我提供一个，天正里的，花了几分钟改了一下，通用了,但速度很慢的：（

2. 
   
3. (defun range (a fun / b x x1)
   
4.   (while (setq x (car a))
   
5.          (setq x1 x a (cdr a))
   
6.     (foreach y a(if(apply fun(list x y))(setq x y)))
   
7.     (setq a (subst x1 x a))
   
8.     (if (or(apply fun(list x (car b)))(not b))(setq b (cons x b)))
   
9.   )
   
10.   b
    
11. )
    

<br /> (defun range (a fun / b x x1)<br />   (while (setq x (car a))<br />          (setq x1 x a (cdr a))<br />     (foreach y a(if(apply fun(list x y))(setq x y)))<br />     (setq a (subst x1 x a))<br />     (if (or(apply fun(list x (car b)))(not b))(setq b (cons x b)))<br />   )<br />   b<br /> )<br />

实例:
(range '( 6 3 8 1 0) '<)  --->(0 1 3 6 8)
(range '((13) (2) (35) (6) (9)) '(lambda($1 $2)(<(car $1)(car $2))))
   --->((2) (6) (9) (13) (35))

你要的:

2. 
   
3. (setq ss(ssget '((0 . "LINE"))))
   
4. (setq i -1 li '())
   
5. (repeat(sslength ss)
   
6.   (setq s (ssname ss(setq i(1+ i))))
   
7.   (setq en(entget s))
   
8.   (if(equal(setq px(cadr(assoc 10 en)))(cadr(assoc 11 en))1e-3)(setq li(cons(list px s)li)))
   
9. )   ;所有垂直线'((x? ename1)(x? ename2)...)
   
10. (setq li(range li '(lambda($ #)(<(car $)(car #)))))  ;现在排好了.每个为 '(x坐标 实体名)
    
11.   ;下面写字应该会了!?
    

<br /> (setq ss(ssget '((0 . "LINE"))))<br /> (setq i -1 li '())<br /> (repeat(sslength ss)<br />   (setq s (ssname ss(setq i(1+ i))))<br />   (setq en(entget s))<br />   (if(equal(setq px(cadr(assoc 10 en)))(cadr(assoc 11 en))1e-3)(setq li(cons(list px s)li)))<br /> )   ;所有垂直线'((x? ename1)(x? ename2)...)<br /> (setq li(range li '(lambda($ #)(<(car $)(car #)))))  ;现在排好了.每个为 '(x坐标 实体名)<br />   ;下面写字应该会了!?<br />

cy956

最初由 aeo 发布
[B]r14没办法排序:-)
网上找找很多的.
... [/B]

在很久很久以前, 老母鸡肉就和现在的鸡肉一样好吃.

至少abd2.0时(acadr10),这样功能的函数都已经相当成熟,
至于更早,嘿嘿,我也不知道了...

ihqu

谢谢了

talkershadows

呵呵！！期待更完善的～～～

panzhongw

有谁能将一下排序的算法

ARTX

能不能分一下横行和竖行，作一下提示呢？