[求助]

wanghangshun

(defun c:chapic3 () ;一个图像裁剪程序，运行时提示安全数组不正确，请哪位高手给予指导一下
  (vl-load-com)
  (setq acad (vlax-get-acad-object))
  (setq document (vla-get-activedocument acad))
  (setq modelspace (vla-get-modelspace document))
  (setq utili (vla-get-utility document))
  (setq image (vlax-ename->vla-object (car (entsel "\n Ñ¡ÔñͼÏñ£º"))))
  (setq ptlis '())
  (setq n 0)
  (command "line")
  (vla-setvariable document "osmode" 1)
  (while (setq pt (getpoint "\n ÊäÈë²Ã¼ô±ß½ç:"))
    (progn
      (command pt)
      (setq ptlis (append ptlis (list (list (car pt) (cadr pt)))))
      (setq n (1+ n))
    )
  )
  (command "")
  (setq ptarray (vlax-make-safearray vlax-vbdouble (cons 1 n) (cons 0 1)))
  (setq ptarray(vlax-safearray-fill ptarray ptlis))
  (setq clippt (vlax-make-variant ptarray))
  (vla-clipboundary image clippt)
  (vla-put-clippingenabled image :vlax-true)
  (vla-update image)
  (vla-zoompickwindow acad)
)

xianaihua

我做了些修改，测试了一下，没问题

[UseMoney=5]

2. (defun c:chapic3 ()
3.   (defun 3dPoint->2dPoint (3dpt)
4.     (list (car 3dpt) (cadr 3dpt))
5.   )
6.   (defun gp:list->variantArray (ptsList / arraySpace sArray)
7.      ; 给以双精度实数表示的二维点数组分配空间
8.     (setq arraySpace
9.     (vlax-make-safearray
10.       vlax-vbdouble  ; 元素类型
11.       (cons 0
12.      (- (length ptsList) 1)
13.       )    ; 数组维数
14.     )
15.     )
16.     (setq sArray (vlax-safearray-fill arraySpace ptsList))
17.      ; 返回数组变体
18.     (vlax-make-variant sArray)
19.   )
20.   (vl-load-com)
21.   (setq acad (vlax-get-acad-object))
22.   (setq document (vla-get-activedocument acad))
23.   (setq modelspace (vla-get-modelspace document))
24.   (setq utili (vla-get-utility document))
25.   (setq image (vlax-ename->vla-object (car (entsel "\n 选择要修剪的图片"))))
26.   (setq ptlis '())
27.   (setq n 0)
28.   (command "line")
29.   (vla-setvariable document "osmode" 1)
30.   (while (setq pt (getpoint "\n 点取一点:"))
31.     (progn
32.       (command pt)
33.       (setq ptlis (append ptlis (list (list (car pt) (cadr pt)))))
34.       (setq n (1+ n))
35.     )
36.   )
37.   (command "")
38.   (setq polypoints
39.   (apply 'append
40.   (mapcar '3dPoint->2dPoint
41.    ptlis
42.   )
43.   )
44.   )
46.   (setq clippt (gp:list->variantArray polypoints))
47.   (vla-clipboundary image clippt)
48.   (vla-put-clippingenabled image :vlax-true)
49.   (vla-update image)
50.   (vla-zoompickwindow acad)
51. )

(defun c:chapic3 ()   (defun 3dPoint->2dPoint (3dpt)     (list (car 3dpt) (cadr 3dpt))   )   (defun gp:list->variantArray (ptsList / arraySpace sArray)      ; 给以双精度实数表示的二维点数组分配空间     (setq arraySpace     (vlax-make-safearray       vlax-vbdouble  ; 元素类型       (cons 0      (- (length ptsList) 1)       )    ; 数组维数     )     )     (setq sArray (vlax-safearray-fill arraySpace ptsList))      ; 返回数组变体     (vlax-make-variant sArray)   )   (vl-load-com)   (setq acad (vlax-get-acad-object))   (setq document (vla-get-activedocument acad))   (setq modelspace (vla-get-modelspace document))   (setq utili (vla-get-utility document))   (setq image (vlax-ename->vla-object (car (entsel "\n 选择要修剪的图片"))))   (setq ptlis '())   (setq n 0)   (command "line")   (vla-setvariable document "osmode" 1)   (while (setq pt (getpoint "\n 点取一点:"))     (progn       (command pt)       (setq ptlis (append ptlis (list (list (car pt) (cadr pt)))))       (setq n (1+ n))     )   )   (command "")   (setq polypoints   (apply 'append   (mapcar '3dPoint->2dPoint    ptlis   )   )   )   (setq clippt (gp:list->variantArray polypoints))   (vla-clipboundary image clippt)   (vla-put-clippingenabled image :vlax-true)   (vla-update image)   (vla-zoompickwindow acad) )

[/UseMoney]

wanghangshun

谢谢，原来是提供给vla-clipboundary的坐标数组格式不对，明白了