Merubah sudut text

;Merubah sudut text berdasarkan satu garis yang dipilih
;Dari end point terdekat kearah endpoint terjauh


(DEFUN C:99(/ rr v2 se a f an d i k u su ma)
(setq rr *error* *error* merr)
(setq v1(ssget '((0 . "TEXT"))) V2 0
se(nsel" Select line : "))
(setq a (cdr (assoc 10 (entget (car se))))
an (distance (car (cdr se)) a)
f (cdr (assoc 11 (entget (car se))))
d (distance (car (cdr se)) f) )
(if (< an d )(setq i a k f)(setq i f k a))
(setq u (cons 50(ANGLE i k)))
(while (< v2 (sslength v1))
(setq su (assoc 50 (setq ma(entget (ssname v1 v2)))))
(entmod (subst u su ma))
(setq v2 (1+ v2))
)
(setq *error* rr)(princ))

2 Komentar::

Anonim mengatakan...

Maaf bukan menggurui, kode anda selalu pake fungsi error handle, padahal di situ tidak ada seting variable.
error handle baru di gunakan kalau pada kode tsb terdapat perubahn seting command varible.

29 Maret 2010 pukul 21.00
Anonim mengatakan...

;;Align text with a line
;;Kelemahan : Jika mtext atau polyline ianya tidak akan berhasil
(defun c:AT(/ rr ob count se ent pt1 pt2 pt3 d1 d2 ang ob2)
(setq RR *error* *error* merr)
(if (setq OB (ssget "x" (list (cons 0 "TEXT"))))
(if (setq SE (entsel "\nSelect line: "))
(progn
(setq COUNT 0
ENT (entget (car SE))
PT1 (cadr SE)
PT2 (cdr (assoc 10 ENT))
PT3 (cdr (assoc 11 ENT))
D1 (distance PT1 PT2)
D2 (distance PT1 PT3)
ANG (cons 50 (if (< D1 D2 )
(angle PT2 PT3)
(angle PT3 PT2)
);if
);cons
);setq
(while (< COUNT (sslength OB))
(setq OB2 (entget (ssname OB COUNT))
COUNT (1+ COUNT)
)
(entmod (subst ANG (assoc 50 OB2) OB2))
);while
);progn
(alert "\nYou must sellect a line")
);if
(alert "\nNo text found")
);if
(setq *error* RR)
(princ)
)

7 Juni 2012 pukul 02.42

Posting Komentar

Pesan Anda:

Langganan: Posting Komentar (Atom)