社区 › AutoCAD与GIS测绘 › CASS宗地属性修改示例

lockmyeye 发表于 2008-7-1 11:33

CASS宗地属性修改示例

本帖最后由 作者 于 2008-7-1 11:33:53 编辑

(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
)
(repeat (if ss
   (sslength ss)
   0
   )
    (setq Ename      (ssname ss Index)
   Index      (1+ Index)
   Edata      (entget Ename '("SOUTH"))
   ;; 找出对象所指向的词典。
   ;;“{ACAD_XDICTIONARY”表示扩展词典组的起点。
   Edata360   (cdr (member '(102 . "{ACAD_XDICTIONARY") Edata))
   XrEnameSouth nil
    )
    (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))))
)
      )
    )
    (if XrEnameSouth
      (progn
(setq XrObj (vlax-ename->vla-object XrEnameSouth))
(vla-getxrecorddata XrObj 'Ty 'Data)
(vlax-safearray-put-element Data 0 "区号100")
(vlax-safearray-put-element Data 1 "区号100")
(vlax-safearray-put-element Data 2 "区号100")
(vla-setxrecorddata XrObj (vlax-make-variant Ty) (vlax-make-variant Data))
(vlax-release-object XrObj)
      )
      (progn
;; 没有对应的词典，找不到宗地属。
(princ (strcat "\\n句柄：[" (cdr (assoc '5 Edata)) "]所指的对象没有宗地属性。"))
      )
    )
)
(princ)
)

(princ)

相关资料《提取CASS宗地属性的代码》
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=62482&replyID=&skin=1

yhly555 发表于 2015-12-9 14:43

正好需要，收下了，谢谢！

479274135 发表于 2016-6-5 21:53

我去 原来这里有呀我当时好的头疼自己写了个....

wkq004 发表于 2019-3-15 20:26

本帖最后由 wkq004 于 2019-3-15 20:38 编辑

只是将原代码格式化了一下,着色方便阅读

(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)
(repeat (if ss (sslength ss) 0)
    (setq Ename      (ssname ss Index)
          Index      (1+ Index)
          Edata      (entget Ename '("SOUTH"))
          ;; 找出对象所指向的词典。
          ;;“{ACAD_XDICTIONARY”表示扩展词典组的起点。
          Edata360   (cdr (member '(102 . "{ACAD_XDICTIONARY") Edata))
          XrEnameSouth nil   )
    (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)))))))
    (if XrEnameSouth
      (progn
      (setq XrObj (vlax-ename->vla-object XrEnameSouth))
      (vla-getxrecorddata XrObj 'Ty 'Data)
      (vlax-safearray-put-element Data 0 "区号100")
      (vlax-safearray-put-element Data 1 "区号100")
      (vlax-safearray-put-element Data 2 "区号100")
      (vla-setxrecorddata XrObj (vlax-make-variant Ty) (vlax-make-variant Data))
      (vlax-release-object XrObj)
      )
      (progn
      ;; 没有对应的词典，找不到宗地属。
      (princ (strcat "\\n句柄：[" (cdr (assoc '5 Edata)) "]所指的对象没有宗地属性。"))
      )
      )
    )
(princ)
)
(princ)

caddog 发表于 2020-12-20 23:45

CASS9.1的界址线数据里已经没有 (102 . "{ACAD_XDICTIONARY") 了。数据又是存在哪里去了呢？

查看完整版本: CASS宗地属性修改示例