明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 12038|回复: 4

CASS宗地属性修改示例

[复制链接]
发表于 2008-7-1 11:33 | 显示全部楼层 |阅读模式
本帖最后由 作者 于 2008-7-1 11:33:53 编辑
  1. (vl-load-com)
  2. ;; 条目名称 SOUTHDIJI
  3. ;; 选择宗地界址线
  4. (defun c:bak ()
  5.   ;; 获得JZD层上的闭合线选择集,必须带有扩展数据("SOUTH" (1000 . "300000"))。
  6.   (setq ss    (ssget "x" '((0 . "*LINE") (8 . "JZD") (-4 . "&=") (70 . 1) (-3 ("SOUTH" (1000 . "300000")))))
  7. Index 0
  8.   )
  9.   (repeat (if ss
  10.      (sslength ss)
  11.      0
  12.    )
  13.     (setq Ename        (ssname ss Index)
  14.    Index        (1+ Index)
  15.    Edata        (entget Ename '("SOUTH"))
  16.    ;; 找出对象所指向的词典。
  17.    ;;“{ACAD_XDICTIONARY”表示扩展词典组的起点。
  18.    Edata360     (cdr (member '(102 . "{ACAD_XDICTIONARY") Edata))
  19.    XrEnameSouth nil
  20.     )
  21.     (if Edata360
  22.       (progn
  23. ;; 360 所有者词典的硬所有者 ID/句柄。
  24. ;; 在此不考虑出现多个360的情况,感觉这种情况不应该存在。
  25. (setq DEname    (cdr (assoc '360 Edata360)) ;_词典对象。
  26.        DEdata    (entget DEname) ;_词典数据。
  27.        ;;条目名称SOUTHDIJI所对应的XRECORD对象
  28.        XrEnameSouth (cdr (assoc '360 (cdr (member '(3 . "SOUTHDIJI") DEdata))))
  29. )
  30.       )
  31.     )
  32.     (if XrEnameSouth
  33.       (progn
  34. (setq XrObj (vlax-ename->vla-object XrEnameSouth))
  35. (vla-getxrecorddata XrObj 'Ty 'Data)
  36. (vlax-safearray-put-element Data 0 "区号100")
  37. (vlax-safearray-put-element Data 1 "区号100")
  38. (vlax-safearray-put-element Data 2 "区号100")
  39. (vla-setxrecorddata XrObj (vlax-make-variant Ty) (vlax-make-variant Data))
  40. (vlax-release-object XrObj)
  41.       )
  42.       (progn
  43. ;; 没有对应的词典,找不到宗地属。
  44. (princ (strcat "\\n句柄:[" (cdr (assoc '5 Edata)) "]所指的对象没有宗地属性。"))
  45.       )
  46.     )
  47.   )
  48.   (princ)
  49. )
  50. (princ)
相关资料《提取CASS宗地属性的代码》
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=62482&replyID=&skin=1

本帖被以下淘专辑推荐:

发表于 2015-12-9 14:43 | 显示全部楼层
正好需要,收下了,谢谢!
发表于 2016-6-5 21:53 | 显示全部楼层
我去 原来这里有呀  我当时好的头疼自己写了个....
发表于 2019-3-15 20:26 | 显示全部楼层
本帖最后由 wkq004 于 2019-3-15 20:38 编辑

只是将原代码格式化了一下,着色方便阅读
  1. (vl-load-com)
  2. ;; 条目名称 SOUTHDIJI
  3. ;; 选择宗地界址线
  4. (defun c:bak ()
  5.   ;; 获得JZD层上的闭合线选择集,必须带有扩展数据("SOUTH" (1000 . "300000"))。
  6.   (setq ss    (ssget "x" '((0 . "*LINE") (8 . "JZD") (-4 . "&=") (70 . 1) (-3 ("SOUTH" (1000 . "300000"))))) Index 0)
  7.   (repeat (if ss (sslength ss) 0)
  8.     (setq Ename        (ssname ss Index)
  9.           Index        (1+ Index)
  10.           Edata        (entget Ename '("SOUTH"))
  11.           ;; 找出对象所指向的词典。
  12.           ;;“{ACAD_XDICTIONARY”表示扩展词典组的起点。
  13.           Edata360     (cdr (member '(102 . "{ACAD_XDICTIONARY") Edata))
  14.           XrEnameSouth nil     )
  15.     (if Edata360
  16.       (progn
  17.         ;; 360 所有者词典的硬所有者 ID/句柄。
  18.         ;; 在此不考虑出现多个360的情况,感觉这种情况不应该存在。
  19.         (setq DEname    (cdr (assoc '360 Edata360)) ;_词典对象。
  20.               DEdata    (entget DEname) ;_词典数据。
  21.               ;;条目名称SOUTHDIJI所对应的XRECORD对象
  22.               XrEnameSouth (cdr (assoc '360 (cdr (member '(3 . "SOUTHDIJI") DEdata)))))))
  23.     (if XrEnameSouth
  24.       (progn
  25.         (setq XrObj (vlax-ename->vla-object XrEnameSouth))
  26.         (vla-getxrecorddata XrObj 'Ty 'Data)
  27.         (vlax-safearray-put-element Data 0 "区号100")
  28.         (vlax-safearray-put-element Data 1 "区号100")
  29.         (vlax-safearray-put-element Data 2 "区号100")
  30.         (vla-setxrecorddata XrObj (vlax-make-variant Ty) (vlax-make-variant Data))
  31.         (vlax-release-object XrObj)
  32.         )
  33.       (progn
  34.         ;; 没有对应的词典,找不到宗地属。
  35.         (princ (strcat "\\n句柄:[" (cdr (assoc '5 Edata)) "]所指的对象没有宗地属性。"))
  36.         )
  37.       )
  38.     )
  39.   (princ)
  40.   )
  41. (princ)
发表于 2020-12-20 23:45 | 显示全部楼层
CASS9.1的界址线数据里已经没有 (102 . "{ACAD_XDICTIONARY") 了。数据又是存在哪里去了呢?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-4-19 11:04 , Processed in 0.274578 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表