在地形图缩编1：500变成1：2000的时候，植被符号需要抽稀，

dwjb

在地形图缩编1：500变成1：2000的时候，植被符号需要抽稀，（原图是按照2cm填充的，变成2000图间距就很密，需要删减）本人一直用高程点过滤功能，请高人写个程序，一次批选，按照距离自动删减，

dwjb

高手快来i，不行再给些

qfkxc

2. (defun c:fhcx ()
   
3. (vl-load-com)
   
4. (setvar "cmdecho" 0)
   
5. (setq v1 (getvar "osmode"))
   
6. (setvar "osmode" 0)
   
7. (setq blc(getreal "请输入当前图形的比例尺<500>:"))
   
8. (if (= blc nil)
   
9.     (setq blc 500))
   
10. (setq blxs (* 0.001 blc));新插入块的比例系数
    
11. (setq xzl (- (* 0.02 blc) 1.5))
    
12. (setq yzl (- (* 0.01 blc) 1.5))
    
13. (setq s1 (entsel "\n请选择一个植被符号:"))
    
14. (command "zoom" "e" "")
    
15. (setq tyb (entget(car s1)))；图元表
    
16. (setq gjz0 (assoc 0 tyb));关键字0
    
17. (setq tkm (assoc 2 tyb));图块名
    
18. (setq tcm (assoc 8 tyb));图层名
    
19. (setq glb (list gjz0 tcm tkm));选择集过滤表
    
20. (setq s (ssget "x" glb ));植被选择集
    
21. (setq tygs (sslength s));选择集内图元个数
    
22. (setq ff (open "d:/坐标表.txt" "w"))；新建植被插入点坐标文档
    
23. (setq i 0)
    
24. (repeat tygs
    
25. (setq dgtym (ssname s i))
    
26. (setq dgtyb (entget dgtym))；单个符号图元表
    
27. (setq zbb (cdr (assoc 10 dgtyb)));坐标表
    
28. (setq zbx (rtos (car zbb) 2 2))
    
29. (setq zby (rtos (cadr zbb) 2 2))
    
30. (setq zbzfq (strcat zbx "," zby))；坐标字符串
    
31. (write-line zbzfq ff)；写入坐标字符串
    
32. (setq i (1+ i)))
    
33. (close ff)
    
34. (command  "._erase" s "" );删除植被符号
    
35. (setq tcm1 (cdr tcm))
    
36. (command "layer" "s" tcm1 "");设置当前层
    
37. (setq ff (open "d:/坐标表.txt" "r"))；打开植被插入点坐标文档
    
38. (setq tkmc (strcat (cdr tkm) ".dwg"))
    
39. (setq i 0)
    
40. (while (< i tygs)
    
41. (setq zbzfq (read-line ff));读出坐标字符串
    
42. (setq zfqcd (strlen zbzfq));坐标字符串的长度
    
43. (setq dhwz (vl-string-search "," zbzfq));查找,所在位置
    
44. (setq xzb (atof (substr zbzfq 1 dhwz)));截取字符串转换为X坐标
    
45. (setq yzb (atof (substr zbzfq (+ dhwz 2))));截取字符串转换为y坐标
    
46. (setq zbb (list xzb yzb));组合为坐标表
    
47. (setq p1 (list (- xzb xzl) (- yzb yzl)));检查是否有植被符号的范围
    
48. (setq p2 (list (+ xzb xzl) (+ yzb yzl)))
    
49. (setq s (ssget "w" p1 p2 glb ));植被选择集
    
50. (if (= s nil)
    
51. (progn
    
52. (setq p1 (list (- xzb 3) (- yzb 3 (* 0.01 blc))))
    
53. (setq p2 (list (+ xzb 3) (+ yzb 3 (* 0.01 blc))))
    
54. (setq s (ssget "w" p1 p2 glb ));植被选择集
    
55. (if (= s nil)
    
56. (command "-insert" tkmc zbb blxs blxs blxs))))
    
57. (setq i (1+ i)))
    
58. (close ff)
    
59. (command "layer" "s" 0 "");设置当前层
    
60. )
    
61. 
    
62. 
    

(defun c:fhcx ()<br /> (vl-load-com)<br /> (setvar "cmdecho" 0)<br /> (setq v1 (getvar "osmode"))<br /> (setvar "osmode" 0)<br /> (setq blc(getreal "请输入当前图形的比例尺<500>:"))<br /> (if (= blc nil) <br />     (setq blc 500))<br /> (setq blxs (* 0.001 blc));新插入块的比例系数<br /> (setq xzl (- (* 0.02 blc) 1.5))<br /> (setq yzl (- (* 0.01 blc) 1.5))<br /> (setq s1 (entsel "\n请选择一个植被符号:"))<br /> (command "zoom" "e" "")<br /> (setq tyb (entget(car s1)))；图元表<br /> (setq gjz0 (assoc 0 tyb));关键字0<br /> (setq tkm (assoc 2 tyb));图块名<br /> (setq tcm (assoc 8 tyb));图层名<br /> (setq glb (list gjz0 tcm tkm));选择集过滤表<br /> (setq s (ssget "x" glb ));植被选择集<br /> (setq tygs (sslength s));选择集内图元个数<br /> (setq ff (open "d:/坐标表.txt" "w"))；新建植被插入点坐标文档<br /> (setq i 0)<br /> (repeat tygs<br /> (setq dgtym (ssname s i))<br /> (setq dgtyb (entget dgtym))；单个符号图元表<br /> (setq zbb (cdr (assoc 10 dgtyb)));坐标表<br /> (setq zbx (rtos (car zbb) 2 2))<br /> (setq zby (rtos (cadr zbb) 2 2))<br /> (setq zbzfq (strcat zbx "," zby))；坐标字符串<br /> (write-line zbzfq ff)；写入坐标字符串<br /> (setq i (1+ i)))<br /> (close ff)<br /> (command  "._erase" s "" );删除植被符号<br /> (setq tcm1 (cdr tcm))<br /> (command "layer" "s" tcm1 "");设置当前层<br /> (setq ff (open "d:/坐标表.txt" "r"))；打开植被插入点坐标文档<br /> (setq tkmc (strcat (cdr tkm) ".dwg"))<br /> (setq i 0)<br /> (while (< i tygs)<br /> (setq zbzfq (read-line ff));读出坐标字符串<br /> (setq zfqcd (strlen zbzfq));坐标字符串的长度<br /> (setq dhwz (vl-string-search "," zbzfq));查找,所在位置<br /> (setq xzb (atof (substr zbzfq 1 dhwz)));截取字符串转换为X坐标<br /> (setq yzb (atof (substr zbzfq (+ dhwz 2))));截取字符串转换为y坐标<br /> (setq zbb (list xzb yzb));组合为坐标表<br /> (setq p1 (list (- xzb xzl) (- yzb yzl)));检查是否有植被符号的范围<br /> (setq p2 (list (+ xzb xzl) (+ yzb yzl)))<br /> (setq s (ssget "w" p1 p2 glb ));植被选择集<br /> (if (= s nil)<br /> (progn <br /> (setq p1 (list (- xzb 3) (- yzb 3 (* 0.01 blc))))<br /> (setq p2 (list (+ xzb 3) (+ yzb 3 (* 0.01 blc))))<br /> (setq s (ssget "w" p1 p2 glb ));植被选择集<br /> (if (= s nil)<br /> (command "-insert" tkmc zbb blxs blxs blxs))))<br /> (setq i (1+ i)))<br /> (close ff)<br /> (command "layer" "s" 0 "");设置当前层<br /> )<br /> <br /> <br />

dwjb

qfkxc 发表于 2013-4-6 20:08

功能基本完整，应该输入当前图的比例尺，要按照3厘米间隔插入符号的，
或者可以手工选取抽稀的范围，或者pline线选则的范围，运行速度不是很快，
非常感谢！！！！！！！！！！！如何给你转明镜币呢？

dwjb

dwjb 发表于 2013-4-6 20:16
功能基本完整，应该输入当前图的比例尺，要按照3厘米间隔插入符号的，
或者可以手工选取抽稀的范围，或 ...

在另一个测绘板块已经付了1个明镜币，和50分

qfkxc

程序是根据我单位的符号间隔编辑的，看来你的符号比我的间距大一倍，在输入当前比例尺时你把比例尺扩大一倍试试，即2000的比例尺你输入4000试试。

dwjb

qfkxc 发表于 2013-4-7 07:02
程序是根据我单位的符号间隔编辑的，看来你的符号比我的间距大一倍，在输入当前比例尺时你把比例尺扩大一倍 ...

符号旋转了，比例尺输入2000，就旋转2度，4000就旋转4度，----bug？？？