[LISP]请教写扩展数据的问题

wmz

我用LISP写了一个写扩展数据的程序,但运行起来相当慢(慢得不可忍受),请那位大侠帮我看看,能不能优化,使之加快运行速度,谢谢了! 源代码如下: (defun stbm (s0 db / ss sss b c)
(setq ss (entget (ssname s0 0)(list "SOUTH")))
(setq sss (ssname s0 0))
(cond ((= db "a")
(setq b '(("SOUTH" (1000 . "202101"))))
(setq c '("SOUTH" (1000 . "202101")))
)

((= db "ad")
(setq b '(("SOUTH" (1000 . "202111"))))
(setq c '("SOUTH" (1000 . "202111")))
)
)
(setq ss (subst (cons -3 b) (assoc -3 ss) ss))
(regapp "SOUTH")
(setq ss (append ss (list (cons '-3 (list c)))))
(entmod ss)
(entupd sss)
(setq s0 nil)
)
(defun c:SSD (/ zdx0 zdx s0)
(command "insert" "gc200" (list y x h) 1.0 1.0 0)
(setq s0 (ssget "X" '((2 . "GC200"))))
(stbm s0 "a")
(command "text" (list (+ y 0.5) (- x 0.75)) "2.0" "0" h)
(setq s0 (ssget "X" '((0 . "TEXT"))))(stbm s0 "ad")
)

meflying

就写扩展数据的部分： (setq ss (subst (cons -3 b) (assoc -3 ss) ss))
(regapp "SOUTH")
(setq ss (append ss (list (cons '-3 (list c)))))
(entmod ss) 基本上已经是最精简了，，， 不过你程序中的 (setq s0 ...)可以改为(setq s0 (entlast))，后面也就不用(ssname s0 0)了，而直接使用s0 但怎么说，你这个程序都不至于慢吧，更不用说慢得不能忍受，因为你连一个循环都没有，除非你的图有问题

wmz

谢谢你,飞哥! 这是一段展点程序,我这只是其中的一小段代码,在主程序中还有读数据,循环展点等等,我试着展了大约3000点,等了好半天,我想,问题可能出在建立选集上面,下面这一句: (setq s0 (ssget "X" '((2 . "GC200"))))(stbm s0 "a") 和 (setq s0 (ssget "X" '((0 . "TEXT"))))(stbm s0 "ad") 一句上面,因为,如果在前面加上循环以后,如: (defun c:SSD (/ n zdx0 zdx s0) (setq n 3000) ;n是读数据以后得来的(读数据代码此处略) (repeat n
(command "insert" "gc200" (list y x h) 1.0 1.0 0)
(setq s0 (ssget "X" '((2 . "GC200"))))
(stbm s0 "a")
(command "text" (list (+ y 0.5) (- x 0.75)) "2.0" "0" h)
(setq s0 (ssget "X" '((0 . "TEXT"))))(stbm s0 "ad")
) ) 则每展一点,就要进行一次选择,而按照这样一种过滤法,选择集s0里面就会累积重复,从而造成重复进行选择重复进行操作,那当然就慢了.还有一种办法就是先展点,后加入扩展数据,选集一次建立统一对选择集进行操作,我今天进行了测试,不是很慢.能忍受.但现在有一个问题:这是地形点展绘,我的数据是混着的,即既有岸上点,又有水下点,它们在图形数据库中的其他属性均相同,在没加入扩展属性以前是无法将它们区分开的.我展点的时候是用它们的编码进行识别的,要加入不同的扩展属性,以便今后选择区分. 请飞哥帮忙想想办法,能不能展一点只选择当前的这一点,我没找到这样的办法.

meflying

我不明白什么叫展点，什么叫展绘、水上点、水下点。。。


就按你的程序，重复3000次，插入块、写文字，不管怎么样都会很慢的。。。


你不如传个图上来，然后在用通俗的语言描述一下你要做什么。。。

wmz

好!我下午就将有关数据及相关源程序发来,请你看看.(不是图,而是数据,要展绘于图上,你一看就明白了)

wmz

飞哥:现将程序及数据传给你,请你看看.这是一段长江河道地形的水下点数据及部分边滩数据(虽然你不是搞测绘的,但我相信你能看懂),数据共有5项,分别是:点号,编码,y,x,h.其中编码0表示水边点;1表示水下点;2表示水上(陆地)点(在地形测量中,y,x与数学中是反着的).这段数据仅只有10来公里,而我们要测绘长江的水下地形图,往往一段工程有数百公里之遥,在绘图时不得不分段绘制.故展点速度就很重要.

wmz

我搞忘记了传一个文件,即"GC200.DWG",现补上.

meflying

我自己做了个块，


tmp文件修改了你的生成文字和块的方法，速度提高了些


tmp2使用了vla方法，把其中一些细节的方法做了改进，速度又提高了少许。。。


两种都基本上未修改你的程序的整体结构和思路，由于要生成这么多图形，所以不管怎么样，我想再怎么改进，速度都很难有很大的提高了。。。


测试过程，用tmp2处理1100个数据用了7秒多，你原来的程序用了57秒，我处理完所有的数据用了1分27秒，你的程序我没有等到结束





       

wmz

十分感谢!我下午就去试一试!

龙龙仔

2. ;;假设图中已有图块"gc200"
3. ;;把文字&图块&xdata改以entmake,速度将快2倍
4. ;;字体大小未定
5. ;;未详细测试
6. ;; 地形展点主程序
7. (defun C:DXZD (/ FN N0 BLXS NAME NAME1 F0 F1 SXDM SXDJ ZHUJ Y X  H SBX S0
8.                ASPACE)
9.    (if (not BLC)
10.        (setq BLC (BLCHS BLC))
11.    )
12.    ;;(command "LAYER" "N" "GCD" "C" 1 "")
13.    ;;(command "layer" "s" "GCD" "")
14.    ;;(command "style" "HZ" "rs" "" "0.8" "" "N" "N" "N")
15.    (setq BLXS (/ BLC 1000.0))
16.    (setq NAME (getfiled "输入水下点资料档案名:" "" "dat" 8))
17.    (setq F (open (findfile NAME) "r"))
18.    (setq N (atoi (read-line F)))
19.    (setq  ZHUJ (getangle
20.                "\n水下点旋转角度<偏离北方向:左 + 右 -   单位: 度> ? "
21.            )        ;这里改成了取角度，输入180度，会自动转换成3.1519...
22.   SBX   (getint "\n水边点写不写高程(写:1 不写:2):")
23.    )
24.    (if (= ZHUJ NIL)
25.        (setq ZHUJ 0.0)
26.    )
27.    (setq N0 1)
28.    (setq STIME (getvar "date"))
29.    (while (<= N0 N)
30.        (setq PARAM (DUSJ F))
31.        (setq SXDJ (car PARAM))
32.        (setq PT (cdr PARAM))
33.        (setq H (last PT))
34.        (cond
35.            ((= SXDJ 2) (SSD PT))    ;sxdj=2 水上点展绘
36.            ((= SXDJ 1) (DSD PT))    ;sxdj=1 水下点展绘
37.            ((= SXDJ 0)      ;sxdj=0 水边点展绘
38.              (cond
39.    ((= SBX 2)
40.      (MAKEINSERT "gc200" PT BLXS BLXS "186400")
41.    )
42.    ((= SBX 1) (SSD PT))
43.              )        ;cond2
44.            )
45.        )          ;cond1
46.        (setq N0 (+ N0 1))
47.    )          ;end while
48.    (close F)
49.    (setq ETIME (getvar "date"))
50.    (prompt
51.        (strcat
52.            "\n程式共耗用时间: "
53.            (rtos (* 86400.0 (- (- ETIME STIME) (fix (- ETIME STIME))))
54.          2
55.          3
56.            )
57.            "秒"
58.        )
59.    )
60.   (princ)
61. )          ;END
62. ;;地形展点展水下点
63. (defun DSD (PT / X1 ZDX0 ZDX S0)
64.    (setq ZDX0 (* BLXS 2.0))
65.    (MAKEINSERT "gc200" PT BLXS BLXS "186400")
66.    (setq  X (polar (list (car PT) (cadr PT))
67.      (+ (* 1.5 pi) ZHUJ)
68.      (* BLXS 0.25)
69.      )
70.    )
71.    (setq X1 (polar X ZHUJ (* BLXS -0.5)))
72.    (setq X (polar X ZHUJ (* BLXS 0.5)))
73.    (MAKETEXT "r" X1 ZDX0 ZHUJ (rtos H 2 0) "186411")
74.    (setq H (* (- H (fix H)) 10.0))
75.    (MAKETEXT "n" X ZDX0 ZHUJ (rtos H 2 0) "186412")
76. )          ;end
77. ;;地形展点展岸上点
78. (defun SSD (PT / ZDX0 ZDX S0)
79.    (setq ZDX0 (* BLXS 2.0))
80.    (MAKEINSERT "gc200" PT BLXS BLXS "202101")
81.    (MAKETEXT
82.        "n"
83.        (list (+ (car PT) (* BLXS 0.5)) (- (cadr PT) (* BLXS 0.75)))
84.        ZDX0
85.        0
86.        (rtos H 2 1)
87.        "202111"
88.    )
89. )          ;end
90. ;;读数据
91. (defun DUSJ (F / STR)
92.    (setq STR (read-line F))
93.    (setq STR (vl-string-translate "," " " STR))
94.    (cdr (read (strcat "(" STR ")")))
95. )
96. ;;输入比例尺函数
97. (defun BLCHS (BLC / W1)
98.    (setq W1 (getint "\输入比例尺:"))
99.    (if W1
100.        W1
101.        BLC
102.    )
103. )
104. (defun MAKETEXT  (FLAG PT HEI ANG STR DATA / PTX TOBJ)
105.    (if (= (strcase FLAG) "R")
106.        (entmake
107.            (list '(0 . "TEXT")
108.          (cons 10 PT)
109.          '(40 . 0.002)
110.          (cons 50 ANG)
111.          (cons 1 STR)
112.          (cons 11 PT)
113.          '(72 . 2)
114.          (list -3 (list "SOUTH" (cons 1000 DATA)))
115.            )
116.        )
117.        (entmake (list '(0 . "TEXT")
118.          (cons 10 PT)
119.          '(40 . 0.002)
120.          (cons 50 ANG)
121.          (cons 1 STR)
122.          (list -3 (list "SOUTH" (cons 1000 DATA)))
123.            )
124.        )
125.    )
126. )
127. (defun MAKEINSERT (BLKNAME PT SX SY DATA)
128.    (entmake (list '(0 . "INSERT")
129.      '(100 . "AcDbBlockReference")
130.      (cons 2 BLKNAME)
131.      (cons 10 PT)
132.      (cons 41 SX)
133.      (cons 42 SY)
134.      (list -3 (list "SOUTH" (cons 1000 DATA)))
135.        )
136.    )
137. )

;;假设图中已有图块"gc200" ;;把文字&图块&xdata改以entmake,速度将快2倍 ;;字体大小未定 ;;未详细测试 ;; 地形展点主程序 (defun C:DXZD (/ FN N0 BLXS NAME NAME1 F0 F1 SXDM SXDJ ZHUJ Y X  H SBX S0                ASPACE)    (if (not BLC)        (setq BLC (BLCHS BLC))    )    ;;(command "LAYER" "N" "GCD" "C" 1 "")    ;;(command "layer" "s" "GCD" "")    ;;(command "style" "HZ" "rs" "" "0.8" "" "N" "N" "N")    (setq BLXS (/ BLC 1000.0))    (setq NAME (getfiled "输入水下点资料档案名:" "" "dat" 8))    (setq F (open (findfile NAME) "r"))    (setq N (atoi (read-line F)))    (setq  ZHUJ (getangle                "\n水下点旋转角度<偏离北方向:左 + 右 -   单位: 度> ? "            )        ;这里改成了取角度，输入180度，会自动转换成3.1519...   SBX   (getint "\n水边点写不写高程(写:1 不写:2):")    )    (if (= ZHUJ NIL)        (setq ZHUJ 0.0)    )    (setq N0 1)    (setq STIME (getvar "date"))    (while (<= N0 N)        (setq PARAM (DUSJ F))        (setq SXDJ (car PARAM))        (setq PT (cdr PARAM))        (setq H (last PT))        (cond            ((= SXDJ 2) (SSD PT))    ;sxdj=2 水上点展绘            ((= SXDJ 1) (DSD PT))    ;sxdj=1 水下点展绘            ((= SXDJ 0)      ;sxdj=0 水边点展绘              (cond    ((= SBX 2)      (MAKEINSERT "gc200" PT BLXS BLXS "186400")    )    ((= SBX 1) (SSD PT))              )        ;cond2            )        )          ;cond1        (setq N0 (+ N0 1))    )          ;end while    (close F)    (setq ETIME (getvar "date"))    (prompt        (strcat            "\n程式共耗用时间: "            (rtos (* 86400.0 (- (- ETIME STIME) (fix (- ETIME STIME))))          2          3            )            "秒"        )    )   (princ) )          ;END ;;地形展点展水下点 (defun DSD (PT / X1 ZDX0 ZDX S0)    (setq ZDX0 (* BLXS 2.0))    (MAKEINSERT "gc200" PT BLXS BLXS "186400")    (setq  X (polar (list (car PT) (cadr PT))      (+ (* 1.5 pi) ZHUJ)      (* BLXS 0.25)      )    )    (setq X1 (polar X ZHUJ (* BLXS -0.5)))    (setq X (polar X ZHUJ (* BLXS 0.5)))    (MAKETEXT "r" X1 ZDX0 ZHUJ (rtos H 2 0) "186411")    (setq H (* (- H (fix H)) 10.0))    (MAKETEXT "n" X ZDX0 ZHUJ (rtos H 2 0) "186412") )          ;end ;;地形展点展岸上点 (defun SSD (PT / ZDX0 ZDX S0)    (setq ZDX0 (* BLXS 2.0))    (MAKEINSERT "gc200" PT BLXS BLXS "202101")    (MAKETEXT        "n"        (list (+ (car PT) (* BLXS 0.5)) (- (cadr PT) (* BLXS 0.75)))        ZDX0        0        (rtos H 2 1)        "202111"    ) )          ;end ;;读数据 (defun DUSJ (F / STR)    (setq STR (read-line F))    (setq STR (vl-string-translate "," " " STR))    (cdr (read (strcat "(" STR ")"))) ) ;;输入比例尺函数 (defun BLCHS (BLC / W1)    (setq W1 (getint "\输入比例尺:"))    (if W1        W1        BLC    ) ) (defun MAKETEXT  (FLAG PT HEI ANG STR DATA / PTX TOBJ)    (if (= (strcase FLAG) "R")        (entmake            (list '(0 . "TEXT")          (cons 10 PT)          '(40 . 0.002)          (cons 50 ANG)          (cons 1 STR)          (cons 11 PT)          '(72 . 2)          (list -3 (list "SOUTH" (cons 1000 DATA)))            )        )        (entmake (list '(0 . "TEXT")          (cons 10 PT)          '(40 . 0.002)          (cons 50 ANG)          (cons 1 STR)          (list -3 (list "SOUTH" (cons 1000 DATA)))            )        )    ) ) (defun MAKEINSERT (BLKNAME PT SX SY DATA)    (entmake (list '(0 . "INSERT")      '(100 . "AcDbBlockReference")      (cons 2 BLKNAME)      (cons 10 PT)      (cons 41 SX)      (cons 42 SY)      (list -3 (list "SOUTH" (cons 1000 DATA)))        )    ) )