注目の投稿

技術者として人として

 技術者として人として これまで、生きてきて、ひとりで解決していくものと考えていた。 知り合いなどの助言もあるが、それだけでも、やり切れない場合があった。 長い間、この性格を作り上げてきて正確などは、変わることがないだろうと決めつけていた。 思考は、そうそう簡単には変わらないもの。 ひとりでは、変わらないものであるということに気づくことができた。 日本では、カウンセリングという文化が浸透していないが、古くは仏教など、生活の為に、必要な事を、学ぶ機会が少ないと思う。 カウンセリングは、それを、実現できるものと思う。 ひとりでは解決できないこと、それは、正しい方法を見つけられないから。それを、学んでいないからで、専門的な第三者が心理学などを通して教えてくれることは救いとなる。 生きにくい世の中であることは間違いない。 生きやすくする方法もあると知ることができた。 技術者は孤独になるときがあり、ひとりでなんともならない時の対策方法を見失う時がある。日本ではカウンセリング文化が浸透していないような気がするが、ひとりでは解決出来ない時。救われる方法があると知る事になる。 https://t.co/LBKNwUyXg5 — chsugiyama (@chx_sugi_001) January 3, 2023
コメントを投稿

エクセルからAUTOCADで選択中の円の座標を取得（Ver.2）

 エクセルからAUTOCADで選択中の円の座標を取得


選択している円のデータ情報を知りたいという質問がありましたので、下記のように変更しました。

エクセルのVBAのみで、Autocad側のマクロの操作はありません。

SelectionSets.Add　選択セットを使用しています。VBAの最後に削除しています。


AUTOCADのコードでは、ThisDrawingですが、Excelから設定するには、AcadDocと書き直します。
ThisDrawing.SelectionSets.Add("Sample")
AcadDoc.SelectionSets.Add("Sample") 

AcadDocは下記のように定義
Set AcadDoc = AcadApp.ActiveDocument()

参照設定
AutoCAD 2021 Type Library にチェックしています。


  • AUTOCADで、選択した円のデータを抽出
１．エクセルで、マクロ起動。

２．AUTOCAD画面で円を選択。
　　右クリックで確定
３．VBA 動作　
　　円を青色に変更、Excelに座標を書き出す。

  • VBA CODE　エクセル

Option Explicit

Private AcadDoc As AutoCAD.AcadDocument     'ﾓｼﾞｭｰﾙ定義
Private AcadApp As AutoCAD.AcadApplication  ' AutoCAD アプリケーション変数


Public Sub AutocadSelectionSET()

    Set AcadApp = GetObject(, "AutoCAD.Application")    ' xls追加
    Set AcadDoc = AcadApp.ActiveDocument()
         
    Dim objSelSet As AcadSelectionSet
    Dim objEntity As AcadEntity

    Dim objCircle As AcadCircle
    Dim Str As String
    Dim N

    Set objSelSet = AcadDoc.SelectionSets.Add("Sample")  'いったん選択セットを設定する。
    
    Call objSelSet.SelectOnScreen ' autocad 画面上で、円を選択する。マクロ起動後にAUTOCAD画面で選択する。


    N = ActiveCell.Row
         
         Cells(N, ActiveCell.Column + 0) = "objCircle.center(0)"
         Cells(N, ActiveCell.Column + 1) = "objCircle.center(1)"
         Cells(N, ActiveCell.Column + 2) = "objCircle.center(2)"



    N = ActiveCell.Row + 1

    For Each objEntity In objSelSet
      
      If objEntity.ObjectName = "AcDbCircle" Then
         Set objCircle = objEntity
           
         'Str = "OBJ name" & objEntity.ObjectName & "半径" & objCircle.Area & vbCrLf & "中心座標" & objCircle.center(0) & "," & objCircle.center(1) & "," & objCircle.center(2)
            ' MsgBox Str
           
            ' MsgBox "ECXEL 現在のセルの左に入力します。"
            
         Cells(N, ActiveCell.Column + 0) = objCircle.center(0)
         Cells(N, ActiveCell.Column + 1) = objCircle.center(1)
         Cells(N, ActiveCell.Column + 2) = objCircle.center(2)
         
      
         objEntity.Color = acBlue  '　選択した円を青くする。不要の場合は削除する。
      
         N = N + 1
      End If
    Next
    

    AcadDoc.SelectionSets("Sample").Delete      '使用後　選択セット削除する。

End Sub


コメント

コメントを投稿

このブログの人気の投稿

DesignSpark Mechanical オブジェクトの拡大、縮小　"Scale the body"

イメージ
デザインスパークメカニカル　オブジェクトの拡大、縮小 DesignSpark Mechanical "Scale the body" デザインスパークは無料のソフトですけど、使いやすいソフトです。使い方が分からない所がありますが、大体の事は出来ると思います。 その中でも、拡大縮小は、分かりませんでしたが、調べてみると下記の方法でちゃんと、数値入力でも可能ということが分かりましたので、メモします。 説明動画YOUTUBE  https://youtube.com/shorts/XwRMVjA6BDI?feature=share 説明動画YOUTUBE  プル　ボディをスケール https://youtu.be/VexvsAR076Q 操作説明 編集メニューの「プル」上部の赤矢印をクリック後に、アイコン「ボディをスケール」赤矢印 により、拡大、縮小が可能になります。 操作方法 「ボディをスケール」をクリック 下の図のアイコンをクリック。アイコンが選択されると大きくなります。 アンカーポイントを選択 ボディをスケール(拡大縮小したいオブジェクト)するアンカーポイントを選択する。 左下の角を選択すると、下記のように、選択された点に、マークが表示されます。 ※オブジェクトを選択後に、アンカーポイントを選択しても可能です。 アンカーポイントが基準の位置になります。 この位置（アンカーポイント）は変わりません。 拡大、縮小したいオフジェクトを選択する。 オブジェクトの選択は、ストラクチャのSOLIDを選択。 下の図の場合は、「四角」と、「NF3(ABT)」のSOLID、複数のSOLIDを選択しています。 ※オブジェクト選択後にアンカーポイントを選択しても可能です。 右のプル矢印（赤丸部）が表示されます。 この矢印をドラックまたは、数値を入力することで、拡大、縮小が可能。 数値を入力すると数値入力。ドラックすると、任意のサイズに拡大縮小が出来ます。 動画では、数値入力で２倍、0.5倍などを行っています。 その他の操作方法リンク DSMについて DSM 曲線SOLIDからパスを作成する方法 DSM コピー COPY方法 DSM オブジェクトの拡大、縮小 DSM5 Solidの分割 DSM コンポーネントの移動ができない DSM5 で、2つの図の面(角度)を合わせる...
続きを読む

EXCEL VBA EXCELの表からAUTOCADの文字を書き換える.　EXCEL VBA Rewrite the characters of AUTOCAD from the table of EXCEL.

イメージ
EXCEL VBA EXCELの表からAUTOCADの文字を書き換える.　 EXCEL VBA Rewrite the characters of AUTOCAD from the table of EXCEL. エクセルの変換表にしたがって、AUTOCADの文字列を変更するコードです。 A1セルに検索する文字、名前を「検索文字」 B1セルに変換後の文字、名前を「変換文字」 としておきます。 下記のコードは、マルチテキストです、 If ent.ObjectName = "AcDbMText" Then　 この行で、マルチテキストかどうかを判断しています。 ここを、ダイナミックテキストにする場合には、 If ent.ObjectName = "AcDbText" Then　 とします。 オブジェクトの名前が、わからなかったのですが、ブレークポイントを、図の位置に設定しておいて CADの図に、両方のマルチテキストと、ダイナミックテキストを書いておいて、 ブレークポイントに止まったときに、ent.ObjectName の内容を確認することで、 確認することが出来ました。 ObjectNameが分からないときには、円や、Line、Solidなど、 CAD上に作図しておき、ブレークポイントで確認することで、Nameを確認することが出来ます。 ただ、ブロックの属性について、調べていたのですが、まだ、分かっていません。 ローカルウインドウに、何か、表示されていないかと、調べたのですが、探しきれませんでした。 ただし、ブロックエディタの画面でも、テキストの内容がわかりますので、 ブロックエディタ画面で、文字の変更は可能です。 おそらく、Block, Model,Paper このあたりが、なにかあるとおもっているのですが。 下記のコードはモデル空間に対してのマクロになり、ブロックに対しては、違う方法になるのだと、 現在は、１文字ですが、これを、FOR分などで、変換文字列をぞれぞれ、確認するようにすれば、 CAD上の文字変換が可能になります。 変換する文字のサイズの変更や、色の変更も、たぶん必要になってくると思っています。 サン...
続きを読む

エクセルからパワーポイントのノートを書き込むVBA

イメージ
エクセルからパワーポイントのノートを書き込むVBAを作成しました。 エクセルには、ページ数と、ノートの項目を入力しておきます。 セルの内容を、各ページのノートに入力します。 開いているパワーポイントに対して、処理をします。 現状の問題点 エクセルのセルの中で改行がある場合に、パワーポイントでは１行となるところを、下記の判定を追加することで、パワーポイントのノートに改行を追加することが出来ました。 これを、下記のコードに盛り込めば、対応が可能にあります。         If InStr(str, vbLf) Then             str = Replace(str, vbLf, vbVerticalTab)         End If エラーの処理がないので、パワーポイントのファイルが開いていない場合には、エラーで止まります。 改善点としては、 ファイルの指定をしておいて、一度に、複数のファイルに対して、処理をするということも検討中。 Sub ExceltoPPtNote()     Dim varRng As Variant     Dim intSNum As Integer     Dim i, j As Integer     Dim MaxPage As Long       Dim PpApp As PowerPoint.Application     Dim PpPrs As PowerPoint.Presentation     Set PpApp = CreateObject("PowerPoint.Application")     Set PpPrs = PpApp.Presentations.Item(1)       MaxPage = Range("ページ数")   ...
続きを読む