この掲示板は AutoCADマクロ屋本舗 の掲示板です。

【 注意 】最初に必ず ↓↓ 下記内容 ↓↓ を参照ください。
① マクロが分からない方は、まず 【 マクロ講座 】 を参照ください。
② 質問の前に 【 マクロ使用前の注意事項 】 をお読みください。
③ 質問する時は、新規投稿フォーム下の【 新規投稿時のお願い 】を必ずお読みください。

LISP 円の中心付近にテキストがあったら移動させたい
範囲を選択し、円の中心付近にテキストが存在していた場合、テキストを円の中心の下方(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かじり
  • 2025/01/03 (Fri) 18:44:11
Re: LISP 円の中心付近にテキストがあったら移動させたい
(vla-Update textObj)
で、オブジェクトを更新してみては?
  • LUNE
  • 2025/01/06 (Mon) 09:21:04
Re: LISP 円の中心付近にテキストがあったら移動させたい
(vla-Update textObj) では変化がありませんでした。

vlaオブジェクトにしての移動がどうにもうまくいかなかっため、
エンティデータの書き換えで望んだ動作をするようにこじつけました。悔しい…


(defun c:test (/ entList obj pos textObj radius minPt maxPt textList entData newAddr i)
(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 (ssname textList 0))
(setq entData (entget textObj))
;; テキストの新しい座標位置を設定
(setq newAddr (list (car pos) (- (cadr pos) (+ radius 50.0)) 0.0))
(setq entData (subst (cons 11 newAddr) (assoc 11 entData) entData))
;; 水平および垂直方向の位置合わせを設定(中心)
(setq entData (subst (cons 72 1) (assoc 72 entData) entData)) ;; 水平位置合わせ
(setq entData (subst (cons 73 2) (assoc 73 entData) entData)) ;; 垂直位置合わせ
;; エンティティに反映する
(entmod entData)
)
)
)
)
)
(princ)
)
  • Lispかじり
  • 2025/01/22 (Wed) 21:45:22
Re: LISP 円の中心付近にテキストがあったら移動させたい
自分の環境(Win10 2022)で試してみたら、最初のコードでちゃんと文字が移動されました。
(すみません、最初のコメント、コードだけざっとみて書き込みました)

なんで質問者さんの環境では、動かないんだろう・・・
  • LUNE
  • 2025/01/23 (Thu) 11:39:42
Re: LISP 円の中心付近にテキストがあったら移動させたい
vlaオブジェクトで処理するのを諦めるまでの考察とか

(vlax-property-available-p textObj 'InsertionPoint)
(vla-put-insertionpoint ・・・
このInsertionPointというのが、グループコード10に該当する情報を持っているみたいだ。

テキストオブジェクトの位置を確定する座標は、
位置合わせが左寄せのときはグループコード10の座標
位置合わせが左寄せ以外のときはグループコード11の座標、
となっているようだ。

InsertionPointを書き換ればグループコード10の座標が書き換わるので、
左寄せのテキストは移動するが、
左寄せ以外はグループコード11が変わらないので動かないんだと思う。

じゃぁグループコード11に該当する、InsertionPointに代わるものは何だ?
・・・辿り着けませんでした。

こんな感じで諦めに至りました。

用語や表現が的確でないかもしれない点はご容赦下さい。
  • Lispかじり
  • 2025/01/24 (Fri) 20:28:35
Re: LISP 円の中心付近にテキストがあったら移動させたい
https://help.autodesk.com/view/OARX/2024/JPN/?guid=GUID-B6F917C1-9916-419A-9047-625453CEA306
こちらに、
「このプロパティは、Alignment プロパティが acAlignmentLeft、acAlignmentAligned、または acAlignmentFitに設定されている文字を除き、読み込み専用です。」
とあります。これが、左寄せ以外の基点設定の場合に、移動しない原因かと。

その場合は、
「TextAlignmentPoint プロパティを使用して文字の位置を決定します。」
とあります。

Alignment プロパティが acAlignmentLeftかどうかを確認→処理を分けるという感じでしょうか。
  • LUNE
  • 2025/01/27 (Mon) 09:34:48

返信フォーム






プレビュー (投稿前に内容を確認)