请教关于打散和合并属性块的问题

wmz

;;;;;南方CASS的地形点是用的属性块，他有打散和合并功能，不知是如何实现的
;;;;;我现在用了一种办法但感觉实在是太笨了！请教哪位大侠能指教一二！
;;;;;以下是我的代码：

  (vl-load-com)
;;;打散
(defun c:DSKY (/ bl blc blxs ZG s n s0 s1 d1 m k jd b)
  (setq blc (getvar "userr1") blxs (/ blc 1000.0))
  (setq  bl (* blxs 0.4) ZG (* 2.0 blxs))
  (setq s (ssget))
  (setq n (sslength s) m 0)
  (repeat n
    (setq s0 (ssname s m) m (+ m 1) k 0)
    (setq s1 (entget s0 (list "SOUTH")))
    (setq d1 (cdr(assoc 10 s1)))
    (setq JD (cdr(assoc 50 s1)))
    (setq  b (cdadr (cadr (assoc -3 s1))))
    (setq  b (vl-princ-to-string b))
    (setq  b (vl-string-translate "" "" B))
    (cond ((= b "202101")(setq height (last d1))
           (command "_.erase" s0 "")
           (MKINSERT d1 bl bl bl JD "202101")
           (MKTEXTA d1 ZG JD (rtos height 2 2) "202111")
          )
          ((= b "186400")(setq H (rtos (last d1) 2 1))
           (command "_.erase" s0 "")
           (setq k (vl-string-search "." h))
           (setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
           (MKINSERT d1 bl bl bl JD "186400")
           (MKTEXTB d1 ZG JD h1 "186411")
           (MKTEXTC d1 ZG JD h2 "186412")
          )
    )
  )
)
;;;合并
(defun c:HBKY (/ bl blc blxs ZG lay s n s0 s1 d1 m k jd b)
  (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" ""  "")
  (setq blc (getvar "userr1") blxs (/ blc 1000.0))
  (setq  bl (* blxs 0.4) ZG (* 2.0 blxs))
  (setq s (ssget))
  (setq n (sslength s) m 0)(print "n=")(princ n)(princ)
  (repeat n
    (setq  s0 (ssname s m) m (+ m 1) k 0)
    (setq  s1 (entget s0 (list "SOUTH")))
    (setq lay (cdr(assoc 8 s1)))
    (setq   e (cdr (assoc 0 s1)))
    (if (and(= e "TEXT")(= lay "GCD"))(command "erase" s0 ""))
    (if (and(= e "INSERT")(= lay "GCD"))(progn
       (setq d1 (cdr(assoc 10 s1)))
       (setq JD (cdr(assoc 50 s1)))
       (setq  b (cdadr (cadr (assoc -3 s1))))
       (setq  b (vl-princ-to-string b))
       (setq  b (vl-string-translate "" "" B))
       (cond ((= b "202101")(setq height (rtos (last d1) 2 2))
              (command "_.erase" s0 "")
              (MINSERTAA d1 (/ bl 2.0) height)
             )
             ((= b "186400")(setq H (rtos (last d1) 2 1))
              (command "_.erase" s0 "")
              (setq k (vl-string-search "." h))
              (setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
              (MINSERTSS d1 (/ bl 2.0) JD h1 h2)
             )
       )
     ))
  )
)
;;插入块打散后用
(defun MKINSERT (PT SX SY SSZ ZJ DATA)
  (entmake (list '(0 . "INSERT")
                 '(100 . "AcDbBlockReference")
                 (cons 2 "GC200")
                 (cons 8 "GCD")
                 (cons 10 PT)
                 (cons 41 SX)
                 (cons 42 SY)
                 (cons 43 SSZ)
                 (cons 50 ZJ)
                 (list -3 (list "SOUTH" (cons 1000 DATA)))
            )
  )
)
;;;写文字岸上点打散后用
(defun MKTEXTA (PT HEI ANG STR DATA / PTX TOBJ)
    (setq pty (polar pt ANG 0.5))
    (entmake (list '(0 . "TEXT")
                   (cons 7 "HZ")
                   (cons 8 "GCD")            
                   (cons 10 PT)
                   (cons 40 HEI) ;;字高
                   (cons 41 0.8)            
                   (cons 50 ANG)
                   (cons 1 STR)
                   (cons 72 0)  ;;左对齐
                   (cons 73 2)
                   (cons 11 pty)
                   (list -3 (list "SOUTH" (cons 1000 DATA)))
              )
    )
)
;;;写文字水下点左打散后用
(defun MKTEXTB (PT HEI ANG STR DATA / PTz TOBJ)
    (setq ptz (polar pt ANG -0.3))
    (entmake (list '(0 . "TEXT")
                   (cons 7 "HZ")
                   (cons 8 "GCD")            
                   (cons 10 PT)
                   (cons 40 HEI) ;;字高
                   (cons 41 0.8)            
                   (cons 50 ANG)
                   (cons 1 STR)
                   (cons 11 ptz)
                   (cons 72 2)  ;;右对齐
                   (cons 73 0)
                   (list -3 (list "SOUTH" (cons 1000 DATA)))
              )
    )
)
;;;写文字水下点右打散后用
(defun MKTEXTC (PT HEI ANG STR DATA / PTy TOBJ)
    (setq pty (polar pt ANG 0.2))
    (entmake (list '(0 . "TEXT")
                   (cons 7 "HZ")
                   (cons 8 "GCD")            
                   (cons 10 PTy)
                   (cons 40 HEI) ;;字高
                   (cons 41 0.8)            
                   (cons 50 ANG)
                   (cons 1 STR)
                   (cons 11 pty)
                   (cons 72 0)  ;;左对齐
                   (cons 73 0)
                   (list -3 (list "SOUTH" (cons 1000 DATA)))
              )
    )
)

;;;插入块(岸上点)合并用
(defun MINSERTAA (inspt scale height / pt)
  (setq pt (polar inspt 0 (* 1.2 scale)))
  (entmake (list
             '(0 . "INSERT")
             '(100 . "AcDbEntity")
             '(100 . "AcDbBlockReference")
             '(66 . 1);;;属性跟随标志,1跟随，0不跟随
             (cons 2 "GC200")
             (cons 10 inspt)
             (cons 41 scale)
             (cons 42 scale)
             (cons 43 scale)
             '(-3 ("SOUTH" (1000 . "202101")))
           )
  )
  ;;;插入属性
    (entmake (list
            '(0 . "ATTRIB")
            '(100 . "AcDbEntity")
            '(100 . "AcDbText")
            (cons 10 pt)
            (cons 40 (* 10.0 scale))
            (cons 50 0)
            (cons 41 0.8)
            (cons 51 0)
            (cons 1 height)
            (cons 7 "HZ")
            (cons 72 0)
            (cons 11 pt)
            '(100 . "AcDbAttribute")
            (cons 2 "height")
            (cons 70 0)
            (cons 74 2)
           )
    )
           ;;;结束标志
          (entmake '((0 . "SEQEND")))
           (princ)
  )
;;;插入块(水下点)合并用
(defun MINSERTSS (inspt scale JD integer decimal / pt ptz pty)
  (setq pt (polar inspt 0 (* 1.2 scale)))
  (setq ptz (polar pt jd -0.4))
  (setq pty (polar pt jd 0.2))
  (entmake (list
             '(0 . "INSERT")
             '(100 . "AcDbEntity")
             '(100 . "AcDbBlockReference")
             '(66 . 1);;;属性跟随标志,1跟随，0不跟随
             (cons 2 "GC200")
             (cons 10 inspt)
             (cons 41 scale)
             (cons 42 scale)
             (cons 43 scale)
             (cons 50 JD)
             '(-3 ("SOUTH" (1000 . "186400")))
           )
  )
  ;;;插入属性
    (entmake (list
            '(0 . "ATTRIB")
            '(100 . "AcDbEntity")
            '(100 . "AcDbText")
            (cons 10 pt)
            (cons 40 (* 10.0 scale))
            (cons 50 JD)
            (cons 41 0.8)
            (cons 51 0)
            (cons 1 integer)
            (cons 7 "HZ")
            (cons 72 2)  ;;右对齐
            (cons 11 ptz)
            '(100 . "AcDbAttribute")
            (cons 2 "integer")
            (cons 70 0)

2. ;;;;;南方CASS的地形点是用的属性块，他有打散和合并功能，不知是如何实现的
   
3. ;;;;;我现在用了一种办法但感觉实在是太笨了！请教哪位大侠能指教一二！
   
4. ;;;;;以下是我的代码：
   
5. 
   
6.   (vl-load-com)
   
7. ;;;打散
   
8. (defun c:DSKY (/ bl blc blxs ZG s n s0 s1 d1 m k jd b)
   
9.   (setq blc (getvar "userr1") blxs (/ blc 1000.0))
   
10.   (setq  bl (* blxs 0.4) ZG (* 2.0 blxs))
    
11.   (setq s (ssget))
    
12.   (setq n (sslength s) m 0)
    
13.   (repeat n
    
14.     (setq s0 (ssname s m) m (+ m 1) k 0)
    
15.     (setq s1 (entget s0 (list "SOUTH")))
    
16.     (setq d1 (cdr(assoc 10 s1)))
    
17.     (setq JD (cdr(assoc 50 s1)))
    
18.     (setq  b (cdadr (cadr (assoc -3 s1))))
    
19.     (setq  b (vl-princ-to-string b))
    
20.     (setq  b (vl-string-translate "" "" B))
    
21.     (cond ((= b "202101")(setq height (last d1))
    
22.      (command "_.erase" s0 "")
    
23.      (MKINSERT d1 bl bl bl JD "202101")
    
24.      (MKTEXTA d1 ZG JD (rtos height 2 2) "202111")
    
25.     )
    
26.     ((= b "186400")(setq H (rtos (last d1) 2 1))
    
27.      (command "_.erase" s0 "")
    
28.      (setq k (vl-string-search "." h))
    
29.      (setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
    
30.      (MKINSERT d1 bl bl bl JD "186400")
    
31.      (MKTEXTB d1 ZG JD h1 "186411")
    
32.      (MKTEXTC d1 ZG JD h2 "186412")
    
33.     )
    
34.     )
    
35.   )
    
36. )
    
37. ;;;合并
    
38. (defun c:HBKY (/ bl blc blxs ZG lay s n s0 s1 d1 m k jd b)
    
39.   (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" ""  "")
    
40.   (setq blc (getvar "userr1") blxs (/ blc 1000.0))
    
41.   (setq  bl (* blxs 0.4) ZG (* 2.0 blxs))
    
42.   (setq s (ssget))
    
43.   (setq n (sslength s) m 0)(print "n=")(princ n)(princ)
    
44.   (repeat n
    
45.     (setq  s0 (ssname s m) m (+ m 1) k 0)
    
46.     (setq  s1 (entget s0 (list "SOUTH")))
    
47.     (setq lay (cdr(assoc 8 s1)))
    
48.     (setq   e (cdr (assoc 0 s1)))
    
49.     (if (and(= e "TEXT")(= lay "GCD"))(command "erase" s0 ""))
    
50.     (if (and(= e "INSERT")(= lay "GCD"))(progn
    
51.        (setq d1 (cdr(assoc 10 s1)))
    
52.        (setq JD (cdr(assoc 50 s1)))
    
53.        (setq  b (cdadr (cadr (assoc -3 s1))))
    
54.        (setq  b (vl-princ-to-string b))
    
55.        (setq  b (vl-string-translate "" "" B))
    
56.        (cond ((= b "202101")(setq height (rtos (last d1) 2 2))
    
57.               (command "_.erase" s0 "")
    
58.         (MINSERTAA d1 (/ bl 2.0) height)
    
59.        )
    
60.        ((= b "186400")(setq H (rtos (last d1) 2 1))
    
61.         (command "_.erase" s0 "")
    
62.         (setq k (vl-string-search "." h))
    
63.         (setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
    
64.         (MINSERTSS d1 (/ bl 2.0) JD h1 h2)
    
65.        )
    
66.        )
    
67.      ))
    
68.   )
    
69. )
    
70. ;;插入块打散后用
    
71. (defun MKINSERT (PT SX SY SSZ ZJ DATA)
    
72.   (entmake (list '(0 . "INSERT")
    
73.                  '(100 . "AcDbBlockReference")
    
74.                  (cons 2 "GC200")
    
75.                  (cons 8 "GCD")
    
76.                  (cons 10 PT)
    
77.                  (cons 41 SX)
    
78.                  (cons 42 SY)
    
79.                  (cons 43 SSZ)
    
80.                  (cons 50 ZJ)
    
81.                  (list -3 (list "SOUTH" (cons 1000 DATA)))
    
82.             )
    
83.   )
    
84. )
    
85. ;;;写文字岸上点打散后用
    
86. (defun MKTEXTA (PT HEI ANG STR DATA / PTX TOBJ)
    
87.     (setq pty (polar pt ANG 0.5))
    
88.     (entmake (list '(0 . "TEXT")
    
89.                    (cons 7 "HZ")
    
90.                    (cons 8 "GCD")      
    
91.                    (cons 10 PT)
    
92.                    (cons 40 HEI) ;;字高
    
93.                    (cons 41 0.8)      
    
94.                    (cons 50 ANG)
    
95.                    (cons 1 STR)
    
96.                    (cons 72 0)  ;;左对齐
    
97.                    (cons 73 2)
    
98.                    (cons 11 pty)
    
99.                   (list -3 (list "SOUTH" (cons 1000 DATA)))
    
100.               )
     
101.     )
     
102. )
     
103. ;;;写文字水下点左打散后用
     
104. (defun MKTEXTB (PT HEI ANG STR DATA / PTz TOBJ)
     
105.     (setq ptz (polar pt ANG -0.3))
     
106.     (entmake (list '(0 . "TEXT")
     
107.                    (cons 7 "HZ")
     
108.                    (cons 8 "GCD")      
     
109.                    (cons 10 PT)
     
110.                    (cons 40 HEI) ;;字高
     
111.                    (cons 41 0.8)      
     
112.                    (cons 50 ANG)
     
113.                    (cons 1 STR)
     
114.                    (cons 11 ptz)
     
115.                    (cons 72 2)  ;;右对齐
     
116.                    (cons 73 0)
     
117.                    (list -3 (list "SOUTH" (cons 1000 DATA)))
     
118.               )
     
119.     )
     
120. )
     
121. ;;;写文字水下点右打散后用
     
122. (defun MKTEXTC (PT HEI ANG STR DATA / PTy TOBJ)
     
123.     (setq pty (polar pt ANG 0.2))
     
124.     (entmake (list '(0 . "TEXT")
     
125.                    (cons 7 "HZ")
     
126.                    (cons 8 "GCD")      
     
127.                    (cons 10 PTy)
     
128.                    (cons 40 HEI) ;;字高
     
129.                    (cons 41 0.8)      
     
130.                    (cons 50 ANG)
     
131.                    (cons 1 STR)
     
132.                   (cons 11 pty)
     
133.                   (cons 72 0)  ;;左对齐
     
134.                   (cons 73 0)
     
135.                  (list -3 (list "SOUTH" (cons 1000 DATA)))
     
136.               )
     
137.     )
     
138. )
     
139. 
     
140. ;;;插入块(岸上点)合并用
     
141. (defun MINSERTAA (inspt scale height / pt)
     
142.   (setq pt (polar inspt 0 (* 1.2 scale)))
     
143.   (entmake (list
     
144.              '(0 . "INSERT")
     
145.              '(100 . "AcDbEntity")
     
146.              '(100 . "AcDbBlockReference")
     
147.              '(66 . 1);;;属性跟随标志,1跟随，0不跟随
     
148.              (cons 2 "GC200")
     
149.              (cons 10 inspt)
     
150.              (cons 41 scale)
     
151.              (cons 42 scale)
     
152.              (cons 43 scale)
     
153.              '(-3 ("SOUTH" (1000 . "202101")))
     
154.            )
     
155.   )
     
156.   ;;;插入属性
     
157.     (entmake (list
     
158.             '(0 . "ATTRIB")
     
159.             '(100 . "AcDbEntity")
     
160.             '(100 . "AcDbText")
     
161.            (cons 10 pt)
     
162.             (cons 40 (* 10.0 scale))
     
163.             (cons 50 0)
     
164.             (cons 41 0.8)
     
165.             (cons 51 0)
     
166.             (cons 1 height)
     
167.             (cons 7 "HZ")
     
168.             (cons 72 0)
     
169.             (cons 11 pt)
     
170.             '(100 . "AcDbAttribute")
     
171.             (cons 2 "height")
     
172.             (cons 70 0)
     
173.             (cons 74 2)
     
174.            )
     
175.     )
     
176.            ;;;结束标志
     
177.           (entmake '((0 . "SEQEND")))
     
178.            (princ)
     
179.   )
     
180. ;;;插入块(水下点)合并用
     
181. (defun MINSERTSS (inspt scale JD integer decimal / pt ptz pty)
     
182.   (setq pt (polar inspt 0 (* 1.2 scale)))
     
183.   (setq ptz (polar pt jd -0.4))
     
184.   (setq pty (polar pt jd 0.2))
     
185.   (entmake (list
     
186.              '(0 . "INSERT")
     
187.              '(100 . "AcDbEntity")
     
188.              '(100 . "AcDbBlockReference")
     
189.              '(66 . 1);;;属性跟随标志,1跟随，0不跟随
     
190.              (cons 2 "GC200")
     
191.              (cons 10 inspt)
     
192.              (cons 41 scale)
     
193.              (cons 42 scale)
     
194.              (cons 43 scale)
     
195.             (cons 50 JD)
     
196.              '(-3 ("SOUTH" (1000 . "186400")))
     
197.            )
     
198.   )
     
199.   ;;;插入属性
     
200.     (entmake (list
     
201.             '(0 . "ATTRIB")
     
202.             '(100 . "AcDbEntity")
     
203.             '(100 . "AcDbText")
     
204.             (cons 10 pt)
     
205.             (cons 40 (* 10.0 scale))
     
206.             (cons 50 JD)
     
207.             (cons 41 0.8)
     
208.             (cons 51 0)
     
209.             (cons 1 integer)
     
210.             (cons 7 "HZ")
     
211.             (cons 72 2)  ;;右对齐
     
212.             (cons 11 ptz)
     
213.             '(100 . "AcDbAttribute")
     
214.             (cons 2 "integer")
     
215.             (cons 70 0)
     
216.            (cons 73 2)
     
217.             (cons 74 1)
     
218.            )
     
219.     )
     
220.     (entmake (list
     
221.             '(0 . "ATTRIB")
     
222.             '(100 . "AcDbEntity")
     
223.             '(100 . "AcDbText")
     
224.       (cons 10 pt)
     
225.             (cons 40 (* 10.0 scale))
     
226.             (cons 50 JD)
     
227.             (cons 41 0.8)
     
228.             (cons 51 0)
     
229.             (cons 1 decimal)
     
230.             (cons 7 "HZ")
     
231.             (cons 72 0) ;;左对齐
     
232.             (cons 11 pty)
     
233.             '(100 . "AcDbAttribute")
     
234.             (cons 2 "decimal")
     
235.             (cons 70 0)
     
236.            (cons 73 2)
     
237.             (cons 74 1)
     
238.            )
     
239.     )
     
240.            ;;;结束标志
     
241.           (entmake '((0 . "SEQEND")))
     
242.            (princ)
     
243.   )
     

;;;;;南方CASS的地形点是用的属性块，他有打散和合并功能，不知是如何实现的<br /> ;;;;;我现在用了一种办法但感觉实在是太笨了！请教哪位大侠能指教一二！<br /> ;;;;;以下是我的代码：<br /> <br />   (vl-load-com)<br /> ;;;打散<br /> (defun c:DSKY (/ bl blc blxs ZG s n s0 s1 d1 m k jd b)<br />   (setq blc (getvar "userr1") blxs (/ blc 1000.0))<br />   (setq  bl (* blxs 0.4) ZG (* 2.0 blxs))<br />   (setq s (ssget))<br />   (setq n (sslength s) m 0)<br />   (repeat n<br />     (setq s0 (ssname s m) m (+ m 1) k 0)<br />     (setq s1 (entget s0 (list "SOUTH")))<br />     (setq d1 (cdr(assoc 10 s1)))<br />     (setq JD (cdr(assoc 50 s1)))<br />     (setq  b (cdadr (cadr (assoc -3 s1))))<br />     (setq  b (vl-princ-to-string b))<br />     (setq  b (vl-string-translate "" "" B))<br />     (cond ((= b "202101")(setq height (last d1))<br />      (command "_.erase" s0 "")<br />      (MKINSERT d1 bl bl bl JD "202101")<br />      (MKTEXTA d1 ZG JD (rtos height 2 2) "202111")<br />     )<br />     ((= b "186400")(setq H (rtos (last d1) 2 1))<br />      (command "_.erase" s0 "")<br />      (setq k (vl-string-search "." h))<br />      (setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))<br />      (MKINSERT d1 bl bl bl JD "186400")<br />      (MKTEXTB d1 ZG JD h1 "186411")<br />      (MKTEXTC d1 ZG JD h2 "186412")<br />     )<br />     )<br />   )<br /> )<br /> ;;;合并<br /> (defun c:HBKY (/ bl blc blxs ZG lay s n s0 s1 d1 m k jd b)<br />   (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" ""  "")<br />   (setq blc (getvar "userr1") blxs (/ blc 1000.0))<br />   (setq  bl (* blxs 0.4) ZG (* 2.0 blxs))<br />   (setq s (ssget))<br />   (setq n (sslength s) m 0)(print "n=")(princ n)(princ)<br />   (repeat n<br />     (setq  s0 (ssname s m) m (+ m 1) k 0)<br />     (setq  s1 (entget s0 (list "SOUTH")))<br />     (setq lay (cdr(assoc 8 s1)))<br />     (setq   e (cdr (assoc 0 s1)))<br />     (if (and(= e "TEXT")(= lay "GCD"))(command "erase" s0 ""))<br />     (if (and(= e "INSERT")(= lay "GCD"))(progn <br />        (setq d1 (cdr(assoc 10 s1)))<br />        (setq JD (cdr(assoc 50 s1)))<br />        (setq  b (cdadr (cadr (assoc -3 s1))))<br />        (setq  b (vl-princ-to-string b)) <br />        (setq  b (vl-string-translate "" "" B))<br />        (cond ((= b "202101")(setq height (rtos (last d1) 2 2))<br />               (command "_.erase" s0 "")<br />         (MINSERTAA d1 (/ bl 2.0) height)<br />        )<br />        ((= b "186400")(setq H (rtos (last d1) 2 1))<br />         (command "_.erase" s0 "")<br />         (setq k (vl-string-search "." h))<br />         (setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))<br />         (MINSERTSS d1 (/ bl 2.0) JD h1 h2)<br />        )<br />        )<br />      )) <br />   )<br /> )<br /> ;;插入块打散后用<br /> (defun MKINSERT (PT SX SY SSZ ZJ DATA)<br />   (entmake (list '(0 . "INSERT")<br />                  '(100 . "AcDbBlockReference")<br />                  (cons 2 "GC200")<br />                  (cons 8 "GCD")<br />                  (cons 10 PT)<br />                  (cons 41 SX)<br />                  (cons 42 SY)<br />                  (cons 43 SSZ)<br />                  (cons 50 ZJ)<br />                  (list -3 (list "SOUTH" (cons 1000 DATA)))<br />             )<br />   )<br /> )<br /> ;;;写文字岸上点打散后用<br /> (defun MKTEXTA (PT HEI ANG STR DATA / PTX TOBJ)<br />     (setq pty (polar pt ANG 0.5))<br />     (entmake (list '(0 . "TEXT")<br />                    (cons 7 "HZ")<br />                    (cons 8 "GCD")      <br />                    (cons 10 PT)<br />                    (cons 40 HEI) ;;字高<br />                    (cons 41 0.8)      <br />                    (cons 50 ANG)<br />                    (cons 1 STR)<br />                    (cons 72 0)  ;;左对齐<br />                    (cons 73 2)<br />                    (cons 11 pty)<br />                   (list -3 (list "SOUTH" (cons 1000 DATA)))<br />               )<br />     )<br /> )<br /> ;;;写文字水下点左打散后用<br /> (defun MKTEXTB (PT HEI ANG STR DATA / PTz TOBJ)<br />     (setq ptz (polar pt ANG -0.3))<br />     (entmake (list '(0 . "TEXT")<br />                    (cons 7 "HZ")<br />                    (cons 8 "GCD")      <br />                    (cons 10 PT)<br />                    (cons 40 HEI) ;;字高<br />                    (cons 41 0.8)      <br />                    (cons 50 ANG)<br />                    (cons 1 STR)<br />                    (cons 11 ptz)<br />                    (cons 72 2)  ;;右对齐<br />                    (cons 73 0)<br />                    (list -3 (list "SOUTH" (cons 1000 DATA)))<br />               )<br />     )<br /> )<br /> ;;;写文字水下点右打散后用<br /> (defun MKTEXTC (PT HEI ANG STR DATA / PTy TOBJ)<br />     (setq pty (polar pt ANG 0.2))<br />     (entmake (list '(0 . "TEXT")<br />                    (cons 7 "HZ")<br />                    (cons 8 "GCD")      <br />                    (cons 10 PTy)<br />                    (cons 40 HEI) ;;字高<br />                    (cons 41 0.8)      <br />                    (cons 50 ANG)<br />                    (cons 1 STR)<br />                   (cons 11 pty)<br />                   (cons 72 0)  ;;左对齐<br />                   (cons 73 0)<br />                  (list -3 (list "SOUTH" (cons 1000 DATA)))<br />               )<br />     )<br /> )<br /> <br /> ;;;插入块(岸上点)合并用<br /> (defun MINSERTAA (inspt scale height / pt)<br />   (setq pt (polar inspt 0 (* 1.2 scale)))<br />   (entmake (list<br />              '(0 . "INSERT")<br />              '(100 . "AcDbEntity")<br />              '(100 . "AcDbBlockReference")<br />              '(66 . 1);;;属性跟随标志,1跟随，0不跟随<br />              (cons 2 "GC200")<br />              (cons 10 inspt)<br />              (cons 41 scale)<br />              (cons 42 scale)<br />              (cons 43 scale)<br />              '(-3 ("SOUTH" (1000 . "202101")))<br />            )<br />   )<br />   ;;;插入属性<br />     (entmake (list<br />             '(0 . "ATTRIB")<br />             '(100 . "AcDbEntity")<br />             '(100 . "AcDbText")<br />            (cons 10 pt)<br />             (cons 40 (* 10.0 scale))<br />             (cons 50 0)<br />             (cons 41 0.8)<br />             (cons 51 0)<br />             (cons 1 height)<br />             (cons 7 "HZ")<br />             (cons 72 0)<br />             (cons 11 pt)<br />             '(100 . "AcDbAttribute")<br />             (cons 2 "height")<br />             (cons 70 0)<br />             (cons 74 2)<br />            )<br />     )<br />            ;;;结束标志<br />           (entmake '((0 . "SEQEND")))<br />            (princ)<br />   )<br /> ;;;插入块(水下点)合并用<br /> (defun MINSERTSS (inspt scale JD integer decimal / pt ptz pty)<br />   (setq pt (polar inspt 0 (* 1.2 scale)))<br />   (setq ptz (polar pt jd -0.4))<br />   (setq pty (polar pt jd 0.2))<br />   (entmake (list<br />              '(0 . "INSERT")<br />              '(100 . "AcDbEntity")<br />              '(100 . "AcDbBlockReference")<br />              '(66 . 1);;;属性跟随标志,1跟随，0不跟随<br />              (cons 2 "GC200")<br />              (cons 10 inspt)<br />              (cons 41 scale)<br />              (cons 42 scale)<br />              (cons 43 scale)<br />             (cons 50 JD)<br />              '(-3 ("SOUTH" (1000 . "186400")))<br />            )<br />   )<br />   ;;;插入属性<br />     (entmake (list<br />             '(0 . "ATTRIB")<br />             '(100 . "AcDbEntity")<br />             '(100 . "AcDbText")<br />             (cons 10 pt)<br />             (cons 40 (* 10.0 scale))<br />             (cons 50 JD)<br />             (cons 41 0.8)<br />             (cons 51 0)<br />             (cons 1 integer)<br />             (cons 7 "HZ")<br />             (cons 72 2)  ;;右对齐<br />             (cons 11 ptz)<br />             '(100 . "AcDbAttribute")<br />             (cons 2 "integer")<br />             (cons 70 0)<br />            (cons 73 2)<br />             (cons 74 1)<br />            )<br />     )<br />     (entmake (list<br />             '(0 . "ATTRIB")<br />             '(100 . "AcDbEntity")<br />             '(100 . "AcDbText")<br />       (cons 10 pt)<br />             (cons 40 (* 10.0 scale))<br />             (cons 50 JD)<br />             (cons 41 0.8)<br />             (cons 51 0)<br />             (cons 1 decimal)<br />             (cons 7 "HZ")<br />             (cons 72 0) ;;左对齐<br />             (cons 11 pty)<br />             '(100 . "AcDbAttribute")<br />             (cons 2 "decimal")<br />             (cons 70 0)<br />            (cons 73 2)<br />             (cons 74 1)<br />            )<br />     )<br />            ;;;结束标志<br />           (entmake '((0 . "SEQEND")))<br />            (princ)<br />   )<br />

(cons 73 2)
            (cons 74 1)
           )
    )
    (entmake (list
            '(0 . "ATTRIB")
            '(100 . "AcDbEntity")
            '(100 . "AcDbText")
            (cons 10 pt)
            (cons 40 (* 10.0 scale))
            (cons 50 JD)
            (cons 41 0.8)
            (cons 51 0)
            (cons 1 decimal)
            (cons 7 "HZ")
            (cons 72 0) ;;左对齐
            (cons 11 pty)
            '(100 . "AcDbAttribute")
            (cons 2 "decimal")
            (cons 70 0)
            (cons 73 2)
            (cons 74 1)
           )
    )
           ;;;结束标志
          (entmake '((0 . "SEQEND")))
           (princ)
  )