地形图缩编1：500变成2000，植被符号抽稀功能，

dwjb

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

happy336

谢谢分享，支持

myzwsc1

阅读权限不足。。。。。

dwjb

自己顶下，高人快来哦

dwjb

自己顶下，高人快来哦

gzxl

CASS里不是 绘图处理 改变当前图形比例尺
不行吗？

dwjb

gzxl 发表于 2013-4-3 22:34
CASS里不是 绘图处理 改变当前图形比例尺
不行吗？

不能改变植被符号的填充密度，也许是bug

杨光88888888

顶，很有用的东东

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 (= b1 nil)
   
9.     (setq b1 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. )
    

(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 (= b1 nil) <br />     (setq b1 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 />

dwjb

qfkxc 发表于 2013-4-6 19:09

程序运行速度慢，重新填充的符号不均匀，应该按照3cm重新计算填充坐标

004

dwjb 发表于 2013-4-6 20:58
程序运行速度慢，重新填充的符号不均匀，应该按照3cm重新计算填充坐标

抽稀还可以，但重新计算填充坐标，意味着要判断出植被的范围，困难了吧。

Gu_xl