範囲を選択し、円の中心付近にテキストが存在していた場合、テキストを円の中心の下方(Y座標-50)に移動させたいと考えています。
下記のコードでテキストを検出することはできているのですが、位置移動が機能しません。
位置移動の箇所に、下記の文字高や回転角度を指定するコードを含めるとそれは機能します。
(vlax-put textObj 'Height 50)
(vlax-put textObj 'Rotation 0)
位置移動の処理について、手直ししていただけないでしょうか。
(defun c:test (/ entList obj pos textObj radius minPt maxPt)
(prompt "\n処理対象範囲を選択してください: ")
(setq entList (ssget '((0 . "CIRCLE")))) ;; 円のみを選択
(if entList
(progn
(repeat (setq i (sslength entList))
(setq obj (vlax-ename->vla-object (ssname entList (setq i (1- i)))))
(setq pos (vlax-get obj 'Center)) ;; 円の中心取得
(setq radius (vlax-get obj 'Radius)) ;; 円の半径取得
;; プラスマイナス10の範囲に基づいて最小点と最大点を取得
(setq minPt (list (- (car pos) 10) (- (cadr pos) 10)))
(setq maxPt (list (+ (car pos) 10) (+ (cadr pos) 10)))
;; テキストを範囲内で探す
(setq textList (ssget "_C"
minPt
maxPt
(list
(cons 0 "TEXT,MTEXT")
)
)
)
;; テキストが見つかった場合
(if textList
(progn
(setq textObj (vlax-ename->vla-object (ssname textList 0)))
;; 各属性を設定する前に、オブジェクトの型確認と値の妥当性確認
(if (vlax-property-available-p textObj 'InsertionPoint)
(progn
;; テキストの座標を新しい位置に変更
(vla-put-insertionpoint textObj
(vlax-3d-point (car pos)
(- (cadr pos)
(+ radius 50.0)
)
0.0
)
)
)
)
)
)
)
)
)
(princ)
)
LISP 円の中心付近にテキストがあったら移動させたい
- Lispかじり
- 2025/01/03 (Fri) 18:44:11