電気図で 3D CAD を試したときに考えた Lisp

トップページ（index.htm）に戻ります

図面を作って材料集計するのに準備した Lisp 集です。分からないことは Web 頼みで、つぎはぎになりながらも必要なものは用意できました。この Lisp と細かい電気記号シンボルの Block がたくさんあって、ルールに従って作図したなら、図面から材料リストがすぐできる・・・なんてことはないが、あると便利と自負するこの頃。

1. 名前付き Block を作成したあと、その Block に置き換える Lisp
2. Block を他の Block と入れ替える
3. Block 名を変更する
4. 図面上の Block 名とその数をカウントする
5. 図形を指定した Z の位置に移動
6. 名前付き Group を作る
7. Group の名前を変更する
8. Group 化された図形の長さの情報を取得する
9. Group の名前と線分の合計長をリストする
10. Entity 情報の表示
11. 図形を Z 方向にコピーする
12. 図形を Z 方向に移動する

1. 名前付き Block を作成したあと、その Block に置き換える Lisp

定石の Lisp のようで、Web では「Quick Block」と呼ばれたりしているようです。図形を選んで Block にして置き換える。非常に便利。簡易で名前を付けるので、Block 管理画面など、Block を探しやすい。もらった CAD データの図記号が Block 化されていないとき、これを使ってさっさと Block にします。

Block 名は「DENKI」＋連番にしています。

(defun c:BLKCQ (/ selectionset insertionpoint number Blockname)
  (if (and (setq selectionset (ssget "_:L"))
        (setq insertionpoint (getpoint "\n ブロックの挿入基点を指定 :"))
      )
    (progn
      (setq number    1
        Blockname (strcat "DENKI" (itoa number))
      )
      (while (tblsearch "BLOCK" Blockname)
        (setq Blockname
          (strcat "DENKI" (itoa (setq number (1+ number))))
        )
      )
      (command "_.-Block" Blockname insertionpoint selectionset "")
      (command "_.-insert" Blockname insertionpoint "" "" "")
    )
    (princ)
  )
  (princ)
)

このページのトップに戻る

2. Block を他の Block と入れ替える

Block を入れ替える Lisp。どんなときに役に立つかというと、2個口コンセントの Block を、3個口用の Block に変えるとか。あと、もらった CAD データのシンボルをとにかく Block に変更した後、手持ちの Block 化された標準のシンボル図に入れ替えていくとかです。地味に便利。

参考にしたページ：Block replace - Autodesk Community（http://forums.autodesk.com/ のサイトを開きます）

ブロック名の print は不要ですが、何が何に変わったかを知る意味で便利かも。

(defun c:BLKREP (/ Exblk1 Nwblk1 nb ib Extblk1 Nwblkname Newblkname Extblkname Extblk2)
  (prompt "入れ替えるブロックを選択 : ")
  (setq Exblk1 (ssget))
  (setq ensel (car (entsel "挿入するブロックを選択 : ")))
  (if (= "INSERT" (cdr (assoc 0 (entget ensel))))
    (progn
      (setq Newblkname (cdr (assoc 2 (entget ensel))))
      (command "insert" Nwblkname nil)
      (setq nb (sslength Exblk1))
      (setq ib 0)
      (repeat nb
        (setq Extblk1 (entget (ssname Exblk1 ib)))
        (print Extblk1)
        (setq Nwblkname (cons 2 Newblkname))
        (print Nwblkname)
        (setq Extblk2 (assoc 2 Extblk1))
        (print Extblk2)
        (setq Extblkname (cdr Extblk2))
        (print Extblkname)
        (entmod (subst Nwblkname Extblk2 Extblk1))
        (setq ib (1+ ib))
      )
    )
  )
  (prin1)
)

このページのトップに戻る

3. Block 名を変更する

Block 名を変える Lisp。

参考にしたページ：Rename block name: AUGI（http://forums.autodesk.com/ のサイトを開きます）

Block 名を出力する print 行は不要ですが、何が何に変わったかを知る意味で便利かも。

(defun c:BLKRN (/ ent name new)
  (if (and (setq ent (car (entsel "\n名前を変更するブロックを選択 : ")))
    (or (eq "INSERT" (cdr (assoc 0 (entget ent))))
      (alert "Invalid object!")
    )
    (princ (strcat "\n->>> "
      (setq name (cdr (assoc 2 (entget ent))))
        " <<<-"
      )
    )
    (/= "" (setq new (getstring T "\nブロックの新しい名前を指定 : ")))
    )
    (cond
      ((tblsearch "block" new) (alert (strcat "ブロック: " new " 既にあります")))
      ((not (snvalid new)) (alert (strcat "不正なブロック名です: " new)))
      ((snvalid new)
       (command "_.rename" "_block" name new)
       (alert (strcat "\nBlock \"" name "\" renamed to \"" new "\""))
      )
    )
  )
  (princ)
)

このページのトップに戻る

4. 図面上の Block 名とその数をカウントする

Block 名とその数をリストします。よくある集計は Block に付与された Block 定義を集計しますが、これは Block 名だけです。欲しいものが Web にあったので、そっくりそのまま使っています。これをそのまま部材リストに使うので、Block 名はなるべく詳しく設定しておきます。

参考にしたページ：block counting - Autodesk Community（http://forums.autodesk.com/ のサイトを開きます）

このページのトップに戻る

5. 指定した Z の位置に移動

Block や図形などを、指定した位置に移動します。例えばコンセントを Z 上で 300㎜の位置に配置したりします。それぞれの縦位置を決めないと、立ち下がり・立ち上がりのケーブルが描けません。

参考にしたページ：AutoLISP Move only Z-Coord.? [Archive] - AutoCAD Forums（http://www.cadtutor.net/forum/ のサイトを開きます）

print は不要ですが、参考になるかもしれません。
使い方は、最初に移動の基準となる図形を一つ選択 → 移動するものを一つ、または複数選択 → 移動する位置をタイプする。
DXF コード（assoc 10 または 38）から、移動の基準となる図形の Z 位置を調べ、目標とする Z 位置との差分だけ図形を動かします。
条件は、LINE、CIRCLE、ELLIPSE、LEADER、DIMENSION、LWPOLYLINE、INSERT について指定しています。
回転された 3D オブジェクトの場合、X・Y・Z の値が入れ替わったりするところが危険。回避するには、移動の基準となるものが回転されていない 2D オブジェクトにするしか思いつかない。
3DSOLID、3DFACE など 3D に関する DXF コードから Z の値を取得するのが、ちょっと面倒だったので考えなかった。他の 2D オブジェクトとかを移動の基準にするしかない・・・。

(defun c:OMZV( / ensel ss rz ez MoveDist)
  (setq ensel (car (entsel "移動の基準となる図形（線・円・引出し線・ポリライン・ブロック）を一つ選択: ")))
  (setq ss (ssget) rz (getreal "新しい Z 位置をタイプ: "))

  (if (= "LINE" (cdr (assoc 0 (entget ensel))))
    (progn
      (setq ez (caddr(cdr (assoc 10 (entget ensel)))))
    )
  )
  (if (= "CIRCLE" (cdr (assoc 0 (entget ensel))))
    (progn
      (setq ez (caddr(cdr (assoc 10 (entget ensel)))))
    )
  )
  (if (= "ELLIPSE" (cdr (assoc 0 (entget ensel))))
    (progn
      (setq ez (caddr(cdr (assoc 10 (entget ensel)))))
    )
  )
  (if (= "LEADER" (cdr (assoc 0 (entget ensel))))
    (progn
      (setq ez (caddr(cdr (assoc 10 (entget ensel)))))
    )
  )
  (if (= "DIMENSION" (cdr (assoc 0 (entget ensel))))
    (progn
      (setq ez (caddr(cdr (assoc 10 (entget ensel)))))
    )
  )
  (if (= "LWPOLYLINE" (cdr (assoc 0 (entget ensel))))
    (progn
      (setq ez (cdr (assoc 38 (entget ensel))))
    )
  )
  (if (= "INSERT" (cdr (assoc 0 (entget ensel))))
    (progn
      (setq ez (caddr(cdr (assoc 10 (entget ensel)))))
    )
  )
  (print ez)
  (print rz)
  (setq MoveDist (rtos (- rz ez)))
  (print MoveDist)
  (print (strcat "0,0," MoveDist))
  (command "_.move" ss "" "0,0,0" (strcat "0,0," MoveDist))
  (princ)
)

このページのトップに戻る

6. 名前付き Group を作る

ケーブルを示す LINE や LWPOLYLINE をまとめてケーブルの Group を作ります。名前も適当に付与するので、名前無しの場合より Group管理しやすくなります。最初は Block を作る Lisp を基にして考え始めましたが、Block の場合は tblsearch で探すのに対して、 Group は dictsearch や "ACAD_GROUP"を参照しなけれはならず、色々と我流で考えました。

参考にしたページ：Lisp メモ - この中の [G] → Group の項目で、「グループ名の有無グループに属する図形名の取得」が参考になりました

重要なことは、Group の名前は必ず大文字にすることです。これをカッコよく小文字交じりにしたために、Group 名の登録で、何度も失敗しました。 Group 名はすべて大文字で登録されるらしい。失敗する理由が分かったときはうれしいような悲しいような。
ここで Group 名は、「VV-F1.6-2C-」＋「6桁の連番」になっています。単に「1」からの連番にすると、並び替えのときに順番通りにならないので、6桁になるように「0」を付与しています。この Group 名は、あとあとケーブルリストの名前として使いたいので、具体的なケーブル名にしています。とりあえず、Group 名は勝手に付けておいて、後から「グループ管理」で見直すか、lisp ファイルの "VV-F1.6-2C-" 部分を修正しながら使ったりしています。ここで Dialog とかを使って変更できるようにしたらかっこいいんでしょうけど・・・

(defun c:GRPCQ (/ selectionset number Groupname objdict grpdict)
  (setq objdict (namedobjdict))
  (setq grpdict (dictsearch objdict "ACAD_GROUP"))
  (if (setq selectionset (ssget "_:L"))
    (progn
      (setq number 1)
      (setq Groupname (strcat "VV-F1.6-2C-" "00000" (itoa number)))
      (while (member (cons 3 Groupname) grpdict)
        (setq number (1+ number))
	  (cond
	  ((= (strlen(itoa number)) 1)
            (setq Groupnum (strcat "00000" (itoa number)))
	  )
	  ((= (strlen(itoa number)) 2)
            (setq Groupnum (strcat "0000" (itoa number)))
	  )
	  ((= (strlen(itoa number)) 3)
            (setq Groupnum (strcat "000" (itoa number)))
	  )
	  ((= (strlen(itoa number)) 4)
            (setq Groupnum (strcat "00" (itoa number)))
	  )
	  ((= (strlen(itoa number)) 5)
            (setq Groupnum (strcat "0" (itoa number)))
	  )
	  ((= (strlen(itoa number)) 6)
            (setq Groupnum (strcat number))
	  )
        )
        (setq Groupname (strcat "VV-F1.6-2C-" Groupnum))
      )
      (print Groupname)
      (command "_.-group" "c" Groupname "" selectionset "")
    )
    (princ)
  )
  (princ)
)

このページのトップに戻る

7. Group の名前を変更する

Group 名を変更する Lisp について考えましたが、これは CAD の「グループ管理」機能を使った方が、表示なっていて見やすいし、早いです。

このページのトップに戻る

8. Group 化された図形の長さの情報を取得する

Group をひとつクリックして、その Group にまとめられた図形の長さを表示します。これは Group = 1ケーブルとして、そのケーブル長を調べるためのものです。 Group 内の LINE と LWPOLYLINE の長さを表示します。
最初に「合計長をリストする」Lisp ができて、そのあと、Group をひとつだけ調べられると便利と考え、この Lisp ができました。
オブジェクトの長さはプロパティで確認できますが、複数やグループまとめて表示というのは見当たらなかったと思います。
今度は ARC を追加してみたいです。

最初の ssget で、LINE と LWPOLYLINE だけ選択するようにしています。そのため、if 条件も LINE と LWPOLYLINE のみになっています。
LWPOLYLINE の長さについてどうやって計算するか悩んだ。そんなとき、AUGI のフォーラムが大変参考になりました。 (vlax-curve ~) の LWPOLYLINE の長さ計算は、フォーラムに掲載されていたものそのままです。 LWPOLYLINE 内の位置を全部拾うのか・・・とぼうぜんとしていたところに差した光のようなものでした。

(defun c:GRPIF2 (/ ret geten ct tl ctl ctp pl total num e_name e_data sa ea len total SumLength Item)
  (setq geten (ssget '((0 . "LINE,LWPOLYLINE"))))
  (setq ct 0 tl 0 ctl 0 ctp 0 pl 0 total 0)
  (setq num (sslength geten))
  (setq e_name (ssname geten ct))
  (setq ret (Show_Group_Name e_name))
  (print ret)
  (while (< ct num)
    (setq e_name (ssname geten ct))
    (setq e_data (entget e_name))
    (if (= (cdr (assoc 0 e_data)) "LINE")
      (progn
        (setq sa (cdr (assoc 10 e_data)))
        (setq ea (cdr (assoc 11 e_data)))
        (setq len (distance sa ea))
        (setq tl (+ tl len))
        (setq ctl (1+ ctl))
      )
    )
    (if (= (cdr (assoc 0 e_data)) "LWPOLYLINE")
      (progn
        (vl-load-com)
        (setq Item 0 SumLength 0 )
        (setq SumLength (+ SumLength (vlax-curve-getDistAtParam e_name (vlax-curve-getEndParam e_name ))) )
        (setq Item (1+ Item ) )
        (setq len SumLength)
        (setq pl (+ pl len))
        (setq ctp (1+ ctp))
      )
    )
    (setq total (+ total len))
    (setq ct (1+ ct))
  )
  (if (/= ctl 0)
    (princ (strcat "\n" (itoa ctl) " LINE. " (rtos tl 2)))
  )
  (if (/= ctp 0)
    (princ (strcat "\n" (itoa ctp) " LWPOLYLINE. " (rtos pl 2)))
  )
  (princ (strcat "\n" (rtos total 2)))
  (princ)
)

(defun Show_Group_Name ( en / ed gen lst_groupe lst_gname)
  (setq ed (entget en))
  (while (and (not gen) (setq ed (member (assoc 330 ed) ed)))
    (if (= "GROUP" (cdr (assoc 0 (entget (cdar ed)))))
      (setq gen (cdar ed))
    )
    (setq ed (cdr ed))
  )
  (if (and gen (setq lst_group (reverse (dictsearch (namedobjdict) "ACAD_GROUP"))))
    (while (setq lst_group (member (assoc 350 lst_group) lst_group))
      (if (member (cons 340 en) (entget (cdar lst_group)))
        (setq lst_gname (cons (cdadr lst_group) lst_gname))
      )
      (setq lst_group (cdr lst_group))
    )
  )
  lst_gname
)

このページのトップに戻る

9. Group の名前と線分の合計長をリストする

図面上で使われている Group の名前と Group にまとめられた図形の合計長さを表示します。これは 1 Group = 1ケーブルとして、ケーブルとその全長をリストするために考えたものです。この Lisp を作れることが分かったこと、作れたことが、3D CAD での集計を進めるきっかけになった。

集計対象は LINE と LWPOLYLINE だけです。 INSERT、CIRCLE、ARC の場合は、長さを 0 として集計しています。
悩んだところは、色々ありますが、list にどんどん追加するときの append の書き方、そして Group の中にブロックが入っている場合の 340番図形の処理です。 list を作るときに 340 の値がすでに格納されていないか、member と nil でチェックしています。

(defun c:GRPL2 ( / prp dict ret GEIG GEL)
  (setq dict (namedobjdict))
  (setq prp (reverse (dictsearch dict "ACAD_GROUP")))
  (while (assoc 3 prp)
    (princ (strcat "\n" (cdr (assoc 3 prp))))
    (setq GEIG (GetEntityInGroup (cdr (assoc 3 prp))))
    (princ GEIG)
    (setq prp (cdr prp)
      prp (cdr prp)
    )
  )
  (princ)
)

(defun GetEntityInGroup ( GroupName1 / en GE GE2 GroupEnt objdict grpdict e_name ct tl ctl total num e_data sa ea len total SumLength Item)
  (setq objdict (namedobjdict))
  (setq grpdict (dictsearch objdict "ACAD_GROUP"))
  (setq GroupEnt (reverse (dictsearch (cdar grpdict) GroupName1)))
  (while (setq en (assoc 340 GroupEnt))
    (setq GE (cdr en))
    (if (= nil (member GE GE2))
        (setq GE2 (append GE2 (list GE)))
    )
    (setq GroupEnt (cdr (member en GroupEnt)))
  )
  (setq ct 0 tl 0 ctl 0 ctp 0 pl 0 total 0)
  (setq  num (length GE2))
  (while (< ct num)
    (setq e_name (nth ct GE2))
    (setq e_data (entget e_name))
    (if (= (cdr (assoc 0 e_data)) "LINE")
      (progn
        (setq sa (cdr (assoc 10 e_data)))
        (setq ea (cdr (assoc 11 e_data)))
        (setq len (distance sa ea))
        (setq tl (+ tl len))
        (setq ctl (1+ ctl))
      )
    )
    (if (= (cdr (assoc 0 e_data)) "LWPOLYLINE")
      (progn
        (vl-load-com)
        (setq Item 0 SumLength 0 )
        (setq SumLength (+ SumLength (vlax-curve-getDistAtParam e_name (vlax-curve-getEndParam e_name ))))
        (setq Item (1+ Item ) )
        (setq len SumLength)
      )
    )
    (if (= (cdr (assoc 0 e_data)) "INSERT")
        (setq len 0)
    )
    (if (= (cdr (assoc 0 e_data)) "CIRCLE")
        (setq len 0)
    )
    (if (= (cdr (assoc 0 e_data)) "ARC")
        (setq len 0)
    )
    (setq total (+ total len))
    (setq ct (1+ ct))
  )
  (strcat ", " (rtos total 2))
)

このページのトップに戻る

10. Entity 情報の表示

普通、DXF グループコードリストと呼ばれているんでしょうか、図形の情報を表示する Lisp です。フォーラムなどにあるコードそのままです。

参考にしたページ：概要 - 図形情報を取得する(AutoLISP) Autodesk Knowledge Network（https://knowledge.autodesk.com/ のサイトを開きます）

このページのトップに戻る

11. 図形を Z 方向にコピーする

entmod とかで DXF コードを直接書き換えなければダメだとか考えていたのです。しかし、考えてみれば CAD の copy コマンドを使えば良いだけでした。簡単ですけど、3D で図形位置を調整するにはなくてはならないものです。

参考にしたページ：AutoLISP Move only Z-Coord.? [Archive] - AutoCAD Forums（http://www.cadtutor.net/forum/ のサイトを開きます）

(defun c:OCZ ()
  (setq ss (ssget)
    rz (rtos (getreal "Z 方向の複写距離をタイプ: "))
    rd (strcat "0,0," rz)
  )
  (command "_.copy" ss "" "0,0,0" rd)
)

このページのトップに戻る

12. 図形を Z 方向に移動する

copy コマンドを move にしただけです。コピーと同じく、3D 空間で作業するにはなくてはならないものです。

参考にしたページ：AutoLISP Move only Z-Coord.? [Archive] - AutoCAD Forums（http://www.cadtutor.net/forum/ のサイトを開きます）

(defun c:OMZ ()
  (setq ss (ssget)
    rz (rtos (getreal "Z 方向の移動距離をタイプ: "))
    rd (strcat "0,0," rz)
  )
  (command "_.move" ss "" "0,0,0" rd)
)

このページのトップに戻る

海外のフォーラムがけっこう参考になりました。
できるものなら、Lisp だけでなく、VBA に対応してくれるとうれしい。ダイアログやフォームとかを DCL より簡単に作れそうなので。

光回線

ＧＭＯインターネット株式会社【GMOとくとくBB】ドコモ光

株式会社アウンカンパニー【ソフトバンク光キャンペーン】

サーバー・ドメイン

「ロリポップ！」レンタルサーバー

「ムームードメイン」独自ドメイン

低コストで簡単、プロのようなホームページ作成「グーペ」

「ヘテムル」レンタルサーバー

※本ページのイラスト・イメージは、プリントアウトファクトリー様 (https://www.printout.jp/) のクリップアートを使用しています。

HP開設 2003年
2016年9月