[求助]請問自動產生多邊形網面(AcDbPolygonMesh)各個頂點坐標的清單

meflying

你最好把需求再说详细点，我给你写个比较完整点的程序吧

wangyue

1.將綱面的頂點按：第一行1，3，5。。。這樣抓出，第二行2，4，6，這樣抓出


將坐標存到TXT中，


2.在一個指令，就是將這些點一個一個讀到AUTOCAD中，產生網面


3.在產生的網面頂點上生成一個半徑為2的圓　

无痕

做网架呢？ 一般做网架都有专门的软件。


另外，加载也可以这样：拷贝程序部分，在cad命令行中paste。就可以执行（getver （car（entsel）））

meflying

用之前说的方法加载程序，然后使用命令：mesh

wangyue

meflying and 无痕 真是太謝謝你們了，現在測試，如有擬問還請多多指教，

wangyue

不好意思，請問如何是產生出坐標點的值小數點後是8位而不是4位

meflying

2. ;函数:Sel
3. ;功能:类似于(entsel)函数，带提示，且带一个过滤表，只选择表中类型
4. ;参数:  _types  过滤列表，对象类型字符串列表  msg:  提示语，字符串
5. ;样例:(sel '("LINE" "LWPOLYLINE") "选择直线...")
6. (defun Sel (_types msg / gr ent m ty)
7.    (defun com(ty tylst / i rVal)
8.        (setq i 0)
9.        (while (< i (length tylst))
10.            (if (= ty (nth i tylst))
11.   (progn (setq rVal t) (setq i (length tylst)))
12.            )
13.            (setq i (1+ i))
14.        )
15.        rVal
16.    )
17.    (prompt msg)
18.    (setq m nil)
19.    (while (not m)
20.        (setq gr (grread 2 4 2))
21.        (cond
22.            ((= (car gr) 3)
23.              (setq ent (ssget (cadr gr)))
24.              (if (not (and ent (com (cdr (assoc 0 (entget (setq ent (ssname   ent 0))))) _types)))
25.    
26.    (setq ent nil)
27.              )
28.              (setq m t)
29.            )
30.            ((= (car gr) 25) (setq m t))
31.        )
32.    )
33.    (princ "\n")
34.    (if ent (list ent (cadr gr)) nil)
35. )(defun wl-print-to-string (lst / dz lst2)
36.    (if (= lst "\n")
37.        (setq lst2 "\n")
38.        (progn
39.            (setq dz (getvar "dimzin"))
40.            (setvar "dimzin" 1)
41.            (setq lst2 (vl-princ-to-string (mapcar '(lambda (e) (mapcar 'rtos e '(2 2 2) '(8 8 8))) lst)))
42.            (setvar "dimzin" dz)
43.        )
44.    )
45.    lst2
46. )(defun GetVer( / pts ents ent m n pts2 pts3 pts_l i)
47.    (setq ent (car (sel '("POLYLINE") "选择多面网格...")))
48.    (setq ents (entget ent))
49.    (setq m (cdr (assoc 71 ents)))
50.    (setq n (cdr (assoc 72 ents)))
51.    (while (/= (cdr (assoc 0 (setq ents (entget (setq ent (entnext ent)))))) "SEQEND")
52.        (setq pts (append pts (list (cdr (assoc 10 ents)))))
53.    )
54.    (setq i 0)
55.    (setq pts3 nil)
56.    (while (< i (length pts))
57.        (setq pts2 nil)
58.        (repeat n
59.            (setq pts2 (append pts2 (list (nth i pts))))
60.            (setq i (1+ i))
61.        )
62.        (setq pts3 (append pts3 (list pts2)))
63.    )
64.    (if (< (cadar pts) (cadr (last pts)))
65.        (setq pts (reverse pts))
66.    )
67.    pts3
68. )   (defun OutTxt( / pts i pt_lst fname f)
69.    (setq pts (Getver))
70.    (setq i 0)
71.    (setq fname (getfiled "选择输出文件" "" "txt" 1))
72.    (if fname
73.        (progn
74.            (setq pt_lst nil)
75.            (repeat (+ (/ (length pts) 2) 1)
76.   (setq pt_lst (append pt_lst (list (nth (* 2 i) pts) "\n")))
77.   (setq i (1+ i))
78.            )
79.            (setq f (open fname "w"))
80.            (Write-line (apply 'strcat (mapcar 'wl-print-to-string pt_lst)) f)
81.            (setq pt_lst nil
82.          i 0)
83.            (repeat (/ (length pts) 2)
84.   (setq pt_lst (append pt_lst (list (nth (+ (* 2 i) 1) pts) "\n")))
85.   (setq i (1+ i))
86.            )
87.            (Write-line (apply 'strcat (mapcar 'wl-print-to-string pt_lst)) f)
88.            (close f)
89.        )
90.    )
91.    (princ)
92. )(defun ReadTxt( / fname f pts1 pts2 pts i m ptstr)
93.    (setq fname (getfiled "选择输出文件" "" "txt" 0))
94.    (if fname
95.        (progn
96.            (setq f (open fname "r"))
97.            (while (/= (setq ptstr (read-line f)) "")
98.   (setq pts1 (append pts1 (list (read ptstr))))
99.            )
100.            (while (and (setq ptstr (read-line f)) (/= ptstr ""))
101.   (setq pts2 (append pts2 (list (read ptstr))))
102.            )
103.            (setq m (+ (length pts1) (length pts2)))
104.            (setq i 0)
105.            (repeat (length pts1)
106.   (setq pts (append pts (list (nth i pts1))))
107.   (if (nth i pts2)
108.      (setq pts (append pts (list (nth i pts2))))
109.   )
110.   (setq i (1+ i))
111.            )
112.            (close f)
113.            (list (apply 'append pts) m)
114.        )
115.    )
116. )(defun MakeMesh(pt_lst m / os cmd)
117.    (setq os (getvar "osmode"))
118.    (setq cmd (getvar "cmdecho"))
119.    (setvar "osmode" 0)
120.    (setvar "cmdecho" 0)
121.    (command "_.3dmesh" m (/ (length pt_lst) m))
122.    (mapcar 'command pt_lst)
123.    (setvar "osmode" os)
124.    (setvar "cmdecho" cmd)
125. )(defun c:mesh( / pts)
126.    (setq ty (getstring "[(I)输入]<(O)输出>:"))
127.    (if (or (= ty "I") (= ty "i"))      
128.        (progn
129.            (setq pts (ReadTxt))
130.            (if pts
131.   (MakeMesh (car pts) (cadr pts))
132.            )
133.        )
134.        (OutTxt)
135.    )
136.    (princ)
137. )

;函数:Sel ;功能:类似于(entsel)函数，带提示，且带一个过滤表，只选择表中类型 ;参数:  _types  过滤列表，对象类型字符串列表  msg:  提示语，字符串 ;样例:(sel '("LINE" "LWPOLYLINE") "选择直线...") (defun Sel (_types msg / gr ent m ty)    (defun com(ty tylst / i rVal)        (setq i 0)        (while (< i (length tylst))            (if (= ty (nth i tylst))   (progn (setq rVal t) (setq i (length tylst)))            )            (setq i (1+ i))        )        rVal    )    (prompt msg)    (setq m nil)    (while (not m)        (setq gr (grread 2 4 2))        (cond            ((= (car gr) 3)              (setq ent (ssget (cadr gr)))              (if (not (and ent (com (cdr (assoc 0 (entget (setq ent (ssname   ent 0))))) _types)))        (setq ent nil)              )              (setq m t)            )            ((= (car gr) 25) (setq m t))        )    )    (princ "\n")    (if ent (list ent (cadr gr)) nil) )(defun wl-print-to-string (lst / dz lst2)    (if (= lst "\n")        (setq lst2 "\n")        (progn            (setq dz (getvar "dimzin"))            (setvar "dimzin" 1)            (setq lst2 (vl-princ-to-string (mapcar '(lambda (e) (mapcar 'rtos e '(2 2 2) '(8 8 8))) lst)))            (setvar "dimzin" dz)        )    )    lst2 )(defun GetVer( / pts ents ent m n pts2 pts3 pts_l i)    (setq ent (car (sel '("POLYLINE") "选择多面网格...")))    (setq ents (entget ent))    (setq m (cdr (assoc 71 ents)))    (setq n (cdr (assoc 72 ents)))    (while (/= (cdr (assoc 0 (setq ents (entget (setq ent (entnext ent)))))) "SEQEND")        (setq pts (append pts (list (cdr (assoc 10 ents)))))    )    (setq i 0)    (setq pts3 nil)    (while (< i (length pts))        (setq pts2 nil)        (repeat n            (setq pts2 (append pts2 (list (nth i pts))))            (setq i (1+ i))        )        (setq pts3 (append pts3 (list pts2)))    )    (if (< (cadar pts) (cadr (last pts)))        (setq pts (reverse pts))    )    pts3 )   (defun OutTxt( / pts i pt_lst fname f)    (setq pts (Getver))    (setq i 0)    (setq fname (getfiled "选择输出文件" "" "txt" 1))    (if fname        (progn            (setq pt_lst nil)            (repeat (+ (/ (length pts) 2) 1)   (setq pt_lst (append pt_lst (list (nth (* 2 i) pts) "\n")))   (setq i (1+ i))            )            (setq f (open fname "w"))            (Write-line (apply 'strcat (mapcar 'wl-print-to-string pt_lst)) f)            (setq pt_lst nil          i 0)            (repeat (/ (length pts) 2)   (setq pt_lst (append pt_lst (list (nth (+ (* 2 i) 1) pts) "\n")))   (setq i (1+ i))            )            (Write-line (apply 'strcat (mapcar 'wl-print-to-string pt_lst)) f)            (close f)        )    )    (princ) )(defun ReadTxt( / fname f pts1 pts2 pts i m ptstr)    (setq fname (getfiled "选择输出文件" "" "txt" 0))    (if fname        (progn            (setq f (open fname "r"))            (while (/= (setq ptstr (read-line f)) "")   (setq pts1 (append pts1 (list (read ptstr))))            )            (while (and (setq ptstr (read-line f)) (/= ptstr ""))   (setq pts2 (append pts2 (list (read ptstr))))            )            (setq m (+ (length pts1) (length pts2)))            (setq i 0)            (repeat (length pts1)   (setq pts (append pts (list (nth i pts1))))   (if (nth i pts2)      (setq pts (append pts (list (nth i pts2))))   )   (setq i (1+ i))            )            (close f)            (list (apply 'append pts) m)        )    ) )(defun MakeMesh(pt_lst m / os cmd)    (setq os (getvar "osmode"))    (setq cmd (getvar "cmdecho"))    (setvar "osmode" 0)    (setvar "cmdecho" 0)    (command "_.3dmesh" m (/ (length pt_lst) m))    (mapcar 'command pt_lst)    (setvar "osmode" os)    (setvar "cmdecho" cmd) )(defun c:mesh( / pts)    (setq ty (getstring "[(I)输入]<(O)输出>:"))    (if (or (= ty "I") (= ty "i"))              (progn            (setq pts (ReadTxt))            (if pts   (MakeMesh (car pts) (cadr pts))            )        )        (OutTxt)    )    (princ) )

wangyue

非常感謝meflying，真是太佩服您了，這項功能已交差了

jaminth

wangyue发表于2004-2-6 11:02:00請問自動產生多邊形網面(AcDbPolygonMesh)各個頂點坐標的清單

怎么用?