CODE16：選択したポリラインの個別辺長を一括表記
2023年05月16日
;選択したポリラインの個別辺長を一括表記;+++++++++++++(defun C:CODE16 ();+++++++++++++ (princ "\nLWPOLYLINEを選択") (setq Obj (ssget (list (cons 0 "LWPOLYLINE")))) (if (not(= Obj nil));最適化ポリラインが選択されていたら・・・ (progn (setq cnt 0) (setq num (sslength Obj)) ;------ (Command "OsnapCoord" "1" "-Layer" "M" "FlagLength" "") ;------ (while (< cnt num); (setq tmpl (ssname Obj cnt)) (setq ent (entget tmpl)) (setq MyHandle (cdr (assoc 5 ent)));ハンドル名 (setq MyFlag (cdr (assoc 70 ent)));ポリライン フラグ ;------ (setq npsu (cdr (assoc 90 ent));頂点数 pstl ent nc 0) (repeat npsu;頂点数 (setq Pt (cdr (assoc 10 pstl));LWPOLYLINEの頂点座標を取得 Pt (trans Pt tmpl 0);OCS座標からWCS座標に変換 Pt (trans Pt 0 1));WCS座標からUCS座標に変換 ;------ (setq Ptx (car Pt) Pty (cadr Pt)) (setq ppnl (assoc 10 pstl) pstl (member ppnl pstl) pstl (cdr pstl)) (if (= nc 0) (progn (setq lppnt (list ppnt)) (setq Pt1 Pt Pt1x Ptx Pt1y Pty) (setq Pt0 Pt Pt0x Ptx Pt0y Pty) );progn (progn (setq lppnt (append lppnt (list ppnt))) (setq Pt2 Pt Pt2x Ptx Pt2y Pty) ;中点座標 ;+++++++++++++ (setq PtXm (/ (+ Pt1x Pt2x) 2) PtYm (/ (+ Pt1y Pt2y) 2)) (setq PtXm (rtos PtXm ) PtYm (rtos PtYm )) ;+++++++++++++ (setq Ptm (strcat PtXm "," PtYm)) (setq ObjLength (distance Pt1 Pt2)) (Command "ID" Ptm "Ucs" "w" "-MText" "@" "J" "BC" "@0,0" (Strcat (rtos ObjLength)) "" "Ucs" "p" "Grips" "2" );Command (setq Pt1 Pt Pt1x Ptx Pt1y Pty) );progn );if (setq nc (+ nc 1)) );repeat (if (= MyFlag 1);閉じたポリライン (progn ;中点座標 ;+++++++++++++ (setq PtXm (/ (+ Pt1x Pt0x) 2) PtYm (/ (+ Pt1y Pt0y) 2)) (setq PtXm (rtos PtXm ) PtYm (rtos PtYm )) ;+++++++++++++ (setq Ptm (strcat PtXm "," PtYm)) (setq ObjLength (distance Pt1 Pt0)) (Command "ID" Ptm "Ucs" "w" "-MText" "@" "J" "BC" "@0,0" (Strcat (rtos ObjLength)) "" "Ucs" "p" "Grips" "2" );Command );progn );if (setq cnt (1+ cnt)) );while );progn ;最適化ポリラインが選択されていなかったら・・・ (alert "選択エラー：最適化ポリラインが選択されていません") ):if (princ))
