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


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

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 化された標準のシンボル図に入れ替えていくとかです。 地味に便利。

ブロック名の 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。

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 名はなるべく詳しく設定しておきます。

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

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

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"を参照しなけれはならず、色々と我流で考えました。

重要なことは、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 です。 フォーラムなどにあるコードそのままです。

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

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

(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 空間で作業するにはなくてはならないものです。

(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 より簡単に作れそうなので。



A8.net ネット特集

光回線

株式会社NEXT【auひかりサイト】

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

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

格安スマホ

ニフティ株式会社 ニフティのMVNOサービス【NifMo】

エヌ・ティ・ティ・コミュニケーションズ株式会社 「OCN モバイル ONE」

モバイル通信

ヤフー株式会社 モバイルルーター【Yahoo! WiFi】

エクスコムグローバル株式会社【海外WiFiならイモトのWiFi】

ページトップに戻る

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

Copyright(c) 有限会社 岡田電工 Okada Denko Ltd. All Rights Reserved.

HP開設 2003年
2016年9月