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

任得强 · 发表于 2013-12-6 13:46:10

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

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

zyhandw · 发表于 2013-12-6 14:11:07

直接上附件得了

newer · 发表于 2013-12-6 14:20:54

信息提供的不够。

st788796 · 发表于 2013-12-6 15:01:14

把dwg发上来

任得强 · 发表于 2013-12-6 15:07:42

谢谢老师:)

阿斯大是大非 · 发表于 2013-12-6 16:12:21

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

aa-909 · 发表于 2013-12-6 17:46:43

可以帮你写QQ：599017495

st788796 · 发表于 2013-12-6 20:51:48

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

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

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

Free-Lancer · 发表于 2013-12-7 00:38:26

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

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

q3_2006 · 发表于 2013-12-7 05:52:00

(defun c:tt ( / elist i name num pts qs s1 s2 ss ss0 str1 str2 x xdata)
(setvar "pickstyle" 0)
(if (and (setq ss0 (ssget '((0 . "LWPOLYLINE"))))
(setq i -1)
)
(while (setq qs (ssname ss0 (setq i (1+ i))))
(progn
(setq elist (entget qs '("*"))
elist (vl-remove (assoc -3 elist) elist)
pts (mapcar
'cdr
(vl-remove-if '(lambda (x)
(/= (car x) 10)
) (entget qs)
)
)
ss (ssget "cp" pts '((0 . "text")))
s1 (ssname ss 0)
s2 (ssname ss 1)
str1 (cdr (assoc 1 (entget s1)))
str2 (cdr (assoc 1 (entget s2)))
)
(if (> (ascii (substr str1 1 1)) 159)
(progn
(setq name (cons 1000 (cdr (assoc 1 (entget s1)))))
(setq num (cons 1000 (cdr (assoc 1 (entget s2)))))
)
(progn
(setq name (cons 1000 (cdr (assoc 1 (entget s2)))))
(setq num (cons 1000 (cdr (assoc 1 (entget s1)))))
)
)
(regapp "SOUTH")
(setq xdata (list -3 (list "SOUTH" (cons 1000 "300000") num name
(cons 1000 "072")
)
)
)
(entmod (append
elist
(list xdata)
)
)
)
)
)
(setvar "pickstyle" 1)
)

(defun c:tt ( / elist i name num pts qs s1 s2 ss ss0 str1 str2 x xdata) 
  (setvar "pickstyle" 0) 
  (if (and (setq ss0 (ssget '((0 . "LWPOLYLINE")))) 
  (setq i -1) 
  ) 
  (while (setq qs (ssname ss0 (setq i (1+ i)))) 
    (progn 
      (setq elist (entget qs '("*")) 
      elist (vl-remove (assoc -3 elist) elist) 
      pts (mapcar 
      'cdr 
      (vl-remove-if '(lambda (x) 
           (/= (car x) 10) 
         ) (entget qs) 
      ) 
    ) 
      ss (ssget "cp" pts '((0 . "text"))) 
      s1 (ssname ss 0) 
      s2 (ssname ss 1) 
      str1 (cdr (assoc 1 (entget s1))) 
      str2 (cdr (assoc 1 (entget s2))) 
      ) 
      (if (> (ascii (substr str1 1 1)) 159) 
  (progn 
    (setq name (cons 1000 (cdr (assoc 1 (entget s1))))) 
    (setq num (cons 1000 (cdr (assoc 1 (entget s2))))) 
  ) 
  (progn 
    (setq name (cons 1000 (cdr (assoc 1 (entget s2))))) 
    (setq num (cons 1000 (cdr (assoc 1 (entget s1))))) 
  ) 
      ) 
 
      (regapp "SOUTH") 
      (setq xdata (list -3 (list "SOUTH" (cons 1000 "300000") num name 
         (cons 1000 "072") 
         ) 
      ) 
      ) 
      (entmod (append 
    elist 
    (list xdata) 
        ) 
      ) 
    ) 
  ) 
  ) 
  (setvar "pickstyle" 1) 
)

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

st788796 · 发表于 2013-12-7 07:32:15

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

任得强 · 发表于 2013-12-7 12:22:53

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

nowave2004 · 发表于 2014-8-11 08:27:56

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

你咋个解决的，说下吧

账号		自动登录	找回密码
密码			立即注册

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

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

点评