提取CASS宗地属性的代码

lockmyeye

这是在CASS5.0下提取宗地属性的源码。
在网上查了一查，都是一些手里捏着源码不发布的主，要么QQ联系，要么电话联系，呵呵，看来都不是什么善鸟，没法，自已写一段。

3. (vl-load-com)
4. ;; 条目名称 SOUTHDIJI
5. ;;选择宗地界址线
6. (defun c:bak ()
7.   ;; 获得JZD层上的闭合线选择集，必须带有扩展数据("SOUTH" (1000 . "300000"))。
8.   (setq ss    (ssget "x" '((0 . "*LINE") (8 . "JZD") (-4 . "&=") (70 . 1) (-3 ("SOUTH" (1000 . "300000")))))
9. Index 0
10.   ) ;_ End setq
11.   (repeat (if ss
12.      (sslength ss)
13.      0
14.    ) ;_ End if
15.     (setq Ename        (ssname ss Index)
16.    Index        (1+ Index)
17.    Edata        (entget Ename '("SOUTH"))
18.    ;; 找出对象所指向的词典。
19.    ;;“{ACAD_XDICTIONARY”表示扩展词典组的起点。
20.    Edata360     (cdr (member '(102 . "{ACAD_XDICTIONARY") Edata))
21.    XrEnameSouth nil
22.     ) ;_ End setq
23.     (if Edata360
24.       (progn
25. ;; 360 所有者词典的硬所有者 ID/句柄。
26. ;; 在此不考虑出现多个360的情况，感觉这种情况不应该存在。
27. (setq DEname    (cdr (assoc '360 Edata360)) ;_词典对象。
28.        DEdata    (entget DEname) ;_词典数据。
29.        ;;条目名称SOUTHDIJI所对应的XRECORD对象
30.        XrEnameSouth (cdr (assoc '360 (cdr (member '(3 . "SOUTHDIJI") DEdata))))
31. ) ;_ End setq
32.       ) ;_ End progn
33.     ) ;_ End if
34.     (if XrEnameSouth
35.       (progn
36. (setq XrEdataSouth (entget XrEnameSouth)
37.        XrEdataSouth (vl-remove-if-not (function (lambda (_Var) (= 1 (car _Var)))) XrEdataSouth)
38.        XrEdataSouth (mapcar (function (lambda (_Var) (strcat "\t" (cdr _Var)))) XrEdataSouth)
39.        DiJiData    (apply 'strcat XrEdataSouth)
40.        Xdata    (mapcar 'cdr (cdr (assoc "SOUTH" (cdr (assoc '-3 Edata)))))
41.        DiJiData    (strcat (nth 1 Xdata) "\t" (nth 2 Xdata) "\t" (nth 3 Xdata) DiJiData)
42. ) ;_ End setq
43. (princ (strcat DiJiData "\n"))
44. ;;(setq DiJiDataLst nil)
45. (setq DiJiDataLst (cons DiJiData DiJiDataLst))
46. ;;; (vlax-invoke-method (vlax-ename->vla-object XrEnameSouth) 'GetXRecordData 'XRecordDataType 'XRecordData)
47.       ) ;_ End progn
48.       (progn
49. ;; 没有对应的词典，找不到宗地属。
50. (princ (strcat "\n句柄：[" (cdr (assoc '5 Edata)) "]所指的对象没有宗地属性。"))
51.       ) ;_ End progn
52.     ) ;_ End if
53.   ) ;_ End repeat
54.   (princ)
55. ) ;_ End defun

(vl-load-com) ;; 条目名称 SOUTHDIJI ;;选择宗地界址线 (defun c:bak ()   ;; 获得JZD层上的闭合线选择集，必须带有扩展数据("SOUTH" (1000 . "300000"))。   (setq ss    (ssget "x" '((0 . "*LINE") (8 . "JZD") (-4 . "&=") (70 . 1) (-3 ("SOUTH" (1000 . "300000"))))) Index 0   ) ;_ End setq   (repeat (if ss      (sslength ss)      0    ) ;_ End if     (setq Ename        (ssname ss Index)    Index        (1+ Index)    Edata        (entget Ename '("SOUTH"))    ;; 找出对象所指向的词典。    ;;“{ACAD_XDICTIONARY”表示扩展词典组的起点。    Edata360     (cdr (member '(102 . "{ACAD_XDICTIONARY") Edata))    XrEnameSouth nil     ) ;_ End setq     (if Edata360       (progn ;; 360 所有者词典的硬所有者 ID/句柄。 ;; 在此不考虑出现多个360的情况，感觉这种情况不应该存在。 (setq DEname    (cdr (assoc '360 Edata360)) ;_词典对象。        DEdata    (entget DEname) ;_词典数据。        ;;条目名称SOUTHDIJI所对应的XRECORD对象        XrEnameSouth (cdr (assoc '360 (cdr (member '(3 . "SOUTHDIJI") DEdata)))) ) ;_ End setq       ) ;_ End progn     ) ;_ End if     (if XrEnameSouth       (progn (setq XrEdataSouth (entget XrEnameSouth)        XrEdataSouth (vl-remove-if-not (function (lambda (_Var) (= 1 (car _Var)))) XrEdataSouth)        XrEdataSouth (mapcar (function (lambda (_Var) (strcat "\t" (cdr _Var)))) XrEdataSouth)        DiJiData    (apply 'strcat XrEdataSouth)        Xdata    (mapcar 'cdr (cdr (assoc "SOUTH" (cdr (assoc '-3 Edata)))))        DiJiData    (strcat (nth 1 Xdata) "\t" (nth 2 Xdata) "\t" (nth 3 Xdata) DiJiData) ) ;_ End setq (princ (strcat DiJiData "\n")) ;;(setq DiJiDataLst nil) (setq DiJiDataLst (cons DiJiData DiJiDataLst)) ;;; (vlax-invoke-method (vlax-ename->vla-object XrEnameSouth) 'GetXRecordData 'XRecordDataType 'XRecordData)       ) ;_ End progn       (progn ;; 没有对应的词典，找不到宗地属。 (princ (strcat "\n句柄：[" (cdr (assoc '5 Edata)) "]所指的对象没有宗地属性。"))       ) ;_ End progn     ) ;_ End if   ) ;_ End repeat   (princ) ) ;_ End defun

刚刚写完，基本的功能已经有了，要用的自个修改吧。

zyhandw

强人！高手！羡慕 啊.....

yn_labor

好啊，找了好久终于找到了你

 

没搞过LISP哈。。。

 

有哪位好人接个VB的么，盼啊盼

虚子

CASS2008生成的宗地图无 （102 . "{ACAD_XDICTIONARY"）和(3 . "SOUTHDIJI")，汗啊，不知道这新版本到底把地籍XRECORD对象数据存哪去了，就是没找到

不过，经测试，在CASS56.0中保存的宗地数据格式也和CASS5.0相同，CASS7.0也不行，并且我的CASS2008是破解版，用的是CASS7.0内核，就是说从7.0开始宗地数据格式就开始改变了，求高人破解CASS2008的宗地属性的XRECORD对象数据的储存位置，我到现在还没找到，太苦B了，汗。。。。

虚子

顶，求CASS7.0宗地属性的XRECORD对象数据的储存位置，

虚子

汗，问题已经解决了，从别人的问题帖子里找到为啥我老找不到的原因。。

mycadstudy

大神，给译成C#吧，谢谢啦！

薰衣草-花语

觉得有点罗嗦

薰衣草-花语

(setq ss (ssget '((0 . "LWPOLYLINE")(8 . "JZD"))))
  (setq i 0)
  (setq n 1)
(repeat (sslength ss)
    (setq ssn (ssname ss i))
(SETQ QS (assoc -3 (entget ssn '("*"))))

582267365

看着咋那么复杂了