哪位老师帮我写一个关于权属线赋值的插件

任得强

大概意思是根据图面的人名《（张三，单独的一个人名层）》，《（宗地编号纯数字，00001），单独的一个宗地编号层》，
在图面选取一个人名或者宗地号会自动历遍所有的人名或者宗地号赋值到对应的权属线

zyhandw

直接上附件得了

newer

信息提供的不够。

st788796

把dwg发上来

任得强

谢谢老师:)

阿斯大是大非

悬赏20000元征集最美乡村设计方案，入选湖北最美，再加十万奖金 电话13997507337    http://task.zhubajie.com/3444863

aa-909

可以帮你写QQ：599017495

st788796

这个 XDATA 没有 1002, 用 xdrx_xdata_set 会多出 1002 组码，另外这个替换也是特定位置替换

1. (defun c:tt (/ ss pl box)
   
2.   (if (setq ss (ssget '((0 . "LWPOLYLINE") (8 . "JZD")))) ;_pline
   
3.     (progn
   
4.       (setq
   
5.         pl (mapcar '(lambda (x)
   
6.                       (list (xdrx_getpropertyvalue x "Vertices") x)
   
7.                     )
   
8.                    (xdrx_pickset->ents ss)
   
9.            )
   
10.       )
    
11.       (setq box (xdrx_entity_box ss))
    
12.       (if (apply 'xdrx_document_isptoutscreen box)
    
13.         (xdrx_document_zoomw (car box) (caddr box))
    
14.       )
    
15.       (XD::Doc:DisableOsmode)
    
16.       (mapcar
    
17.         '(lambda (x / s str el xdata nxdata)
    
18.            (if
    
19.              (setq s (ssget "CP" (car x) '((0 . "text") (8 . "图层1")))) ;_text
    
20.               (progn
    
21.                 (setq
    
22.                   str (xdrx_getpropertyvalue (ssname s 0) "Textstring")
    
23.                 )
    
24.                 (setq el     (entget (cadr x) '("*"))
    
25.                       xdata  (cdadr (assoc -3 el))
    
26.                       nxdata (XD::List:Insert
    
27.                                (XD::List:RemoveN xdata 3)
    
28.                                2
    
29.                                (cons 1000 str)
    
30.                              )
    
31.                 )
    
32.                 (entmod        (subst (list -3 (cons "SOUTH" nxdata))
    
33.                                (assoc -3 el)
    
34.                                el
    
35.                         )
    
36.                 )
    
37.               )
    
38.            )
    
39.          )
    
40.         pl
    
41.       )
    
42.       (XD::Doc:EnableOsmode)
    
43.     )
    
44.   )
    
45.   (princ)
    
46. )

(defun c:tt (/ ss pl box)<br />   (if (setq ss (ssget '((0 . "LWPOLYLINE") (8 . "JZD")))) ;_pline<br />     (progn<br />       (setq<br />         pl (mapcar '(lambda (x)<br />                       (list (xdrx_getpropertyvalue x "Vertices") x)<br />                     )<br />                    (xdrx_pickset->ents ss)<br />            )<br />       )<br />       (setq box (xdrx_entity_box ss))<br />       (if (apply 'xdrx_document_isptoutscreen box)<br />         (xdrx_document_zoomw (car box) (caddr box))<br />       )<br />       (XD::Doc:DisableOsmode)<br />       (mapcar<br />         '(lambda (x / s str el xdata nxdata)<br />            (if<br />              (setq s (ssget "CP" (car x) '((0 . "text") (8 . "图层1")))) ;_text<br />               (progn<br />                 (setq<br />                   str (xdrx_getpropertyvalue (ssname s 0) "Textstring")<br />                 )<br />                 (setq el     (entget (cadr x) '("*"))<br />                       xdata  (cdadr (assoc -3 el))<br />                       nxdata (XD::List:Insert<br />                                (XD::List:RemoveN xdata 3)<br />                                2<br />                                (cons 1000 str)<br />                              )<br />                 )<br />                 (entmod        (subst (list -3 (cons "SOUTH" nxdata))<br />                                (assoc -3 el)<br />                                el<br />                         )<br />                 )<br />               )<br />            )<br />          )<br />         pl<br />       )<br />       (XD::Doc:EnableOsmode)<br />     )<br />   )<br />   (princ)<br /> )

Free-Lancer

1. (defun c:tt (/ pss i e el xd data pts tss txt ndata)
   
2.   (if (setq pss (ssget '((0 . "LWPOLYLINE") (8 . "ZJD") (-3 ("SOUTH")))))
   
3.     (progn
   
4.       (setq i -1)
   
5.       (setvar "osmode" (logior (getvar "osmode") 16384));_临时关闭捕捉
   
6.       (repeat (sslength pss)
   
7.         (setq e           (ssname pss (setq i (1+ i)))
   
8.               el   (entget e '("*"))
   
9.               xd   (assoc -3 el)
   
10.               data (cdadr xd)
    
11.               pts  (mapcar 'cdr
    
12.                            (vl-remove-if-not '(lambda (x) (= (car x) 10)) el)
    
13.                    )
    
14.         )
    
15.         (if (setq tss (ssget "CP" '((0 . "Text") (8 . "人名"))));_自己修改图层名
    
16.           (progn
    
17.             (setq txt        (cdr (assoc 1 (entget (ssname tss 0))));_这个也许会选到两个及以上
    
18.                   ndata        (list (car data)
    
19.                               (cadr data)
    
20.                               (cons 1000 txt)
    
21.                               (last data)
    
22.                         ) ;_仅有四个属性，且修改第三个
    
23.             )
    
24.             (entmod (subst (list -3 (cons "SOUTH" ndata))
    
25.                            xd
    
26.                            el
    
27.                     )
    
28.             )
    
29.           )
    
30.         )
    
31.       )
    
32.     )
    
33.   )
    
34.   (princ)
    
35. )
    

(defun c:tt (/ pss i e el xd data pts tss txt ndata)<br />   (if (setq pss (ssget '((0 . "LWPOLYLINE") (8 . "ZJD") (-3 ("SOUTH")))))<br />     (progn<br />       (setq i -1)<br />       (setvar "osmode" (logior (getvar "osmode") 16384));_临时关闭捕捉<br />       (repeat (sslength pss)<br />         (setq e           (ssname pss (setq i (1+ i)))<br />               el   (entget e '("*"))<br />               xd   (assoc -3 el)<br />               data (cdadr xd)<br />               pts  (mapcar 'cdr<br />                            (vl-remove-if-not '(lambda (x) (= (car x) 10)) el)<br />                    )<br />         )<br />         (if (setq tss (ssget "CP" '((0 . "Text") (8 . "人名"))));_自己修改图层名<br />           (progn<br />             (setq txt        (cdr (assoc 1 (entget (ssname tss 0))));_这个也许会选到两个及以上<br />                   ndata        (list (car data)<br />                               (cadr data)<br />                               (cons 1000 txt)<br />                               (last data)<br />                         ) ;_仅有四个属性，且修改第三个<br />             )<br />             (entmod (subst (list -3 (cons "SOUTH" ndata))<br />                            xd<br />                            el<br />                     )<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

q3_2006

2. (defun c:tt ( / elist i name num pts qs s1 s2 ss ss0 str1 str2 x xdata)
   
3.   (setvar "pickstyle" 0)
   
4.   (if (and (setq ss0 (ssget '((0 . "LWPOLYLINE"))))
   
5.   (setq i -1)
   
6.   )
   
7.   (while (setq qs (ssname ss0 (setq i (1+ i))))
   
8.     (progn
   
9.       (setq elist (entget qs '("*"))
   
10.       elist (vl-remove (assoc -3 elist) elist)
    
11.       pts (mapcar
    
12.       'cdr
    
13.       (vl-remove-if '(lambda (x)
    
14.            (/= (car x) 10)
    
15.          ) (entget qs)
    
16.       )
    
17.     )
    
18.       ss (ssget "cp" pts '((0 . "text")))
    
19.       s1 (ssname ss 0)
    
20.       s2 (ssname ss 1)
    
21.       str1 (cdr (assoc 1 (entget s1)))
    
22.       str2 (cdr (assoc 1 (entget s2)))
    
23.       )
    
24.       (if (> (ascii (substr str1 1 1)) 159)
    
25.   (progn
    
26.     (setq name (cons 1000 (cdr (assoc 1 (entget s1)))))
    
27.     (setq num (cons 1000 (cdr (assoc 1 (entget s2)))))
    
28.   )
    
29.   (progn
    
30.     (setq name (cons 1000 (cdr (assoc 1 (entget s2)))))
    
31.     (setq num (cons 1000 (cdr (assoc 1 (entget s1)))))
    
32.   )
    
33.       )
    
34. 
    
35.       (regapp "SOUTH")
    
36.       (setq xdata (list -3 (list "SOUTH" (cons 1000 "300000") num name
    
37.          (cons 1000 "072")
    
38.          )
    
39.       )
    
40.       )
    
41.       (entmod (append
    
42.     elist
    
43.     (list xdata)
    
44.         )
    
45.       )
    
46.     )
    
47.   )
    
48.   )
    
49.   (setvar "pickstyle" 1)
    
50. )

(defun c:tt ( / 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"))))<br />   (setq i -1)<br />   )<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)<br />            (/= (car x) 10)<br />          ) (entget qs)<br />       )<br />     )<br />       ss (ssget "cp" pts '((0 . "text")))<br />       s1 (ssname ss 0)<br />       s2 (ssname ss 1)<br />       str1 (cdr (assoc 1 (entget s1)))<br />       str2 (cdr (assoc 1 (entget s2)))<br />       )<br />       (if (> (ascii (substr str1 1 1)) 159)<br />   (progn<br />     (setq name (cons 1000 (cdr (assoc 1 (entget s1)))))<br />     (setq num (cons 1000 (cdr (assoc 1 (entget s2)))))<br />   )<br />   (progn<br />     (setq name (cons 1000 (cdr (assoc 1 (entget s2)))))<br />     (setq num (cons 1000 (cdr (assoc 1 (entget s1)))))<br />   )<br />       )<br /> <br />       (regapp "SOUTH")<br />       (setq xdata (list -3 (list "SOUTH" (cons 1000 "300000") num name<br />          (cons 1000 "072")<br />          )<br />       )<br />       )<br />       (entmod (append<br />     elist<br />     (list xdata)<br />         )<br />       )<br />     )<br />   )<br />   )<br />   (setvar "pickstyle" 1)<br /> )

两位大师都出手了,虽然昨天在Q群已经帮他解决了,还是在这里回复一下吧...

st788796

这个用CP选text可能有问题，既然文字可能压线，那是不是可能压相邻的线？这只有楼主知道有没有这种情况了
另外测试图中(1000 . "30000") (1000 . "072")这两个不一定全一样吧，所以car last可能更好

任得强

先谢谢几位老师了问题解决了。非常感谢(1000 . "30000") (1000 . "072")这两个组码是固定不变的

nowave2004

任得强 发表于 2013-12-7 12:22
先谢谢几位老师了问题解决了。非常感谢(1000 . "30000") (1000 . "072")这两个组码是固定不变的

你咋个解决的，说下吧