大家看看有什么问题？

hwwrrbb

以前的能用，现在逐行执行也没错，但整体执行就出错。CAD14 12都试过了。

newer

你提供的信息太少了，至少让人家知道是做什么的，怎么做，怎么交互，到哪地方有什么错误，错误提示是什么啊。另外，你发在API技术支持，你的程序是API写的吗？

iLisp

大致看了看程序，用api写的，楼主是要对块定义内实体处理图层和颜色吧，这个写法用的是setsstodb 循环，现在流行集合加setpropertyvalue方式

st788796

这样试试

1. ;;功能把选择的块内所有实体包括嵌套块改到DX图层
   
2. (defun c:bch (/ ename bname ent layname olderr myerror)
   
3.   (defun en-bl (bname layname / bt blkdef ents bts)
   
4.     (if        (= (xdrx_getpropertyvalue bname "IsA") "AcDbBlockReference")
   
5.       (progn
   
6.         (setq bt   (xdrx_getpropertyvalue bname "BlockTableRecord")
   
7.               ents (xdrx_getpropertyvalue (cadr bt) "allEntities")
   
8.         )
   
9.         (if (not (member (car bt) bts))
   
10.           (mapcar
    
11.             '(lambda (x)
    
12.                (if (/= (xdrx_getpropertyvalue bname "IsA")
    
13.                        "AcDbBlockReference"
    
14.                    )
    
15.                  (xdrx_setpropertyvalue x "Layer" layname "color" 256)
    
16.                  (en-bl x "dx")
    
17.                )
    
18.              )
    
19.             ents
    
20.           )
    
21.         )
    
22.         (setq bts (cons (car bt) bts))
    
23.       )
    
24.     )
    
25.   )
    
26.   (if (not (tblsearch "layer" "dx"))
    
27.     (xdrx_layer_make "dx")
    
28.   )
    
29.   (if (setq ename (car (xdrx_entsel "\n选择块:" '((0 . "INSERT")))))
    
30.     (progn
    
31.       (en-bl ename "DX")
    
32.       (xdrx_object_regen)
    
33.     )
    
34.   )
    
35.   (princ)
    
36. )
    

;;功能把选择的块内所有实体包括嵌套块改到DX图层<br /> (defun c:bch (/ ename bname ent layname olderr myerror)<br />   (defun en-bl (bname layname / bt blkdef ents bts)<br />     (if        (= (xdrx_getpropertyvalue bname "IsA") "AcDbBlockReference")<br />       (progn<br />         (setq bt   (xdrx_getpropertyvalue bname "BlockTableRecord")<br />               ents (xdrx_getpropertyvalue (cadr bt) "allEntities")<br />         )<br />         (if (not (member (car bt) bts))<br />           (mapcar<br />             '(lambda (x)<br />                (if (/= (xdrx_getpropertyvalue bname "IsA")<br />                        "AcDbBlockReference"<br />                    )<br />                  (xdrx_setpropertyvalue x "Layer" layname "color" 256)<br />                  (en-bl x "dx")<br />                )<br />              )<br />             ents<br />           )<br />         )<br />         (setq bts (cons (car bt) bts))<br />       )<br />     )<br />   )<br />   (if (not (tblsearch "layer" "dx"))<br />     (xdrx_layer_make "dx")<br />   )<br />   (if (setq ename (car (xdrx_entsel "\n选择块:" '((0 . "INSERT")))))<br />     (progn<br />       (en-bl ename "DX")<br />       (xdrx_object_regen)<br />     )<br />   )<br />   (princ)<br /> )<br />

hwwrrbb

多谢了，用setpropertyvalue写了，没问题了。

hwwrrbb

st788796 发表于 2014-12-8 13:59
这样试试

多谢了。setpropertyvalue写的够精简的。我setpropertyvalue还不是太熟，弄了半天。

newer

st788796 发表于 2014-12-8 13:59
这样试试

还可以再精简的，

• 
                                 
  登录/注册后可看大图
    (if (not (tblsearch "layer" "dx"))
• 
                                 
  登录/注册后可看大图
      (xdrx_layer_make "dx")
• 
                                 
  登录/注册后可看大图
    )
  

这个可以不要的，xdrx_setpropertyvalue 会自动建立的，如果不存在。

st788796

newer 发表于 2014-12-8 16:07
还可以再精简的，

本来想没有这个图层退出不执行的:)

newer

hwwrrbb 发表于 2014-12-8 16:00
多谢了。setpropertyvalue写的够精简的。我setpropertyvalue还不是太熟，弄了半天。

你的代码看着有问题啊，(setq ename1 (entnext ename1)) 这个不保证是块内的下个实体啊。而且他中断不了循环啊？

newer

st788796 发表于 2014-12-8 16:22
本来想没有这个图层退出不执行的

其实不用管了，用户想怎么就怎么呗。

st788796

newer 发表于 2014-12-8 16:54
其实不用管了，用户想怎么就怎么呗。

这里面还有个 Bug ,如果图块只有一个实体,mapcar 会出错的

allEntities 在只有一个实体的时候返回实体不是表，API需要修正

newer

st788796 发表于 2014-12-8 16:58
这里面还有个 Bug ,如果图块只有一个实体,mapcar 会出错的

allEntities 在只有一个实体的时候返回实体 ...

新拿到的API，这个已经修正了。

newer

如果用老的方法编程，可以用xdrx_object_get 和 xdrx_object_next获得块内的实体

newer

用老的方法，你试试这样写：

1. (defun c:bch (/ bname e ename layname) ; -------
   
2.   (defun en-bl (bname layname / e)
   
3.     (xdrx_object_get "block" bname)
   
4.     (while (setq e (xdrx_object_next))
   
5.      (if (= (xdrx_GetEntDxf 0) "INSERT") ; 嵌套块
   
6.         (progn
   
7.           (en-bl (xdrx_GetEntDxf 2) layname)
   
8.         )
   
9.         (progn
   
10.           (xdrx_setenttodb (last e))
    
11.           (xdrx_ModEnt 8 layname 62 256) ; 老命令
    
12.         )
    
13.       )                                       ; if
    
14.     )                                       ; while
    
15.     (print)
    
16.   )                                       ; defun
    
17.                                        ; ------------------------------
    
18.   (setq ename (car (xdrx_entsel "\n选择块:" '((0 . "INSERT")))))
    
19.   (xdrx_SetEntToDb ename)
    
20.   (setq bname (xdrx_GetEntDxf 2))
    
21.   (en-bl bname "DX")
    
22.   (xdrx_object_regen)
    
23.   (princ)
    
24. )

(defun c:bch (/ bname e ename layname) ; -------<br />   (defun en-bl (bname layname / e)<br />     (xdrx_object_get "block" bname)<br />     (while (setq e (xdrx_object_next))<br />      (if (= (xdrx_GetEntDxf 0) "INSERT") ; 嵌套块<br />         (progn<br />           (en-bl (xdrx_GetEntDxf 2) layname)<br />         )<br />         (progn<br />           (xdrx_setenttodb (last e))<br />           (xdrx_ModEnt 8 layname 62 256) ; 老命令<br />         )<br />       )                                       ; if<br />     )                                       ; while<br />     (print)<br />   )                                       ; defun<br />                                        ; ------------------------------<br />   (setq ename (car (xdrx_entsel "\n选择块:" '((0 . "INSERT")))))<br />   (xdrx_SetEntToDb ename)<br />   (setq bname (xdrx_GetEntDxf 2))<br />   (en-bl bname "DX")<br />   (xdrx_object_regen)<br />   (princ)<br /> )

st788796

newer 发表于 2014-12-8 18:56
用老的方法，你试试这样写：

怎么是(last e)