初めまして。

瑞海と申します。よろしくお願い致します。

『JDrafについての掲示板』ですが、AutoCADでのLispの質問です。

まだ、全くのLisp初心者なのですが、暗中模索、試行錯誤で下記のLispを作ってみました。

図面上にある複数個あるブロックの名前とその数を取得して、Textで書き出す、というものです。



;ブロックネームリスト
(defun c:BNL( / ss1 ss2 cnt num num1 numnum mo l1 ll et 
			p1 po po_x po_y popo bn bnbn bn_l)
(princ "\nブロックネームリスト Text書き出し")

	(setq p1 (getpoint "\n 1点目をクリック"))
	(setq p2 (getcorner p1 "\n ２点目をクリック"))

        (setq ss1(ssget"_C" p1 p2 (list (cons 0 "INSERT"))))
	(setq cnt 0)
        (setq num (sslength ss1))

	(while (< cnt num)
                  (setq l1(ssname ss1 cnt))
                  (setq et(entget l1))
                  (setq bn (assoc 2 et))
		  (if (= (member bn bn_l) nil)
                  	(setq bn_l (append bn_l (list bn)))
		  );if

                  (setq cnt(1+ cnt))
           );wh

	(setq ll (length bn_l))

		(setq po (getpoint "\n点をクリック:"))

	(setq cnt 0)

	(while (< cnt ll)
		(setq bnbn (cdr (nth cnt bn_l)))
		(setq ss2 (ssget "_C" p1 p2 (list (cons 2 bnbn))))
		(setq num1 (sslength ss2))
			(setq numnum (rtos num1 2 0))

		(setq mo (strcat bnbn "  " numnum "本"))

			(setq po_x (car po))
			(setq po_y (car(cdr po)))
				(setq popo (list po_x (- po_y 250)))

			(entmake (list '(0 . "TEXT")
				(cons 8 "文字")
				(cons 7 "明朝")
				(cons 41 0.5)
				(cons 62 2)
				(cons 10 popo)
				(cons 40 150)
				(cons 1 mo)
			));文字作成
		(setq po popo)
          (setq cnt(1+ cnt))
	);wh
   (princ)
　)

編集

すみません。。。

送信されてしまいました。

続きです。

このLisp、おおきな、欠点が２つあります。

１つ目は、ブロックの選択忘れがあっても、再選択できないこと。

２つ目は選択時、どのブロックを選択したのか非常に分かりづらいことです。


１回目のssgetでブロックの種類を抽出。
２回目のssgetで(list (cons 2 bnbn))を使い、ブロック名ひとつひとつの数を抽出しています。

ssgetが１回で済むのでしたらすべて問題がクリアできるのですが、私にはこの方法しか思いつきませんでした。

ssget、１回で済むようにできるよう、ヒントを頂けないかと思い投稿させて頂きました。

ちなみにdataextraction　コマンドは知っているつもりです。

なにとぞよろしくお願いいたします。

編集

瑞海さん、はじめましてこんにちは。

ご質問の件ですが、わたしの場合は安直かもしれませんが、
選択セットにブロックのみを取得して、ブロックの名前で個数を数えていく方法をとりました。

瑞海さんのlispを利用させて頂き、選択セットの取得方法とブロックの数える箇所を
変更させてもらいました。

AutoCADでは試していませんが、jDraf、aresともに実行することが出来ましたので
ご参考になれば幸いです。


;ブロックネームリスト
(defun c:BNL( / test i ss1 cnt num num1 numnum mo l1 ll et 
			p1 po po_x po_y popo bn bnbn bn_l)
(princ "\nブロックネームリスト Text書き出し")

	(setq test (list (cons -4 "<or")))
	(setq test (append test (list (cons 0 "INSERT"))))
	(setq test (append test (list (cons -4 "or>"))))
	(setq ss1 (ssget test))

	(setq cnt 0)
        (setq num (sslength ss1))

	(while (< cnt num)
                  (setq l1(ssname ss1 cnt))
                  (setq et(entget l1))
                  (setq bn (cdr (assoc 2 et)))
		  (if (= (member bn bn_l) nil)
                  	(setq bn_l (append bn_l (list bn)))
		  );if
                  (setq cnt(1+ cnt))
	);wh

	(setq ll (length bn_l))
	(setq po (getpoint "\n点をクリック:"))

	(setq cnt 0)
	(while (< cnt ll)
		(setq bnbn (nth cnt bn_l))
		(setq i 0)
		(setq num1 0)
		(while (< i (sslength ss1))
			(setq l1(ssname ss1 i))
                 	(setq et(entget l1))
			(setq bn (cdr (assoc 2 et)))

		  	(if (= bn bnbn)
				(setq num1 (+ num1 1))
		  	);if
			(setq i (+ i 1));
		);while

		(setq numnum (rtos num1 2 0))

		(setq mo (strcat bnbn "  " numnum "本"))

		(setq po_x (car po))
		(setq po_y (car(cdr po)))
		(setq popo (list po_x (- po_y 250)))

		(entmake (list '(0 . "TEXT")
			(cons 8 "文字")
			(cons 7 "明朝")
			(cons 41 0.5)
			(cons 62 2)
			(cons 10 popo)
			(cons 40 150)
			(cons 1 mo)
		));文字作成
		(setq po popo)
          	(setq cnt(1+ cnt))
	);wh
   (princ)
　)

編集

お世話になります！

返信、ありがとうございます！

無事、私の環境でも動いてくれました。完璧です！！

＞ブロックの名前で個数を数えていく方法をとりました。

やはり、そう考えますよね。
しかし、どうしても私には作れませんでした。。。

どのようにしてカウントしているのかパッと見には私にはまだ解りかねるのですが、
これから腰を据えて読み解いてみようと思います。

本当にありがとうございました。

また、どうしてもわからない事がありましたら、ご迷惑でなかったら、ご教示よろしくお願い致します。

編集