[求助]：如何用vl类函数实现类似ssget的功能

zhang8755 · 发表于 2004-1-30 14:57:05

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

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

×

如何用vl类函数实现类似ssget的功能，是不是用vla-select，怎么加上过滤表，我试了试都不行，每次选择都是获得全图的实体。请给出代码实例。

LUCAS · 发表于 2004-1-30 17:02:54

;;轉貼
(defun VLASSGET (DXFCODE FLG / SELSETCOL SELSET FILTER)
(vl-load-com)
(or *ACADOBJ*
(setq *ACADOBJ* (vlax-get-acad-object))
)
(or *ACTDOC*
(setq *ACTDOC* (vla-get-activedocument *ACADOBJ*))
)
(setq SELSETCOL (vla-get-selectionsets *ACTDOC*)
FILTER (list (mapcar 'car DXFCODE) (mapcar 'cdr DXFCODE))
)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list SELSETCOL "Selection"))
)
)
(vla-clear (setq SELSET (vla-item SELSETCOL "Selection")))
(setq SELSET (vla-add SELSETCOL "Selection"))
)
(if (not FLG)
(vla-selectonscreen
SELSET
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbinteger
(cons 0 (1- (length (car FILTER))))
)
(car FILTER)
)
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbvariant
(cons 0 (1- (length (cadr FILTER))))
)
(cadr FILTER)
)
)
(vla-select
SELSET
acselectionsetall
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbinteger
(cons 0 (1- (length (car FILTER))))
)
(car FILTER)
)
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbvariant
(cons 0 (1- (length (cadr FILTER))))
)
(cadr FILTER)
)
)
)
SELSET
)
(defun C:TEST (/ SSOBJ)
(setq SSOBJ (VLASSGET '((0 . "line") (8 . "0")) NIL))
)

;;轉貼 
(defun VLASSGET        (DXFCODE FLG / SELSETCOL SELSET FILTER) 
  (vl-load-com) 
  (or *ACADOBJ* 
      (setq *ACADOBJ* (vlax-get-acad-object)) 
  ) 
  (or *ACTDOC* 
      (setq *ACTDOC* (vla-get-activedocument *ACADOBJ*)) 
  ) 
  (setq        SELSETCOL (vla-get-selectionsets *ACTDOC*) 
        FILTER          (list (mapcar 'car DXFCODE) (mapcar 'cdr DXFCODE)) 
  ) 
  (if (not 
        (vl-catch-all-error-p 
          (vl-catch-all-apply 'vla-item (list SELSETCOL "Selection")) 
        ) 
      ) 
    (vla-clear (setq SELSET (vla-item SELSETCOL "Selection"))) 
    (setq SELSET (vla-add SELSETCOL "Selection")) 
  ) 
  (if (not FLG) 
    (vla-selectonscreen 
      SELSET 
      (vlax-safearray-fill 
        (vlax-make-safearray 
          vlax-vbinteger 
          (cons 0 (1- (length (car FILTER)))) 
        ) 
        (car FILTER) 
      ) 
      (vlax-safearray-fill 
        (vlax-make-safearray 
          vlax-vbvariant 
          (cons 0 (1- (length (cadr FILTER)))) 
        ) 
        (cadr FILTER) 
      ) 
 
    ) 
    (vla-select 
      SELSET 
      acselectionsetall 
      (vlax-safearray-fill 
        (vlax-make-safearray 
          vlax-vbinteger 
          (cons 0 (1- (length (car FILTER)))) 
        ) 
        (car FILTER) 
      ) 
      (vlax-safearray-fill 
        (vlax-make-safearray 
          vlax-vbvariant 
          (cons 0 (1- (length (cadr FILTER)))) 
        ) 
        (cadr FILTER) 
      ) 
    ) 
  ) 
  SELSET 
) 
 
 
(defun C:TEST (/ SSOBJ) 
  (setq SSOBJ (VLASSGET '((0 . "line") (8 . "0")) NIL)) 
)

陌生人 · 发表于 2004-1-30 18:16:41

一个偷懒的办法

(setq doc (vla-get-activedocument(vlax-get-acad-object)))
(setq ss (ssget '((0 . "*TEXT")))
vss (vla-get-activeselectionset doc))
(vlax-for obj vss (vla-erase obj))

eachy · 发表于 2004-1-30 18:37:49

最初由陌生人发布
[B]一个偷懒的办法

(setq doc (vla-get-activedocument(vlax-get-acad-object)))

(setq ss (ssget '((0 . "*TEXT")))

vss (vla-get-activeselectionset doc))

(vlax-for obj vss (vla-erase obj))

 (setq doc (vla-get-activedocument(vlax-get-acad-object))) (setq ss (ssget '((0 . "*TEXT"))) vss (vla-get-activeselectionset doc)) (vlax-for obj vss (vla-erase obj)) 
[/B]

(if (setq ss (ssget '((0 . "text"))))
(vlax-for item (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
.....;;你的代码
)
)

xcajcj · 发表于 2004-1-31 20:33:50

我在程序中是这样做的：
1.用(entsel)函数获取对象图元名
2.用(vlax-ename->vla-object)函数将象图元名称转换为VLA对象
反之也可以用(vlax-vla-object->ename)函数将VLA对象转换为图元对象。

zhang8755 · 发表于 2004-2-2 12:05:50

2楼的程序用如下代码测试会删除所有实体，起不到过滤效果，不只是为什么？这也是我发这个帖子的初衷。
(defun C:TEST (/ SSOBJ)
(setq SSOBJ (VLASSGET '((0 . "line") (8 . "0")) T))
(vlax-for obj ssobj (vla-erase obj))
)

21cn · 发表于 2004-2-2 13:00:35

最初由 zhang8755 发布
[B]2楼的程序用如下代码测试会删除所有实体，起不到过滤效果，不只是为什么？这也是我发这个帖子的初衷。
(defun C:TEST (/ SSOBJ)
(setq SSOBJ (VLASSGET '((0 . "line") (8 . "0")) T))
(vlax-for obj ssobj (... [/B]

还不如

(defun c:test (/ ss)
(if (setq ss (ssget '((0 . "line") (8 . "0")) )
(vl-cmdf ".erase" "p" "")
)
(princ)
)

LUCAS · 发表于 2004-2-3 08:03:15

這可能又是VLISP的BUG，我很久以前也發現了一個對POLYLINE寬度(VLA-GETWIDTH)的BUG。
內容如下:
;;FOR TEST VLA-GETWIDTH
;;Why not work for "polyline"
(vl-load-com)
(defun C:TT (/ SW EW)
(entmake '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbPolyline")
(90 . 5)
(70 . 0)
(38 . 0.0)
(39 . 0.0)
(10 76.0664 72.0219)
(40 . 0.0)
(41 . 5.0)
(42 . 0.0)
(10 97.0601 104.074)
(40 . 5.0)
(41 . 5.0)
(42 . -0.78921)
(10 155.376 83.0943)
(40 . 5.0)
(41 . 12.0)
(42 . 1.4926)
(10 214.275 99.9943)
(40 . 12.0)
(41 . 1.0)
(42 . 0.0)
(10 213.109 171.091)
(40 . 1.0)
(41 . 1.0)
(42 . 0.0)
(210 0.0 0.0 1.0)
)
)
(vla-getwidth (vlax-ename->vla-object (entlast)) 2 'SW 'EW)
(print SW)
(print EW)
(SETQ SW NIL
EW NIL
)
(entmake '((0 . "POLYLINE")
(62 . 5)
(6 . "CONTINUOUS")
(66 . 1)
)
)
(entmake '((0 . "VERTEX")
(10 76.0664 72.0219)
(40 . 0.0)
(41 . 5.0)
(42 . 0.0)
)
)
(entmake '((0 . "VERTEX")
(10 97.0601 104.074)
(40 . 5.0)
(41 . 5.0)
(42 . -0.78921)
)
)
(entmake '((0 . "VERTEX")
(10 155.376 83.0943)
(40 . 5.0)
(41 . 12.0)
(42 . 1.4926)
)
)
(entmake '((0 . "VERTEX")
(10 214.275 99.9943)
(40 . 12.0)
(41 . 1.0)
(42 . 0.0)
)
)
(entmake '((0 . "VERTEX")
(10 213.109 171.091)
(40 . 1.0)
(41 . 1.0)
(42 . 0.0)
)
)
(entmake '((0 . "SEQEND")))
(PRINT (ENTGET (ENTLAST)))
;;;why not work for "polyline"
(vla-getwidth (vlax-ename->vla-object (entlast)) 2 'SW 'EW)
(print SW)
(print EW)
)

這可能又是VLISP的BUG，我很久以前也發現了一個對POLYLINE寬度(VLA-GETWIDTH)的BUG。 
內容如下: 
;;FOR TEST VLA-GETWIDTH 
;;Why not work for "polyline" 
(vl-load-com) 
(defun C:TT (/ SW EW) 
  (entmake '((0 . "LWPOLYLINE") 
             (100 . "AcDbEntity") 
             (67 . 0) 
             (410 . "Model") 
             (8 . "0") 
             (100 . "AcDbPolyline") 
             (90 . 5) 
             (70 . 0) 
             (38 . 0.0) 
             (39 . 0.0) 
             (10 76.0664 72.0219) 
             (40 . 0.0) 
             (41 . 5.0) 
             (42 . 0.0) 
             (10 97.0601 104.074) 
             (40 . 5.0) 
             (41 . 5.0) 
             (42 . -0.78921) 
             (10 155.376 83.0943) 
             (40 . 5.0) 
             (41 . 12.0) 
             (42 . 1.4926) 
             (10 214.275 99.9943) 
             (40 . 12.0) 
             (41 . 1.0) 
             (42 . 0.0) 
             (10 213.109 171.091) 
             (40 . 1.0) 
             (41 . 1.0) 
             (42 . 0.0) 
             (210 0.0 0.0 1.0) 
            ) 
  ) 
  (vla-getwidth (vlax-ename->vla-object (entlast)) 2 'SW 'EW) 
  (print SW) 
  (print EW) 
  (SETQ        SW NIL 
        EW NIL 
  ) 
  (entmake '((0 . "POLYLINE") 
             (62 . 5) 
             (6 . "CONTINUOUS") 
             (66 . 1) 
            ) 
  ) 
  (entmake '((0 . "VERTEX") 
             (10 76.0664 72.0219) 
             (40 . 0.0) 
             (41 . 5.0) 
             (42 . 0.0) 
            ) 
  ) 
  (entmake '((0 . "VERTEX") 
             (10 97.0601 104.074) 
             (40 . 5.0) 
             (41 . 5.0) 
             (42 . -0.78921) 
            ) 
  ) 
  (entmake '((0 . "VERTEX") 
             (10 155.376 83.0943) 
             (40 . 5.0) 
             (41 . 12.0) 
             (42 . 1.4926) 
            ) 
  ) 
  (entmake '((0 . "VERTEX") 
             (10 214.275 99.9943) 
             (40 . 12.0) 
             (41 . 1.0) 
             (42 . 0.0) 
            ) 
  ) 
  (entmake '((0 . "VERTEX") 
             (10 213.109 171.091) 
             (40 . 1.0) 
             (41 . 1.0) 
             (42 . 0.0) 
            ) 
  ) 
  (entmake '((0 . "SEQEND"))) 
  (PRINT (ENTGET (ENTLAST))) 
;;;why not work for "polyline" 
  (vla-getwidth (vlax-ename->vla-object (entlast)) 2 'SW 'EW) 
  (print SW) 
  (print EW) 
)

陌生人 · 发表于 2004-2-4 08:41:20

;;;why not work for "polyline"
  (vla-getwidth (vlax-ename->vla-object (entlast)) 2 'SW 'EW)
  (print SW)
  (print EW)
)

是不是认为entlast是 seqend段，而不是polyline？

zhang8755 · 发表于 2004-2-4 11:47:59

最初由 21cn 发布
[B][QUOTE]最初由 zhang8755 发布
[B]2楼的程序用如下代码测试会删除所有实体，起不到过滤效果，不只是为什么？这也是我发这个帖子的初衷。
(defun C:TEST (/ SSOBJ)
(setq SSOBJ (VLASSGET '((0 . "line")... [/B]

用ssget只能在当前图形中选择，而用vl-select可以支持MDI，获得其它已打开图形中的实体。从而编出类似批处理的的程序。

LUCAS · 发表于 2004-2-4 12:37:06

最初由陌生人发布
[B];;;why not work for "polyline"
  (vla-getwidth (vlax-ename->vla-object (entlast)) 2 'SW 'EW)
  (print SW)
  (print EW)
)

是不是认为entlast是 seqend段，而不是polyline？ [/B]

你认為(entlast)會抓到seqend段?

http://discussion.autodesk.com/thread.jspa?messageID=1174678

陌生人 · 发表于 2004-2-4 13:09:40

原来如此，3q

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

[求助] [求助]：如何用vl类函数实现类似ssget的功能

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

相关帖子