AutoCADマクロ屋本舗 掲示板

いつも利用させて頂いています。（感謝）
早速ですが、タイトルの様に一枚の鋼板に孔が無数にあるのですが、その孔寸法を記入しています。
ただし、枚数が多すぎて作図時間にかなりの時間が掛かっています。
そこで、孔全てを一機に表に出来ないかと思い投稿しました。
色々調べてDIMCORDと言うコマンドで引出し線表記は出来るとか、システム変数の中に座標は格納されるとか分かったのですが、
それをどうやれば、表に作成出来るのかのスキルが全くありません。
出来れば思い描く様なマクロを作って頂けないかと投稿した次第です。

使っているCADは「IJCad Standard 2024 」です。

添付した画像の様に全ての孔を表に出来たらかなりの時間が軽減されます。
表としましては、画像の要領で大丈夫かと思います。「φ22」などはこちらで書き込みます。（他のサイズの孔もありますので）
尺度は1/20で文字高さは30でお願い出来たらと思います。（そこは入力時に自分で設定しなさい！ということであればそれでも構いません）
なんとか、出来るものでしたら宜しくお願いします。（とにかく大量の作業枚数あるものでお願いできれば助かります）

不足の情報等ありましたら、すみません。随時言って頂ければ提示していきます。

作成したいものはなんでしょう？
引出して座標表示＋表を一括ででしょうか。

その場合、引出線の位置は、孔に対して相対的な位置の指定しかできないので、お示しの図のように他と干渉しないよう適宜調整は難しいと思われます。
Lispならやってできないことはないでしょうけど、ほぼ不可能ですし、マクロならなおさらです。

引出線での座標記入については、マクロがいろいろあると思います。
Lispであれば、引出線がすでにある、あるいは作成したい孔を選択する、で表の作成はLispなら可能かと。
マクロなら、孔を選択ならできるかも・・・（マクロでは文字内容を取得できないので、IJCadでも多分そうだと思います）

もし、表のみを一括ということであれば、もう少し情報が必要です。
文字高さの他に、表の1行の高さやそれぞれの幅、座標値の並べ方（お示しの表だと、X座標の昇順でしょうか）、表に記入する座標の桁数（引出は小数第3位までですが、表内は小数点第1位？それが0の場合は省略？）
条件を明確にすべて示してください。

csv出力するLISPあったので、こちらいかがですか？
UCSを組む→円選ぶと円の座標と半径をcsv出力→Excelなどで整え→AutoCADに張り付けて分解
AutoCADでは動きましたがIJCADで動くかはわかりません。

(defun c:test (/ Old_Os Old_Cm Old_Fd ent i lst cnt filepath fname center rad f extension str text name coordinate times)
(vl-load-com)
;初期設定の保存
(setq Old_Os (getvar "OSMODE"))
(setq Old_Cm (getvar "CMDECHO"))
(setq Old_Fd (getvar "filedia"))

;エラー処理(初期設定の戻し)
(defun *error* (msg)
(setvar "OSMODE" Old_Os);オブジェクトスナップの戻し
(setvar "CMDECHO" Old_Cm);エコーモードの戻し
(setvar "filedia" Old_Fd)
(princ))

;単位の指定
(initget 1 "MEter MIli")(setq times (getkword "\n単位の指定[メートル(ME)/ミリ(MI)]:"))
;mの場合1倍、mmの場合1000倍に設定
(cond
((= times "MEter") (setq times 1.0))
((= times "MIli") (setq times 0.001))
)

;ポリラインの点をlstに格納
(setq ss (ssget '((0 . "CIRCLE")))
i (sslength ss)
cnt 0
lst nil
)

(repeat i
(setq ent (entget (ssname ss cnt)))
(setq center (cdr (assoc 10 ent)))
(setq rad (cdr (assoc 40 ent)))
(setq lst (append lst (list (append (trans center 0 1) (list rad)))))
(setq cnt (1+ cnt))
)

;ダイアログボックスの表示をオフにする。
(setq Old_Fd (getvar "filedia"))
(command "filedia" "0")


;リストをcsvファイルで出力
(setq filepath (getDesktopPath))
(setq extension ".csv")
(setq name (getstring "ファイル名を入力"))

(if (and (setq fname (strcat filepath "\\" name extension))
(setq f (open fname "w"))
)
(progn
(setq str "\"X座標\",\"Y座標\",\"半径\"\n"
cnt 0
)
(repeat i ;cnt is point number
(setq coordinate (nth cnt lst))
(setq text
(strcat "\""
(rtos (* (car coordinate) times) 2 6)
"\",\""
(rtos (* (cadr coordinate) times) 2 6)
"\",\""
(rtos (* (cadddr coordinate) times -1) 2 6)
""
"\""
"\n"
)
)
(setq str (strcat str text)
cnt (1+ cnt)
)
);repeat
(princ str f)
(close f)
);end T
);end if

;オブジェクトスナップ、エコーモードの戻し
(setvar "OSMODE" Old_Os)
(setvar "CMDECHO" Old_Cm)
(setvar "filedia" Old_Fd)
(princ (strcat "\nデスクトップに" name ".csvを保存しました。"))
(princ)
)

;シェルフォルダパスを取得
(defun getShellfolderPath (key / shell)
(setq shell "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders")
(vl-registry-read shell key)
)

;デスクトップのパスを取得
(defun getDesktopPath ( / ) (getshellfolderpath "Desktop") )

早速のご返事有難う御座います。

・・・・・・
もし、表のみを一括ということであれば、もう少し情報が必要です。
文字高さの他に、表の1行の高さやそれぞれの幅、座標値の並べ方（お示しの表だと、X座標の昇順でしょうか）、表に記入する座標の桁数（引出は小数第3位までですが、表内は小数点第1位？それが0の場合は省略？）
条件を明確にすべて示してください。
・・・・・・・

上記の内容に対して

作製希望の件は表だけです。引出線は不要です。
表の1行の高さ＝60mm 幅＝180mm です。
座標値の並べ方＝X座標の昇順で構いません（正直どちらでも問題はありません）
表記の桁数は「小数点第１位」までとして。出来るのであれば小数点の「0」は省略して頂けると助かります。

以上の内容でお願いします。

また、csv出力するLISPの方も今からやってみます。
宜しくお願いします。

んぽ　さん、LISP有難う御座いました。

早速、LISPにして確認しました。結果としてCSVに出来ました。
そこで、CADに貼り付ける場合「OLE」として貼り付けになるのでしょうか。

CADデータとしてCAD図面に変換とか出来ると助かるのですが......
「OLE」のままですと引き延ばしたりして大きさは変えられるのですが毎回微妙にサイズが変わりそうです。

もし、そんな方法がありましたら教えて頂けると助かります。

わがままばかり申しましてすみません。
宜しくお願いします。

編集→形式を選択して貼り付けからAutoCAD図形として貼り付けできます。
詳細は調べてください。

IJCadで動くかどうかは、ちょっと分かりませんが。
コマンド名はhyouです。
※2024/4/12　UCSに対応しました　コマンド中ダイナミック入力をOFFにしました

--------------------------------------------------------
(defun c:hyou ( / ss C_list ent sscnt cnt nR pt hW hH tH p1 p2 bp1 bp2 #osmode #cmdecho #textsize #dimzin #dynmode)
(setq #osmode (getvar "OSMODE"))
(setq #cmdecho (getvar "CMDECHO"))
(setq #textsize (getvar "TEXTSIZE"))
(setq #dynmode (getvar "DYNMODE"))
(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)
(setvar "DYNMODE" (* -1 (abs #dynmode)))

;表の設定
(setq nR 2) ;列の数
(setq hW 180) ;列の幅
(setq hH 50) ;行の高さ
(setq tH 30) ;文字の高さ
(setvar "TEXTSIZE" tH)

;円オブジェクトを選択
(prompt "\n 表を作成する孔を選択: " )
(setq ss (ssget '((0 . "CIRCLE")))) ;孔が円オブジェクトの場合

(setq pt (getpoint "\n表の左上点を指定:"))

;作図用配列作成
(setq C_list (list))
(setq cnt 0)
(setq sscnt (sslength ss))

;孔の中心座標値をリストに格納
(repeat sscnt
(setq ent (entget (ssname ss cnt)))
(setq C_list (append C_list (list (trans (cdr (assoc 10 ent)) 0 1))))
(setq cnt (1+ cnt))
)

;X座標でソート
(setq C_list
(vl-sort C_list
(function (lambda (e1 e2)
(< (car e1) (car e2))))
)
)

;作表
;縦罫線
;外側
(setq pt (trans pt 1 0))
(setq cnt 0)
(repeat 2
(setq p1 (list (+ (car pt) (* (* hW nR) cnt)) (cadr pt) 0.0))
(setq p2 (list (+ (car pt) (* (* hW nR) cnt)) (- (cadr pt) (* hH (+ 2 sscnt))) 0.0))
(entmake (list (cons 0 "LINE")
(cons 10 p1)
(cons 11 p2)
)
)
(setq cnt (1+ cnt))
)
;内側
(setq cnt 1)
(repeat (- nR 1)
(setq p1 (list (+ (car pt) (* hW cnt)) (- (cadr pt) hH) 0.0))
(setq p2 (list (+ (car pt) (* hW cnt)) (- (cadr pt) (* hH (+ 2 sscnt))) 0.0))
(entmake (list (cons 0 "LINE")
(cons 10 p1)
(cons 11 p2)
)
)
(setq cnt (1+ cnt))
)
;横罫線
(setq cnt 0)
(repeat (+ sscnt 3)
(setq p1 (list (car pt) (- (cadr pt) (* hH cnt)) 0.0))
(setq p2 (list (+ (car pt) (* hW nR)) (- (cadr pt) (* hH cnt)) 0.0))
(entmake (list (cons 0 "LINE")
(cons 10 p1)
(cons 11 p2)
)
)
(setq cnt (1+ cnt))
)

;文字記入
(setq pt (trans pt 0 1))
(setq #dimzin (getvar "DIMZIN"))
(setvar "DIMZIN" 8)
(setq cnt 0)

(setq bp1 (list (+ (car pt) (* hW 0.5)) (- (cadr pt) (/ hH 2) (* hH (+ cnt 1))) 0.0))
(setq bp2 (list (+ (car pt) (* hW 1.5)) (- (cadr pt) (/ hH 2) (* hH (+ cnt 1))) 0.0))
(command "-text" "J" "MC" bp1 "" 0 "X")
(command "-text" "J" "MC" bp2 "" 0 "Y")

(repeat sscnt
(setq bp1 (list (+ (car pt) (* hW 0.5)) (- (cadr pt) (/ hH 2) (* hH (+ cnt 2))) 0.0))
(setq bp2 (list (+ (car pt) (* hW 1.5)) (- (cadr pt) (/ hH 2) (* hH (+ cnt 2))) 0.0))
(command "-text" "J" "MC" bp1 "" 0 (rtos (car (nth cnt C_list)) 2 1))
(command "-text" "J" "MC" bp2 "" 0 (rtos (cadr (nth cnt C_list)) 2 1))
(setq cnt (1+ cnt))
)

(setvar "OSMODE" #osmode)
(setvar "CMDECHO" #cmdecho)
(setvar "TEXTSIZE" #textsize)
(setvar "DIMZIN" #dimzin)
(setvar "DYNMODE" #dynmode)

(princ)
)

さっき投稿した内容は、IJCADでは動かないので、投稿を削除しました。
改めてIJCADで動くものを書き込みます。

実行したら、円を選択。
表を書き込みたい位置をクリック。

です。

ついでにクリップボードにも情報をコピーしていますので、
EXCEL上で貼付けをすると、セルに書き込む事もできます。

注意：
外形寸法は最後に選択した円の寸法を表示しています。
文字スタイル管理で、文字高さを0にしておいてください。
表に書き込まれる順番は、円を選択した順になると思います。
窓選択で一括で複数選択した場合は、ランダムです。
何かの順番で並べたい場合は、並べたい順番に1個づつクリックして選択するか、
何かの順番に並べ替えるソートプログラムを追記して下さい。

(defun C:circle_clip ( / ss ent i gp prop html kei x y)

(if (setq ss (ssget '((0 . "CIRCLE"))))
(progn
(setq i 0)
(setq ssl (+ (sslength ss) 2))
(setq gp (getpoint))
(command "undo" "be" "ucs" "m" "non" gp)
(command "line" "non" "0,0" "non" (strcat "0,-" (rtos (* 60 ssl) 2 2)) "")
(command "line" "non" "180,-60" "non" (strcat "180,-" (rtos (* 60 ssl) 2 2)) "")
(command "line" "non" "360,0" "non" (strcat "360,-" (rtos (* 60 ssl) 2 2)) "")

(command "line" "non" "0,0" "non" "360,0" "")
(command "line" "non" "0,-60" "non" "360,-60" "")
(command "line" "non" "0,-120" "non" "360,-120" "")
(command "-text" "non" "65,-105" "30" "0" "X")
(command "-text" "non" "245,-105" "30" "0" "Y")

(setq prop "径\tX座標\tY座標")

(repeat (sslength ss)
(setq ent (entget (ssname ss i)))
(setq kei (strcat "%%C"(rtos (* 2 (cdr (assoc 40 ent))) 2 0)))
(setq x (rtos (car (cdr (assoc 10 ent))) 2 1))
(setq y (rtos (cadr (cdr (assoc 10 ent))) 2 1))
(setq prop (strcat prop "\n" kei "\t" x "\t" y))
(command "line" "non" (strcat "0," (rtos (- -180 (* 60 i)) 2 2)) "non" (strcat "360," (rtos (- -180 (* 60 i)) 2 2)) "")
(command "-text" "non" (strcat "15," (rtos (- -165 (* 60 i)) 2 2)) "30" "0" x)
(command "-text" "non" (strcat "195," (rtos (- -165 (* 60 i)) 2 2)) "30" "0" y)
(setq i (1+ i))
)
(command "-text" "non" "130,-45" "30" "0" kei)
(command "ucs" "p" "undo" "e")

(vl-load-com)
(setq html (vlax-create-object "htmlfile"))
(vlax-invoke (vlax-get (vlax-get html 'ParentWindow) 'ClipBoardData) 'setData "Text" prop)
(vlax-release-object html)
(print "選択した円のプロパティをクリップボードにコピーしました。")
)
)
(princ)
)

コマンドの説明

表は現在層、現在の色・線種で作成されます。
孔を示す円オブジェクトを選択→表の左上位置指定です。

文字サイズ、表のサイズは指定された通り。
Lisp内の表の設定の部分を変更することで、お好みの設定に。

んぽ　さん
LUNE　さん
通りすがりの人　さん

有難う御座いました。どれも動きます。

ただ、LUNE　さんのLISPも、通りすがりの人　さんのLISPも座標値がちょっと違って表記されます。
後学の為にお伺いしたいのです。

今、孔の原点を「原点（USC）」にて左上を0，0にした上でLISPを起動しています。
なのに全く違う所を原点と認識しているのです。（まったく関係のない所）
それは、どういった事でしょうか。
こちらの操作の改善にて直るのなら教えて頂ければと思います。
宜しくお願いします。

ワールド座標で使う事が前提になっていました。
UCSでの座標値であるなら、座標変換のコードを追加すれば良いです。

初めから作り替えたらもっと綺麗なコードが作れますが、
先のコードを無理やり流用して作りました。

(defun C:circle_clip ( / ss ent i gp prop html kei x y ssa)

(if (setq ss (ssget '((0 . "CIRCLE"))))
(progn
(setq i 0)
(setq ssl (+ (sslength ss) 2))
(setq gp (getpoint))
(setq ssa (ssadd))
(command "undo" "be")
(command "line" "non" "0,0" "non" (strcat "0,-" (rtos (* 60 ssl) 2 2)) "")
(ssadd (entlast) ssa)
(command "line" "non" "180,-60" "non" (strcat "180,-" (rtos (* 60 ssl) 2 2)) "")
(ssadd (entlast) ssa)
(command "line" "non" "360,0" "non" (strcat "360,-" (rtos (* 60 ssl) 2 2)) "")
(ssadd (entlast) ssa)

(command "line" "non" "0,0" "non" "360,0" "")
(ssadd (entlast) ssa)
(command "line" "non" "0,-60" "non" "360,-60" "")
(ssadd (entlast) ssa)
(command "line" "non" "0,-120" "non" "360,-120" "")
(ssadd (entlast) ssa)
(command "-text" "non" "65,-105" "30" "0" "X")
(ssadd (entlast) ssa)
(command "-text" "non" "245,-105" "30" "0" "Y")
(ssadd (entlast) ssa)

(setq prop "径\tX座標\tY座標")

(repeat (sslength ss)
(setq ent (entget (ssname ss i)))
(setq kei (strcat "%%C"(rtos (* 2 (cdr (assoc 40 ent))) 2 0)))
(setq x (rtos (car (trans (cdr (assoc 10 ent)) 0 1)) 2 1))
(setq y (rtos (cadr (trans (cdr (assoc 10 ent)) 0 1)) 2 1))
(setq prop (strcat prop "\n" kei "\t" x "\t" y))
(command "line" "non" (strcat "0," (rtos (- -180 (* 60 i)) 2 2)) "non" (strcat "360," (rtos (- -180 (* 60 i)) 2 2)) "")
(ssadd (entlast) ssa)
(command "-text" "non" (strcat "15," (rtos (- -165 (* 60 i)) 2 2)) "30" "0" x)
(ssadd (entlast) ssa)
(command "-text" "non" (strcat "195," (rtos (- -165 (* 60 i)) 2 2)) "30" "0" y)
(ssadd (entlast) ssa)
(setq i (1+ i))
)
(command "-text" "non" "130,-45" "30" "0" kei)
(ssadd (entlast) ssa)
(command "move" ssa "" "non" "0,0" "non" gp "undo" "e")

(vl-load-com)
(setq html (vlax-create-object "htmlfile"))
(vlax-invoke (vlax-get (vlax-get html 'ParentWindow) 'ClipBoardData) 'setData "Text" prop)
(vlax-release-object html)
(print "選択した円のプロパティをクリップボードにコピーしました。")
)
)
(princ)
)

UCSの対応してませんでした。
上記のLISPを修正しましたので、そちらをお使いください。

みなさん、有難う御座いました。

細かい要望まで聞いて下さり感謝します。
どれも、みどとに動いています。これで、さらにLISPも勉強して将来は自分でも作れるようになっていきたいものです。

本当に有難う御座いました。