根据宗地编号合权利人名称批量录入属性

ffian

[quote]Lisphk 发表于 2019-1-6 02:11


谢谢，原来大神都喜欢熬夜
来自: 微社区

Lisphk

ffian 发表于 2019-1-6 02:16
[quote]Lisphk 发表于 2019-1-6 02:11

1. ((= len 1)
   
2.                    (if (> (ascii (substr str1 1 1)) 159)
   
3.                      (progn (setq name (cons 1000 str1))
   
4.                             (setq num (cons 1000 ""))
   
5.                      )
   
6.                      (progn (setq name "") (setq num (cons 1000 str1)))
   
7.                    )
   
8. )
   

((= len 1)<br />                    (if (> (ascii (substr str1 1 1)) 159)<br />                      (progn (setq name (cons 1000 str1))<br />                             (setq num (cons 1000 ""))<br />                      )<br />                      (progn (setq name "") (setq num (cons 1000 str1)))<br />                    )<br /> )<br />

看代码，len>=2的都给你录了， len=1的，也就是指找到一个文字的，也给你录了
那你没录到的，是没文字的了？ 你想找出什么有问题的？

ffian

改变权属线颜色如何编写，有相关函数吗，或者扩展属性里有颜色选项m或者简单点多段线颜色如和修改通过liap
来自: 微社区

ffian

[quote]Lisphk 发表于 2019-1-6 02:20
看代码，len

就是这种没有文字的可以直接通过改变颜色等其他方法让他直接显示出来或者标识出来吗，在300个权属线里很难找到这23个
来自: 微社区

ffian

[quote]Lisphk 发表于 2019-1-6 02:20
看代码，len

一个宗地可以没有名字、但是不能没有号码，所以我要找到这些没有录入的权属线，把宗地编码加上，在实际使用过程中，会出现有名字和宗地号两个文字同时存在也无法录入的情况。我找不到原因
来自: 微社区

ffian

ffian 发表于 2019-1-6 02:33
[quote]Lisphk 发表于 2019-1-6 02:20
看代码，len

最近感觉对于这论坛真的是相见恨晚呀，在这里收获很多
来自: 微社区

ffian

这个插件其实已经满足了我的要求，达到了一定的容错率，程序办不到的可以人为，可是找这剩下的23个空信息权属线也挺耗时间的
来自: 微社区

marting

ffian 发表于 2019-1-6 02:41
这个插件其实已经满足了我的要求，达到了一定的容错率，程序办不到的可以人为，可是找这剩下的23个空信息权 ...

没有文字的线，给你变成红色，放到 “待核查”图层

1. (defun c:zd (/ elist i name num pts qs s1 s2 ss ss0 str1 str2 x xdata)
   
2.   (setvar "pickstyle" 0)
   
3.   (if (and (setq ss0 (ssget '((0 . "LWPOLYLINE")))) (setq i -1))
   
4.     (while (setq qs (ssname ss0 (setq i (1+ i))))
   
5.       (progn
   
6.         (setq elist (entget qs '("*"))
   
7.               elist (vl-remove (assoc -3 elist) elist)
   
8.               pts   (mapcar
   
9.                       'cdr
   
10.                       (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget qs))
    
11.                     )
    
12.         )
    
13.         (if (setq ss (ssget "cp" pts '((0 . "text"))))
    
14.           (progn
    
15.             (setq len (sslength ss))
    
16.             (setq s1   (ssname ss 0)
    
17.                   str1 (cdr (assoc 1 (entget s1)))
    
18.             )
    
19.             (cond ((>= len 2)
    
20.                    (setq s2   (ssname ss 1)
    
21.                          str2 (cdr (assoc 1 (entget s2)))
    
22.                    )
    
23.                    (if (> (ascii (substr str1 1 1)) 159)
    
24.                      (progn (setq name (cons 1000 str1))
    
25.                             (setq num (cons 1000 str2))
    
26.                      )
    
27.                      (progn (setq name (cons 1000 str2))
    
28.                             (setq num (cons 1000 str1))
    
29.                      )
    
30.                    )
    
31.                   )
    
32.                   ((= len 1)
    
33.                    (if (> (ascii (substr str1 1 1)) 159)
    
34.                      (progn (setq name (cons 1000 str1))
    
35.                             (setq num (cons 1000 ""))
    
36.                      )
    
37.                      (progn (setq name "") (setq num (cons 1000 str1)))
    
38.                    )
    
39.                   )
    
40.             )
    
41.             (regapp "SOUTH")
    
42.             (setq xdata        (list -3
    
43.                               (list "SOUTH"
    
44.                                     (cons 1000 "300000")
    
45.                                     num
    
46.                                     name
    
47.                                     (cons 1000 "072")
    
48.                               )
    
49.                         )
    
50.             )
    
51.             (entmod (append elist (list xdata)))
    
52.           )
    
53.           (progn
    
54.             (vla-Add (vla-get-Layers
    
55.                        (vla-get-activedocument (vlax-get-acad-object))
    
56.                      )
    
57.                      "待核查"
    
58.             )
    
59.             (vla-put-color (vlax-ename->vla-object qs) 1)
    
60.             (vla-put-layer (vlax-ename->vla-object qs) "待核查")
    
61.           )
    
62.         )
    
63.       )
    
64.     )
    
65.   )
    
66.   (setvar "pickstyle" 1)
    
67.   (princ)
    
68. )
    
69. 
    

(defun c:zd (/ elist i name num pts qs s1 s2 ss ss0 str1 str2 x xdata)<br />   (setvar "pickstyle" 0)<br />   (if (and (setq ss0 (ssget '((0 . "LWPOLYLINE")))) (setq i -1))<br />     (while (setq qs (ssname ss0 (setq i (1+ i))))<br />       (progn<br />         (setq elist (entget qs '("*"))<br />               elist (vl-remove (assoc -3 elist) elist)<br />               pts   (mapcar<br />                       'cdr<br />                       (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget qs))<br />                     )<br />         )<br />         (if (setq ss (ssget "cp" pts '((0 . "text"))))<br />           (progn<br />             (setq len (sslength ss))<br />             (setq s1   (ssname ss 0)<br />                   str1 (cdr (assoc 1 (entget s1)))<br />             )<br />             (cond ((>= len 2)<br />                    (setq s2   (ssname ss 1)<br />                          str2 (cdr (assoc 1 (entget s2)))<br />                    )<br />                    (if (> (ascii (substr str1 1 1)) 159)<br />                      (progn (setq name (cons 1000 str1))<br />                             (setq num (cons 1000 str2))<br />                      )<br />                      (progn (setq name (cons 1000 str2))<br />                             (setq num (cons 1000 str1))<br />                      )<br />                    )<br />                   )<br />                   ((= len 1)<br />                    (if (> (ascii (substr str1 1 1)) 159)<br />                      (progn (setq name (cons 1000 str1))<br />                             (setq num (cons 1000 ""))<br />                      )<br />                      (progn (setq name "") (setq num (cons 1000 str1)))<br />                    )<br />                   )<br />             )<br />             (regapp "SOUTH")<br />             (setq xdata        (list -3<br />                               (list "SOUTH"<br />                                     (cons 1000 "300000")<br />                                     num<br />                                     name<br />                                     (cons 1000 "072")<br />                               )<br />                         )<br />             )<br />             (entmod (append elist (list xdata)))<br />           )<br />           (progn<br />             (vla-Add (vla-get-Layers<br />                        (vla-get-activedocument (vlax-get-acad-object))<br />                      )<br />                      "待核查"<br />             )<br />             (vla-put-color (vlax-ename->vla-object qs) 1)<br />             (vla-put-layer (vlax-ename->vla-object qs) "待核查")<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (setvar "pickstyle" 1)<br />   (princ)<br /> )<br /> <br />

ffian

marting 发表于 2019-1-6 04:05
没有文字的线，给你变成红色，放到 “待核查”图层

谢谢真得很感谢你
来自: 微社区