lockmyeye 发表于 2007-8-23 18:06:00

提取CASS宗地属性的代码

本帖最后由 作者 于 2007-8-23 18:07:53 编辑

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

(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 发表于 2009-10-19 14:35:00

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

yn_labor 发表于 2010-8-1 18:13:00

<p>好啊，找了好久终于找到了你</p>
<p>&nbsp;</p>
<p>没搞过LISP哈。。。</p>
<p>&nbsp;</p>
<p>有哪位好人接个VB的么，盼啊盼</p>

虚子 发表于 2012-4-19 23:03:08

本帖最后由 虚子 于 2012-4-19 23:27 编辑

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

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

虚子 发表于 2012-4-21 16:36:45

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

虚子 发表于 2012-4-22 21:00:58

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

mycadstudy 发表于 2014-10-9 16:58:20

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

薰衣草-花语 发表于 2014-10-9 18:36:31

觉得有点罗嗦

薰衣草-花语 发表于 2014-10-9 18:40:31

(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 发表于 2016-7-6 23:53:57

看着咋那么复杂了
页: [1]
查看完整版本: 提取CASS宗地属性的代码