[测试]：设置标记、及获取标记后实体。

eachy · 发表于 2003-6-22 23:17:13

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

[font=courier]
;;设置标记
(defun ea:setmark ()
(setq $yb_last_entity_mark
(vla-get-objectid
(vlax-ename->vla-object (entlast))
)
)
)
;;获取标记后生成的实体
(defun ea:getss (/ ss idn for-item docment modelspace)
(setq docment (vla-get-activedocument (vlax-get-acad-object))
modelspace (vla-get-modelspace docment)
)
(setq ss (ssadd))
(if $yb_last_entity_mark
(progn
(vlax-for for-item modelspace
(setq idn (vla-get-objectid for-item))
(if (> idn $yb_last_entity_mark)
(setq ss (ssadd (vlax-vla-object->ename
(vla-objectidtoobject docment idn)
)
ss
)
)
)
)
(setq $yb_last_entity_mark nil)
)
)
ss
)
[/font]

[font=courier] 
;;设置标记 
(defun ea:setmark () 
  (setq        $yb_last_entity_mark 
         (vla-get-objectid 
           (vlax-ename->vla-object (entlast)) 
         ) 
  ) 
) 
;;获取标记后生成的实体 
(defun ea:getss        (/ ss idn for-item docment modelspace) 
  (setq        docment           (vla-get-activedocument (vlax-get-acad-object)) 
        modelspace (vla-get-modelspace docment) 
  ) 
  (setq ss (ssadd)) 
  (if $yb_last_entity_mark 
    (progn 
      (vlax-for        for-item modelspace 
        (setq idn (vla-get-objectid for-item)) 
        (if (> idn $yb_last_entity_mark) 
          (setq        ss (ssadd (vlax-vla-object->ename 
                            (vla-objectidtoobject docment idn) 
                          ) 
                          ss 
                   ) 
          ) 
        ) 
      ) 
      (setq $yb_last_entity_mark nil) 
    ) 
  ) 
  ss 
) 
[/font]

njshf · 发表于 2003-6-23 07:13:35

干吗用？

lijiao · 发表于 2003-6-23 08:21:44

非常有用，我也做了一个这样的程序，用于讲图形标准化。

eachy · 发表于 2003-6-25 07:48:33

最初由 lijiao 发布
[B]非常有用，我也做了一个这样的程序，用于讲图形标准化。 [/B]

2002下通过，2004 下 fail .

lijiao · 发表于 2003-6-25 09:23:21

最初由 eachy 发布
[B]
2002下通过，2004 下 fail . [/B]

我是这样做的：

[FONT=courier new]
(defun update1 (cs_ss / ss entlei enttbl entobj wordh)
(if cs_ss
(setq ss (entnext cs_ss))
(setq ss (entnext))
)
(princ "\n处理")
(while ss
(princ ".")
(setq entobj (vlax-ename->vla-object ss))
(setq enttbl (entget ss (list "*")))
(setq entlei (cdr (assoc 0 enttbl)))
(cond
((= entlei "ACMPARTLIST")
(vlax-put-property entobj 'scale bl)
)
((or (= entlei "TEXT")
(= entlei "MTEXT")
)
(if (= "技术要求" (vla-get-TextString entobj))
(setq wordh (* bl 5.0))
(setq wordh (* bl 3.5))
)
(vla-put-Height entobj wordh)
(vla-put-layer entobj "6")
)
((= entlei "DIMENSION")
(vla-put-ScaleFactor entobj bl)
)
(t (princ))
)
(setq ss (entnext ss))
)
(princ "完毕。")
(setq cs_mylast (entlast))
(princ)
)
[/FONT]

[FONT=courier new] 
(defun update1 (cs_ss / ss entlei enttbl entobj wordh) 
  (if cs_ss 
    (setq ss (entnext cs_ss)) 
    (setq ss (entnext)) 
  ) 
  (princ "\n处理") 
  (while ss 
    (princ ".") 
    (setq entobj (vlax-ename->vla-object ss)) 
    (setq enttbl (entget ss (list "*"))) 
    (setq entlei (cdr (assoc 0 enttbl))) 
    (cond 
      ((= entlei "ACMPARTLIST") 
       (vlax-put-property entobj 'scale bl) 
      ) 
      ((or (= entlei "TEXT") 
           (= entlei "MTEXT") 
       ) 
       (if (= "技术要求" (vla-get-TextString entobj)) 
         (setq wordh (* bl 5.0)) 
         (setq wordh (* bl 3.5)) 
       ) 
       (vla-put-Height entobj wordh) 
       (vla-put-layer entobj "6") 
      ) 
      ((= entlei "DIMENSION") 
       (vla-put-ScaleFactor entobj bl) 
      ) 
      (t (princ)) 
    ) 
    (setq ss (entnext ss)) 
  ) 
  (princ "完毕。") 
  (setq cs_mylast (entlast)) 
  (princ) 
) 
  [/FONT]

还没有在2004上用。
2004上好像要先加载VL，即（VL-LOAD-COM）

LUCAS · 发表于 2003-6-25 10:21:07

遍历MODELSPACE就很花时间了,如对象在其它空间就不能用了!
看来autolisp会简单一些。
好像
(setq SS (ssadd (vlax-vla-object->ename
(vla-objectidtoobject DOCMENT IDN)
)
SS
)
)
可简化为
(ssadd (vlax-vla-object->ename FOR-ITEM) SS)
;;測試
;;设置记号
(vl-load-com)
(defun EA:SETMARK ()
(setq $YB_LAST_ENTITY_MARK
(vla-get-objectid
(vlax-ename->vla-object (entlast))
)
)
)
;;获取标记后生成的实体
(defun EA:GETSS (/ SS COUNT N ENT CURSPACE DOC)
(setq DOC (vla-get-activedocument (vlax-get-acad-object))
CURSPACE (cond
((= (getvar "TILEMODE") 1)
(vla-get-modelspace DOC)
)
((> (getvar "CVPORT") 1)
(vla-get-modelspace DOC)
)
((vla-get-paperspace DOC))
)
)
(setq SS (ssadd))
(if $YB_LAST_ENTITY_MARK
(progn
(setq N 1
COUNT (vla-get-count CURSPACE)
)
(while (and (> (- count n) -1)
(> (vla-get-objectid
(setq ENT (vla-item CURSPACE
(- COUNT N)
)
)
)
$YB_LAST_ENTITY_MARK
)
)
(ssadd (vlax-vla-object->ename ENT) SS)
(setq N (1+ N))
)
(setq $YB_LAST_ENTITY_MARK NIL)
)
)
(vlax-release-object DOC)
(vlax-release-object CURSPACE)
SS
)

遍历MODELSPACE就很花时间了,如对象在其它空间就不能用了! 
看来autolisp会简单一些。 
好像 
(setq SS (ssadd        (vlax-vla-object->ename 
                  (vla-objectidtoobject DOCMENT IDN) 
                ) 
                SS 
         ) 
) 
可简化为 
(ssadd (vlax-vla-object->ename FOR-ITEM) SS) 
 
 
;;測試 
;;设置记号 
(vl-load-com) 
(defun EA:SETMARK () 
  (setq        $YB_LAST_ENTITY_MARK 
         (vla-get-objectid 
           (vlax-ename->vla-object (entlast)) 
         ) 
  ) 
) 
 
;;获取标记后生成的实体 
(defun EA:GETSS        (/ SS COUNT N ENT CURSPACE DOC) 
  (setq        DOC         (vla-get-activedocument (vlax-get-acad-object)) 
        CURSPACE (cond 
                   ((= (getvar "TILEMODE") 1) 
                    (vla-get-modelspace DOC) 
                   ) 
                   ((> (getvar "CVPORT") 1) 
                    (vla-get-modelspace DOC) 
                   ) 
                   ((vla-get-paperspace DOC)) 
                 ) 
  ) 
  (setq SS (ssadd)) 
  (if $YB_LAST_ENTITY_MARK 
    (progn 
      (setq N          1 
            COUNT (vla-get-count CURSPACE) 
      ) 
      (while (and (> (- count n) -1) 
                  (> (vla-get-objectid 
                       (setq ENT (vla-item CURSPACE 
                                           (- COUNT N) 
                                 ) 
                       ) 
                     ) 
                     $YB_LAST_ENTITY_MARK 
                  ) 
             ) 
        (ssadd (vlax-vla-object->ename ENT) SS) 
        (setq N (1+ N)) 
      ) 
      (setq $YB_LAST_ENTITY_MARK NIL) 
    ) 
  ) 
  (vlax-release-object DOC) 
  (vlax-release-object CURSPACE) 
  SS 
)

aeo · 发表于 2003-6-26 20:49:57

EA:SETMARK ($YB_LAST_ENTITY_MARK)时,
如果图上没东西,那$YB_LAST_ENTITY_MARK为nil
那画了东西也得不到.
所以不应该判断$YB_LAST_ENTITY_MARK为空,为空时就应该是图中所有实体.
那反过来一想,又错了:你没设呢(EA:SETMARK ) ?不是又得到全部实体了吗?

所以应该是整个方法不对.

eachy · 发表于 2003-6-26 20:57:42

(defun EA:SETMARK ()
(if (entlast)
(setq $YB_LAST_ENTITY_MARK
(vla-get-objectid
(vlax-ename->vla-object (entlast))
)
))
)

aeo · 发表于 2003-6-26 21:04:43

那你的程序,在空图上不要用?
比如要把程序里的新生的线改为红色.你在空图上运行,不是不行了吗?
我觉的$YB_LAST_ENTITY_MARK空时得到所有的为好.
毕竟不EA:SETMARK ,还有机会发现,自己写的...:)

eachy · 发表于 2003-6-26 21:18:51

萌生这个想法源于 XDRX_API ，想试试用LSP可不可以实现类似功能，至少实现部分功能，设置标记对图中实体不多时还可以(AutoCAD 2002)，遍历肯定会耗时的，好在我画的图都不大。

在CAD2004中实体的ID与2002中就不同了，期待那个置顶的查看CAD内部数据库工具的For 2004版。

试着用Lsp写API中的函数对学习LSP也是有很大帮助的。

fango · 发表于 2003-7-5 19:46:02

搞不懂他的功能，能不能说清楚点？

taner · 发表于 2008-12-19 09:04:07

俺是这样搞的。

[FONT=courier new]
(defun hao-ss-aftere (ename / ss)
(if (and
ename
(setq ss (ssadd))
(eq 'ename (type ename))
)
(while (setq ename (entnext ename))
(ssadd ename ss)
)
(setq ss (ssget "x"))
)
ss
)
(defun c:test ()
(setq laste (entlast))
.......................
(setq ss (hao-ss-aftere laste))
.......................
)
[/FONT]

账号		自动登录	找回密码
密码			立即注册

[测试]：设置标记、及获取标记后实体。

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子