[求助]如何改变多段线的顶点顺序

f5612140

无痕发表于2005-3-26 20:28:00起点不是可以随便指定的

老兄,请再看看楼主在3楼的意思

diablo_xie

自已写了一个支持正向、反向、任意起点楼主你试试：命令bh

sly

能否编个程序？多谢

sly

可以编一段改变起点位置的程序吗？

sly

可以编一段重新定义起点的程序吗？

diablo_xie

(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)

【KAIXIN】

2. ;线形反向
   
3. (defun c:KK()
   
4. 　　　　(setq ss(ssget) mun 0)
   
5. (repeat (sslength ss)
   
6. 　　　　(setq entl-y (ssname ss mun))
   
7. 　　　　(command "pedit" entl-y "d" "")
   
8. 　　　　(setq entl(entget entl-y))
   
9. 　　　 (if (= "POLYLINE" (cdr(assoc 0 entl))) (command "pedit" entl-y "lt" "on" "x"))
   
10. 　　　 (if (= 10 (car (nth 13 entl)))　(setq nn 13))
    
11. 　　　 (if (= 10 (car (nth 12 entl)))　(setq nn 12))
    
12. 　　　 (setq lt-name(cdr(assoc 6 entl)) la-name (cdr (assoc 8 entl)))　　
    
13. 　　　　(setq W_list '())
    
14. 　　　　(setq elem (cdr (nth nn entl)))
    
15. 　　　　(setq w_list (append w_list (list elem)))　
    
16. 　　　(while (not (null elem))　　　　　　　　　
    
17. 　　(setq nn(+ nn 4))
    
18. 　　(setq elem (cdr (nth nn entl)))　
    
19. 　　　 (if (= (car (nth nn entl)) 10)
    
20. 　　　　(setq w_list (append w_list (list elem)))　;构建实体坐标表　　
    
21. 　　　 )
    
22. 　　　)
    
23. 　　　　(setq w_list (reverse w_list))
    
24. 　　　　(setq pt1 (car W_list))
    
25. 　　　　(command "pline" pt1)
    
26. 　　　(while w_list
    
27. 　　　　(setq w_list(cdr w_list))
    
28. 　　　　(setq pt (car w_list))
    
29. 　　　　(command pt)
    
30. 　　　)
    
31. 　　　　(command "")
    
32. 　　　　(command "chprop" (entlast) "" "lt" lt-name "la" la-name "")
    
33. 　　　　(command "pedit" (entlast) "lt" "on" "s" "")
    
34. 　　　　(command "erase" entl-y "")
    
35. 　　　　(setq mun (+ mun 1))
    
36. )
    
37. )

;线形反向<br /> (defun c:KK()<br /> 　　　　(setq ss(ssget) mun 0)<br /> (repeat (sslength ss)<br /> 　　　　(setq entl-y (ssname ss mun))<br /> 　　　　(command "pedit" entl-y "d" "")<br /> 　　　　(setq entl(entget entl-y))<br /> 　　　 (if (= "POLYLINE" (cdr(assoc 0 entl))) (command "pedit" entl-y "lt" "on" "x"))<br /> 　　　 (if (= 10 (car (nth 13 entl)))　(setq nn 13))<br /> 　　　 (if (= 10 (car (nth 12 entl)))　(setq nn 12)) <br /> 　　　 (setq lt-name(cdr(assoc 6 entl)) la-name (cdr (assoc 8 entl)))　　<br /> 　　　　(setq W_list '())<br /> 　　　　(setq elem (cdr (nth nn entl))) <br /> 　　　　(setq w_list (append w_list (list elem)))　<br /> 　　　(while (not (null elem))　　　　　　　　　<br /> 　　(setq nn(+ nn 4))<br /> 　　(setq elem (cdr (nth nn entl)))　 <br /> 　　　 (if (= (car (nth nn entl)) 10)<br /> 　　　　(setq w_list (append w_list (list elem)))　;构建实体坐标表　　 <br /> 　　　 )<br /> 　　　)<br /> 　　　　(setq w_list (reverse w_list))<br /> 　　　　(setq pt1 (car W_list))<br /> 　　　　(command "pline" pt1)<br /> 　　　(while w_list<br /> 　　　　(setq w_list(cdr w_list))<br /> 　　　　(setq pt (car w_list))<br /> 　　　　(command pt)<br /> 　　　)<br /> 　　　　(command "")<br /> 　　　　(command "chprop" (entlast) "" "lt" lt-name "la" la-name "")<br /> 　　　　(command "pedit" (entlast) "lt" "on" "s" "")<br /> 　　　　(command "erase" entl-y "")<br /> 　　　　(setq mun (+ mun 1))<br /> )<br /> )

navalarch

学习了， 正好遇到困难

壮壮和冷血

meflying 发表于 2005-3-25 08:44
程序功能：判断是顺时针还是逆时针，如果是顺时针则更改为逆时针。。。REV函数更改顶点顺序，可单独使用。。 ...

你好  这个lisp怎么调用呀？在cad里输入ap加载  然后输入什么调用呢？谢谢

345862750@qq.co

meflying 发表于 2005-3-25 08:44
程序功能：判断是顺时针还是逆时针，如果是顺时针则更改为逆时针。。。REV函数更改顶点顺序，可单独使用。。 ...

太棒了，楼主人才