AutoCADマクロ屋本舗 掲示板

AutoCAD 2026使用しています。

添付したファイルのように一括でトリムをしたいのですが、マクロ及びlspお持ちの方いらっしゃいませんか？
宜しくお願いいたします。

この時いろいろ調べたけどマクロは無理だったです
AutoLISPでも難しそうですけどね
https://totthi.bbs.fc2bbs.net/?act=reply&tid=16476142

有意義な回答でなくてすいません
とりあえずAutoLISP専門のサイトのほうが見つかるかもしれないです

Lispでも難しいですね。
「内側」の判別が特に難関です。
以下の２通りを思いつきましたが、どちらも完ぺきには動作しなさそうです。

＜A＞
すべての線分の交点ですべての線分を切断し、一定の長さより短い場合は削除
でも、添付図のように包絡される部分とそれ以外の線分の長さが明らかに異なる場合はうまくいくと思いますが、残す部分に包絡される部分より短い線分が作成される場合は、これだとうまくいかないです。

＜B＞
１つの線分に対し、他の線分との交点リストを作成して座標順に並べ、奇数番目から偶数番目の交点の間を削除
ただし、交点の数は必ず偶数である必要があります。余計な線分が混じって奇数になると、線分の始点側から削除するのか、終点側から削除するのかで結果が変わってしまいます。

chibi-tom様　LUNE様
　
やはり難しいようです。
ありがとうございました。

やはり一括は無理だなぁ
添付図だと矩形作図を５回繰り返して右クリックで縦横切替した後に矩形作図を５回繰り返し

*^C^C$M=setenv;to;0;$(nth,$(getenv,to),;hv;縦線切断;;sw;0;;to;1,,,,,,)$(nth,$(getenv,to),,ray;切り取りエッジの一方のコーナーを指定(R-Clickで切り替え)<$(getenv,hv)>^X\$M="""$(if,$(getvar,CMDACTIVE),;setenv;to;2,setenv;to;6)""",,,,,)$(nth,$(getenv,to),,,undo;be;rectang;non;@;\erase;all;r;l;;zoom;e;$(if,$(getenv,sw),setenv;to;4,setenv;to;3),,,,)$(nth,$(getenv,to),,,,;p1;$(-,$(index,0,$(getvar,extmin)),1)","$(+,$(index,1,$(getvar,extmin)),1);;p2;$(+,$(index,0,$(getvar,extmax)),1)","$(-,$(index,1,$(getvar,extmax)),1);;to;5,,,)$(nth,$(getenv,to),,,,,;p1;$(+,$(index,0,$(getvar,extmin)),1)","$(-,$(index,1,$(getvar,extmin)),1);;p2;$(-,$(index,0,$(getvar,extmax)),1)","$(+,$(index,1,$(getvar,extmax)),1);;to;5,,)$(nth,$(getenv,to),,,,,,undo;e;u;zoom;w;non;$(getenv,p1);non;$(getenv,p2);trim;;f;non;$(getenv,p1);non;$(getenv,p2);;;zoom;p;setenv;to;1,)$(nth,$(getenv,to),,,,,,,;hv;$(if,$(getenv,sw),縦線切断,横線切断);;sw;$(if,$(getenv,sw),0,1);;to;1)^M

１.マクロ起動
２.トリムする部分の交点で矩形作図(最初は縦線切断状態)
※右クリックで縦横切替
終了はESCキーです

1列単位なのであまり省略はできていないかもですが自己満足です
LT2026で試しています

R版なのでsetenv,getenvが使用できなかったら
MAIN MENUの【レギュラー版での使用に関する注意事項】
https://ameblo.jp/totthi-macro/entry-10895232361.html
を対応してください

内緒で仮レイアウトなしに変更してます(´∀｀*)

条件：
線分専用（ポリラインは不可なので、分解して使用）
水平・垂直線のみ
添付画像の白の線のみ選択（赤の周囲の線は選択しない事）

(defun c:LineTrim (/ ss i en p1 p2 ang h-list v-list h-min h-max v-min v-max waku yohaku)
(vl-load-com)

;; 線分を一括選択
(princ "\n線分を選択してください:")
(if (setq ss (ssget '((0 . "LINE"))))
(progn
(setq h-list '()
v-list '())

(repeat (setq i (sslength ss))
(setq en (ssname ss (setq i (1- i)))
p1 (trans (cdr (assoc 10 (entget en))) 0 1)
p2 (trans (cdr (assoc 11 (entget en))) 0 1)
ang (angle p1 p2))

(setq tol-ang (/ pi 180.0)) ; 1度未満の傾きは水平垂直とする

(cond
;; 水平判定
((or (< (abs ang) tol-ang)
(< (abs (- ang pi)) tol-ang)
(< (abs (- ang (* 2 pi))) tol-ang))
(setq h-list (cons (cadr p1) h-list)))

;; 垂直判定
((or (< (abs (- ang (/ pi 2.0))) tol-ang)
(< (abs (- ang (* pi 1.5))) tol-ang))
(setq v-list (cons (car p1) v-list)))
)
)

;; ソートと重複削除 (0.1未満のズレは重複として削除)
(setq h-list (process-coords h-list))
(setq v-list (process-coords v-list))

;; 編集範囲（最小・最大値）を取得
(if (and h-list v-list)
(progn
(setq h-min (car h-list)
h-max (car (reverse h-list))
v-min (car v-list)
v-max (car (reverse v-list))
yohaku (/ (- h-max h-min) 20)
waku (list (list (- v-min yohaku) (- h-min yohaku)) (list (+ v-max yohaku) (+ h-max yohaku))))

(command "undo" "be" "zoom" "w" "non" (car waku) "non" (cadr waku))
;; 水平線の中間をトリム
(mid-trim h-list v-min v-max "H" waku)
;; 垂直線の中間をトリム
(mid-trim v-list h-min h-max "V" waku)
(command "zoom" "p" "undo" "e")

(princ "\n完了しました。")
)
(princ "\n水平線または垂直線のどちらかが不足しているため、トリムできません。")
)
)
(princ "\n線分が選択されませんでした。")
)
(princ)
)

;; 補助関数: ソートおよび重複削除
(defun process-coords (lst / res last-val)
(if lst
(progn
(setq lst (vl-sort lst '<))
(setq res (list (car lst))
last-val (car lst))
(foreach x (cdr lst)
(if (>= (abs (- x last-val)) 0.1)
(setq res (cons x res)
last-val x)
)
)
(reverse res)
)
nil
)
)

;; 補助関数: 中間をトリムする
(defun mid-trim (lst min-val max-val mode waku / p1 p2 mid-val)
(while (>= (length lst) 2)
;; 1番目と2番目を取り出して中点を計算
(setq mid-val (/ (+ (car lst) (cadr lst)) 2.0))

(if (= mode "H")
(setq p1 (list min-val mid-val 0.0)
p2 (list max-val mid-val 0.0))
(setq p1 (list mid-val min-val 0.0)
p2 (list mid-val max-val 0.0))
)

;; トリムする
(command "trim" "c" (car waku) (cadr waku) "" "f" "non" p1 "non" p2 "" "")

;; 1番目と2番目をリストから削除して繰り返す
(setq lst (cddr lst))
)
)

ちょっと改造
矩形の作図方向で自動判別(Y座標で判断)にしてみました

*^C^C$M=setenv;to;0;$(nth,$(getenv,to),ray;縦線切断は下コーナー／横線切断は上コーナーを指定(R-Clickで終了)^X\$M="""$(if,$(getvar,CMDACTIVE),;setenv;to;1,^Csetenv;to;0)""",,,,,)$(nth,$(getenv,to),,;p1;$(getvar,lastpoint);undo;be;rectang;non;@;\setenv;p2;$M="""$(getvar,lastpoint)""";erase;all;r;l;;zoom;e;setenv;to;2,,,,)$(nth,$(getenv,to),,,;to;$(if,$(<,$(index,1,$(getenv,p1)),$(index,1,$(getenv,p2))),3,4),,,)$(nth,$(getenv,to),,,,;p1;$(-,$(index,0,$(getvar,extmin)),1)","$(+,$(index,1,$(getvar,extmin)),1);;p2;$(+,$(index,0,$(getvar,extmax)),1)","$(-,$(index,1,$(getvar,extmax)),1);;to;5,,)$(nth,$(getenv,to),,,,,;p1;$(+,$(index,0,$(getvar,extmin)),1)","$(-,$(index,1,$(getvar,extmin)),1);;p2;$(-,$(index,0,$(getvar,extmax)),1)","$(+,$(index,1,$(getvar,extmax)),1);;to;5,)$(nth,$(getenv,to),,,,,,undo;e;u;trim;;f;non;$(getenv,p1);non;$(getenv,p2);;;setenv;to;0)^M

１.マクロ起動
２.縦線切断の場合は下コーナーから指定／横線切断の場合は上コーナーから指定
３.繰り返し(R-CLICKで終了)

不具合発見修正済み(ズーム処理削除)