Menggandakan BOX

Dah lama ngga nulis jadi kangen juga :-). Ini ada sedikit coding untuk mengopi objek berdasarkan jarak tertentu. Silahkan perhatikan ilustrasi gambar. Untuk mengakhiri program silahkan tekan tombol enter.

Berikut codingnya

[sourcecode language='cpp']

(prompt "\nKetik MB untuk run dan enter untuk mengakhiri")
; program ini dibuat untuk mengcopy box
; dibuat Abu Labib 08 Mei 2009
(defun c:MB (/ ss cntss sscount oldosn enone cntss
entwo obone elone lione obtwo eltwo litwo
cnt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pb lb
ptx1 pty1 ptx2)
(vl-load-com)
(while
(setq ss (ssget '((0 . "LWPOLYLINE"))));prose pemilihan objek
(setq cntss 0); membuat conter
(setq sscount (sslength ss)); menghitung jumlah pemilihan
(setq oldosn (getvar "osmode"))

(if (= sscount 2)
(progn
(setq enone (ssname ss cntss)); nama entity pertama
(setq cntss (1+ cntss))
(setq entwo (ssname ss cntss)); nama entity kedua
;--------------
;Pengolahan entity box pertama
(setq obone (vlax-ename->vla-object enone)); mengambil data objek pertama
(setq elone (vlax-get-property obone 'coordinates))
(setq lione (vlax-safearray->list (variant-value elone)))
(setq obtwo (vlax-ename->vla-object entwo));mengambil data objek kedua
(setq eltwo (vlax-get-property obtwo 'coordinates))
(setq litwo (vlax-safearray->list (variant-value eltwo)))
(setq cnt 0)
(repeat (- sscount 1)
(setq pt1 (list (nth cnt lione) (nth (1+ cnt) lione)))
(setq cnt (+ 2 cnt))
(setq pt2 (list (nth cnt lione) (nth (1+ cnt) lione)))
(setq cnt (+ 2 cnt))
(setq pt3 (list (nth cnt lione) (nth (1+ cnt) lione)))
(setq cnt (+ 2 cnt))
(setq pt4 (list (nth cnt lione) (nth (1+ cnt) lione)))
(setq cnt (- cnt 6))
(setq pt5 (list (nth cnt litwo) (nth (1+ cnt) litwo)))
(setq cnt (+ 2 cnt))
(setq pt6 (list (nth cnt litwo) (nth (1+ cnt) litwo)))
(setq cnt (+ 2 cnt))
(setq pt7 (list (nth cnt litwo) (nth (1+ cnt) litwo)))
(setq cnt (+ 2 cnt))
(setq pt8 (list (nth cnt litwo) (nth (1+ cnt) litwo)))
);repeat
(setq pb (- (car pt2) (car pt1))); panjang box
(setq lb (- (cadr pt4) (cadr pt1))); lebar box
(setq ptx1 (+ (- (* 3 pb) 8) (car pt1)))
(setq pty1 (- (cadr pt1) (/ lb 2)))
(setq ptx2 (+ (* 2 pb)(car pt1)))
(setvar "osmode" 0)
(command "copy" enone "" pt1 (list ptx1 pty1))
(command "copy" entwo "" pt5 (list ptx2 pty1))
(setvar "osmode" oldosn)
);progn
(alert "\nJumlah pemilihan < atau > 2")
);if
);while
(princ)
);defun
(princ)

[/sourcecode]