哪位大神帮忙调试一个赋值宗地号到权属线扩展属性的方法

nowave2004

具体描述，现在有cad，每个地块中央都有一个宗地号注记，想把这个注记文字赋值到 权属线（封闭线段）的扩展属性上面。
由于是帮朋友弄，自己学了一个周末，还是没搞定，求大神帮忙调试下，
我目前的思路是：
先点选 注记，再点选 权属线，然后赋值过去。

开始的想法是想直接批量处理，调试程序太难了，而且很多语法，和 数据类型怪怪的，
暂时没搞清楚怎么处理，
有人比较懂的lisp的高手，也可以留 个qq，能帮我解决下语言方面的问题也行，
谢谢了。


(defun C:TT (/ zdh ss)
   (vl-load-com)
   (setq zdh(showlayer (car (entsel "\n注意选择宗地号标注点: "))))
   (princ zdh)
   (setLineValue (car (entsel "\n注意选择权属线: ")) zdh)
     
)
   
;再选择一个线，去赋值属性
(defun setLineValue(lineObj zdhVal / layername)
    (princ (strcat "开始处理：" zdhVal))
    (if(= (type lineObj) 'ENAME) ;判断是不是ename实体
      (progn ( setq lineObj (vlax-ename->vla-object lineObj)) ;转换为vla对象
            (vlax-dump-object lineObj t)
            ;  TextString = "080073"
            (setq layername(vla-get-layer lineObj)) ;图层名称
     (princ layername)
     (if (= layername "0")
         (progn (princ "111")
     ( );这里想实现，写入扩展属性：ZDH 这个扩展属性
   )
         (princ "必须选择图层（0）的线段Polyline")
     )
      )
      ( alert  "选择的不是ename对象" )
   )
)
(defun showlayer(ent / zdh zdhlayername zhdxyz zhdxyzArray)
   (setq zdh "")
   (if(= (type ent) 'ENAME) ;判断是不是ename实体
      (progn ( setq ent (vlax-ename->vla-object ent)) ;转换为vla对象
            (vlax-dump-object ent t)
            ;  TextString = "080073"
            (setq  zdh(vla-get-TextString ent )) ;取得宗地号
            (setq zdhlayername(vla-get-layer ent)) ;图层名称
     (setq zhdxyz(vla-get-InsertionPoint ent));指定公差、文字、块或形的插入点
            ;(alert zdhlayername)
     (princ (= zdhlayername "编号"))
      )
      ( alert  "选择的不是ename对象" )
   )
   (if(= zdhlayername "编号")   
      (progn
  (setq cc "赋值成功！")
  ;(setq zhdxyzArray(vlax-safearray->list (vlax-variant-value zhdxyz)))
      )
      (progn
  (setq zdh "")
  (setq cc "赋值失败：需要选择图层为（编号）的上面的编号注记")
      )
   )
   zdh  ;返回值
)

nowave2004

这里附上，需要操作的文件

XDSoft

你要批量做，还是点一个文字，点一个多段线操作一次。

XDSoft

看你程序用了ENTSEL，想你是要单独的一个一个的操作，但是这样效率太慢了，完全可以窗口选一次，然后批量一次性完成。

nowave2004

XDSoft 发表于 2014-8-11 16:27
你要批量做，还是点一个文字，点一个多段线操作一次。

本来想批量做的，但是感觉没思路，
只有点搞个最傻瓜化的，先选注记，取回值，再选线，给线赋上值，
你有啥批量的方法，线 和 注记 在不同的图层上，

newer

nowave2004 发表于 2014-8-11 16:35
本来想批量做的，但是感觉没思路，
只有点搞个最傻瓜化的，先选注记，取回值，再选线，给线赋上值，
你 ...

看了你的图，首先绘图习惯不好，封闭的宗地界线都在0层，应该在一个特定层上。

思路应该很简单，选择所有的宗地界线，然后遍历循环，选取封闭线内的编号，然后把编号写到宗地线的扩展实体数据上。

nowave2004

newer 发表于 2014-8-11 16:45
看了你的图，首先绘图习惯不好，封闭的宗地界线都在0层，应该在一个特定层上。

思路应该很简单，选择 ...

我初学lisp，现在有问题的地方：
1：不知道 怎么读取 和写入扩展数据，
只是用getxdata，大致了解了一个type  和 value的结构，
但是怎么读出来，然后修改完成后，怎么写回去，写回去的操作还没搞清楚，
没找到资料。

还就是getxdata，读出来的结构好像和entget 读出来的有区别。

2：感觉调试数组操作，比较困难，
还就是选取多个对象的时候，用ssget 对吧，这个用起来也比较迷糊

你能不能帮忙提供一个读取扩展属性，修改后，又赋值回去的例子。

newer

nowave2004 发表于 2014-8-11 17:09
我初学lisp，现在有问题的地方：
1：不知道 怎么读取 和写入扩展数据，
只是用getxdata，大致了解了一 ...

下面用XDRX_API写了个工具，需要加载XDRX_API和晓东通用LISP函数库。
程序会把你选择的宗地界限批量加上编号扩展属性，成功的线颜色变蓝色。

1. (defun c:tt2()
   
2.    (prompt "\n选取要添加编号的宗地界限<退出>:")
   
3.    (if (setq ss (ssget '((8 . "0")(62 . 1)(-4 . "&=")(70 . 1))))
   
4.      (progn
   
5.         (xdrx_begin)
   
6.         (xdrx_document_zoome)
   
7.         (setq len (sslength ss) num 0)
   
8.         (xdrx_setsstodb ss 0)
   
9.         (while (setq e (xdrx_getentdata 0))
   
10.            (if (and (setq pts (xdrx_getpropertyvalue e "Vertices"))
    
11.                     (> (length pts) 2)
    
12.                     (setq ss1 (ssget "cp" pts '((8 . "编号")(0 . "TEXT"))))
    
13.                )
    
14.               (progn
    
15.                 (xdrx_xdata_set e "ZDH" (xdrx_getpropertyvalue (ssname ss1 0) "TEXTSTRING"))
    
16.                 (setq num (1+ num))
    
17.                 (xdrx_setpropertyvalue e "color" 5)
    
18.               )
    
19.            )
    
20.          )
    
21.          (princ (strcat "\n找到" (itoa len) "宗地界线.设置了" (itoa num) "条宗地编号。"))
    
22.          (xdrx_end)
    
23.      )
    
24.      (princ "\n没发现宗地界线")
    
25.    )
    
26.    (princ)
    
27. )

(defun c:tt2()<br />    (prompt "\n选取要添加编号的宗地界限<退出>:")<br />    (if (setq ss (ssget '((8 . "0")(62 . 1)(-4 . "&=")(70 . 1))))<br />      (progn<br />         (xdrx_begin)<br />         (xdrx_document_zoome)<br />         (setq len (sslength ss) num 0)<br />         (xdrx_setsstodb ss 0)<br />         (while (setq e (xdrx_getentdata 0))<br />            (if (and (setq pts (xdrx_getpropertyvalue e "Vertices"))<br />                     (> (length pts) 2)<br />                     (setq ss1 (ssget "cp" pts '((8 . "编号")(0 . "TEXT"))))<br />                )<br />               (progn<br />                 (xdrx_xdata_set e "ZDH" (xdrx_getpropertyvalue (ssname ss1 0) "TEXTSTRING"))<br />                 (setq num (1+ num))<br />                 (xdrx_setpropertyvalue e "color" 5)<br />               )<br />            )<br />          )<br />          (princ (strcat "\n找到" (itoa len) "宗地界线.设置了" (itoa num) "条宗地编号。"))<br />          (xdrx_end)<br />      )<br />      (princ "\n没发现宗地界线")<br />    )<br />    (princ)<br /> )

nowave2004

newer 发表于 2014-8-11 18:06
下面用XDRX_API写了个工具，需要加载XDRX_API和晓东通用LISP函数库。
程序会把你选择的宗地界限批量加上 ...

非常，感觉，晚上试试，再回复结果，
太速度了，只是又调用了那么多，函数库里面的函数，
我看起，感觉又是晕呀

nowave2004

newer 发表于 2014-8-11 18:06
下面用XDRX_API写了个工具，需要加载XDRX_API和晓东通用LISP函数库。
程序会把你选择的宗地界限批量加上 ...

帅哥，现在又有个问题，你熟悉南方cass的：权属信息属性 存放的格式和位置不，
我是个门外汉呀，原来要写入的是权属信息里面的，宗地号属性，
能帮忙调整下不。

csharp

南方在xrecord

nowave2004

还没搞定求回复呀，南方cass的权属属性信息，能不能由直接没有，通过程序弄成有，
怎么写入南方cass的权属信息扩展属性，做了老是不正确

csharp

http://bbs.xdcad.net/forum.php?m ... d=671270&page=2

http://bbs.xdcad.net/forum.php?mod=viewthread&tid=671368

http://bbs.xdcad.net/forum.php?mod=viewthread&tid=671314

nowave2004

(defun c:tt2( / zdh south south1 zdh dilei)
   (vl-load-com)
   (prompt "\n选取要添加编号的宗地界限<退出>:")
   (if (setq ss (ssget '((0 . "*LINE"))))
     (progn
        (xdrx_begin)
        (xdrx_document_zoome)
        (setq len (sslength ss) num 0)
        (xdrx_setsstodb ss 0)
        (while (setq e (xdrx_getentdata 0))
   
           (if (and (setq pts (xdrx_getpropertyvalue e "Vertices"))
                    (> (length pts) 2)
                    (setq ss1 (ssget "cp" pts '((8 . "0")(0 . "TEXT"))))
               )
              (progn
  (print ss1)
  (setq zdh (xdrx_getpropertyvalue (ssname ss1 0) "TEXTSTRING"))
  (print zdh)
  ( setq lineObj (vlax-ename->vla-object e))
  (vlax-dump-object lineObj t)
  ;
                ;(xdrx_xdata_set e "ZDH" zdh)
  ;---------编辑宗地属性-----
         (setq txt (entget e (list "SOUTH")));txt 所有属性
  (print txt)
  (setq jzddata1 (assoc -3 txt));jzddata1 宗地属性节点
  (print jzddata1)
                ;------读取原有的编码，权利人，地类 数组
  (setq south (car (cdr jzddata1)))
  (print south)
  (setq south1 (cdr south)) ;south1  为4个对值 数组
  (print south1)
  ;(print length south)
    ;获取宗地编码
  (setq zdbianma(cdr (car south1 )))
                (print zdbianma)  
  (if zdbianma (setq zdbianma "300000")) ;没有值设置默认值
                ;获取权力人
  (setq qlr(cdr(car (cdr south1))))
  (print qlr)
  (if qlr (setq qlr ""));权力人默认设置空值
  ;获取地类
  (setq dilei (cdr (car (reverse (cdr south)))))
  (print dilei)
  (if dilei (setq dilei ""));地类人默认设置空值
  (setq jzddata5 (vl-list*  1000 zdbianma));编码
                (setq jzddata7 (vl-list*  1000 zdh));宗地号
  (setq zhjzdhaaa10 (vl-list*  1000 qlr));权利人
                (setq jzddata11 (vl-list*  1000 dilei));地类
  
                (setq zzkzxx (list jzddata5 jzddata7 zhjzdhaaa10 jzddata11))
                (setq zhjzdhaaa2 (vl-list* "SOUTH" zzkzxx))
  (setq zhjzdhaaa2 (list  zhjzdhaaa2))
  (setq zhjzdhaaa2 (vl-list* -3 zhjzdhaaa2))
  (setq zhjzdhaaa4 (subst zhjzdhaaa2 jzddata1 txt ))
  (entmod zhjzdhaaa4)
  ;---------编辑宗地属性------
                (setq num (1+ num))
                (xdrx_setpropertyvalue e "color" 5)
              )
           )
         )
         (princ (strcat "\n找到" (itoa len) "宗地界线.设置了" (itoa num) "条宗地编号。"))
         (xdrx_end)
     )
     (princ "\n没发现宗地界线")
   )
   (princ)
)
--------------------------------------------
结个贴，在上面的基础上做了修改，先把权属线的case的扩展属性读取出来，然后再读取到 宗地号，写回去。
代码就是上面的，lisp新手，东拼西凑总算是完成了这个小功能，感谢各位网友的帮助。
希望lisp这门语言能更开放，在网上的资料实在有限，经常都是动不动收费。。。。

张虎标

nowave2004 发表于 2014-8-19 14:55
(defun c:tt2( / zdh south south1 zdh dilei)
   (vl-load-com)
   (prompt "\n选取要添加编号的宗地界 ...

你好我非常需要这个lisp能帮忙传授一下吗？QQ704592716