• 締切済み

AUTOCADで両側オフセットについて

AUTOCAD2015を使用しています。 前回回答いただいたのですが、結果がByLayerに従わなかった為 元要素と同じ色になってしまいました。 それと元々入力値が片側方向のオフセット値なので私の仕事では感違いの元です。 結果を現画層にしたがわせ、入力値が両側にオフセットした結果にする様にしたいのですが ご教授お願い致します。 今のマクロ文は下記です。 ;両側オフセット (defun C:wofset (/ end)   (command "offsetdist" pause)   (setq end 1)   (while (/= nil end)     (command "offset" "" pause)     (if (< 0 (getvar "cmdactive"))       (command "@" "" "change" "l" "" "P" "LA" (getvar "CLAYER") "" "offset" (* 2 (getvar "offsetdist")) (entlast) "@" "" "change" "l" "" "P" "LA" (getvar "CLAYER") "" "offsetdist" (/ (getvar "offsetdist") 2))       (setq end nil)     )   )   (princ) ) どうぞ宜しくお願い致します。

みんなの回答

  • moon00
  • ベストアンサー率44% (315/712)
回答No.1

オフセットした元要素の色が、Bylayerではない場合も、オフセットしたものはBylayerにしたいということでよいしょうか? (defun C:wofset (/ end)   (command "offsetdist" pause)   (setq end 1)   (setvar "offsetdist" (/ (getvar "offsetdist") 2))   (while (/= nil end)     (command "offset" "" pause)     (if (< 0 (getvar "cmdactive"))       (command "@" "" "change" "l" "" "P" "LA" (getvar "CLAYER") "C" "Bylayer" "" "offset" (* 2 (getvar "offsetdist")) (entlast) "@" "" "offsetdist" (/ (getvar "offsetdist") 2))       (setq end nil)     )   )   (princ) ) 前に回答したときに、ちょっと不要なコードもあったので、修正しました。

関連するQ&A

  • AUTOCADで両側オフセットについて

    AUTOCAD 2015を使用しています。 あるホームページにあるLISP文を見つけたのですが、両側オフセットした結果のオブジェクトの 画層が元のオブジェクトと同じになるのですが、現在の画層にできないでしょうか? LISP文は ;両側オフセット (defun C:wofset (/ end)   (command "offsetdist" pause)   (setq end 1)   (while (/= nil end)     (command "offset" "" pause)     (if (< 0 (getvar "cmdactive"))       (command "@" "" "offset" (* 2 (getvar "offsetdist")) (entlast) "@" "" "offsetdist" (/ (getvar "offsetdist") 2))       (setq end nil)     )   )   (princ) ) です。 どうぞ宜しくご教授お願いいたします。

  • AUTO CADの文字の180度、、、

    こないだの質問に対して リスプ 作ったのですが、、、質問が 締め切りになってたので、、、 これだと 回転したい文字 たくさん選んでも 回転できます、、、線分とか 他の図形も 入っても 大丈夫なはずです、、、寸法線とかの文字は 回転してくれません、、、 うちのpcの調子が 悪くて 掲載出来なかったのですが、、、 ああ~~気が付いて くれるといいけどなあ~~ (defun c:t180() (setvar "cmdecho" 0) (setq os (getvar "osmode")) (setvar "mirrtext" 0) (setvar "osmode" 0) (setq e1 (ssget )) (setq ss (sslength e1)) (setq loop 0) (while (< loop ss) (setq b (ssname e1 loop)) (setq et1 (entget b)) (setq txt (cdr (assoc 0 et1))) (setq s1 (cdr (assoc 10 et1))) (setq t1 (cdr (assoc 40 et1))) (setq r1 (cdr (assoc 50 et1))) (if (= "TEXT" txt) (progn (setq r2 (+ r1 (* pi 0.5))) (setq r3 (- r1 pi)) (setq k1 (polar s1 r2 t1 )) (setq rt1 (angtos r1 0 4)) (setq rt2 (angtos r3 0 4)) (command "rotate" b "" s1 "r" rt1 rt2 ) (command "move" b "" s1 k1) (command "mirror" b "" s1 k1 "y") ) ) (setq loop (+ loop 1)) ) (setvar "osmode" os) (setvar "cmdecho" 1) (prin1) )

  • CADのコマンドについて

    CADを使っており、今あるコマンドに追加したいコマンドがあります。 現状ではH≦1300の時にP35とP36を実行するようになってるみたいなのですが、ここにさらにH≦1700のときに追加でP37 P38を実行させたいのです。そこで問題があるんですが、H≦1700のときにH≦1300のコマンドも実行されてしまいます。これを、H≦1700の場合、H≦1300のコマンドを実行させないようにすることはできますか?   初心者なので、説明不足でしたら申し訳ありません。 以下にコマンド載せておきます。 (IF (>= H00 1300.0) (PROGN (SETQ P35 (LIST (- (CAR P00) (- (/ W00 2) 55.0 40.0)) (- (CADR P00) (- (/ H00 2) 100.0)))) (SETQ P36 (LIST (+ (CAR P00) (- (/ W00 2) 55.0 40.0)) (- (CADR P00) (- (/ H00 2) 100.0))))))   (IF (>= H00 1300.0) (PROGN (POSTR (CAR P35) (CADR P35)) (POSTL (CAR P36) (CADR P36))))   (DEFUN POSTR (WX WY) (COMMAND "CIRCLE" (LIST (+ WX  5.0) (+ WY 25.0)) "2.10") (COMMAND "CIRCLE" (LIST (+ WX  5.0) (- WY 25.0)) "2.25") (COMMAND "CIRCLE" (LIST (- WX 20.0) (+ WY 25.0)) "2.25") (COMMAND "CIRCLE" (LIST (- WX 20.0) (- WY 25.0)) "2.10")) (DEFUN POSTL (WX WY) (COMMAND "CIRCLE" (LIST (- WX  5.0) (+ WY 25.0)) "2.25") (COMMAND "CIRCLE" (LIST (- WX  5.0) (- WY 25.0)) "2.10") (COMMAND "CIRCLE" (LIST (+ WX 20.0) (+ WY 25.0)) "2.10") (COMMAND "CIRCLE" (LIST (+ WX 20.0) (- WY 25.0)) "2.25"))

  • LISPでatomの数を数える

    XLISPでlistの中のatomの数を数えたいんです。 下のようにlistの中のatomだけを抜き出してリストにすることはできました。 (DEFUN F1(L) (COND((NULL L) NIL) ((LISTP(CAR L))(F1(CDR L))) (T (CONS (CAR L)(F1(CDR L)))) ) ) このコードを実行すると次のようになります。 (F1 '((A B) C D (E F) G)) (C D G) 後はこれをlengthで数えるだけだと思うのですがそのやり方が分かりません。 それとももしかしてSETQで変数を設定して Tのところで値を1つずつ足していくのでしょうか?

  • ruby メソッドのリターン

    def hoge(arg) "" arg if arg != "" end p hoge("") 上記実行の結果はnilが出力されました。 def piyo(arg) "" end p piyo("") しかし、上記実行の結果は""が出力されました。 前者は""を返してくれないのが納得できません。 説明して頂けませんか?

  • Excel vba でのoffsetについての質問です。

    Excel vba でのoffsetについての質問です。 セルをoffsetを使用して移動させています。 しかし、ファイルを開けた最初だけoffsetしている所とは違う所へ行ってしまいます。 試したのは Private Sub Worksheet_Activate() Range("C10").Select End Sub で起点を設定し Worksheet_Changeイベントで ActiveCell.Offset(1, 0).Select にオフセットしたいのですが、ファイルオープン時はうまく動きません。 別のセルをクリックした後だと、うまく動きだします。 ちなみにファイルオープンしてから最初に MsgBox ActiveCell.Address(0, 0, xlA1) を表示させるとC11になっています。 もう何がなんだか解らなくなっています。 原因や対策など、アドバイスよろしくお願い致しますm(_ _)m

  • Excelマクロのオフセットについて

    マクロのセルのオフセットについて質問です。 複数の画像(仮に7枚)を一度に張り付ける際に If ActiveCell.Column = 1 Then ActiveCell.Offset(, 8).Select Else ActiveCell.Offset(4, -8).Select End If このようなマクロ組むと 1 2 3 4 5 6 7 という感じになります。 列は8列空いて、行は4行空くことになると思うのですが これを 1 2 3 4 5 6 7 としたい場合はどのようなマクロの書き方をすればよいのでしょうか? ご指導の程宜しくお願いします。マクロを張り付けておきます。 Declare Function SetCurrentDirectory Lib "kernel32" Alias _ "SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long Sub 画像一括貼り付け() Dim Fname As Variant, fe As Variant Dim Fn As Variant, Pic As Shape Dim pno As Long Dim myFileName As String Range("A8").Select SetCurrentDirectory "P:\投レ+相模原\F-POT KBB42365\外観確認" Fname = Application.GetOpenFilename _ ("jpg,*.jpg,jpeg,*.jpeg,bmp,*.bmp,gif,*.gif,png,*.png", MultiSelect:=True) If Not IsArray(Fname) Then MsgBox "取り消されました。", vbInformation Exit Sub End If Application.ScreenUpdating = False pno = 0 For Each Fn In Fname 'この次へ追加すべき行 Selection.Offset(-1, 0) = Mid(Fn, InStrRev(Fn, "\") + 1, Len(Fn) - InStrRev(Fn, "\")) ActiveCell.Select Set Pic = ActiveSheet.Shapes.AddPicture(Filename:=Fn, _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=0, Top:=0, Width:=360, Height:=270) With Pic .ScaleWidth 1, msoTrue .ScaleHeight 1, msoTrue .Top = ActiveCell.Top ' 位置:アクティブセルの上側に重ねる .Left = ActiveCell.Left ' 位置:アクティブセルの左側に重ねる .Placement = xlMove ' 移動するがサイズ変更しない End With If ActiveCell.Column = 1 Then ActiveCell.Offset(, 8).Select Else ActiveCell.Offset(4, -8).Select End If Set Pic = Nothing pno = pno + 1 Next Application.ScreenUpdating = True Range("A1").Select MsgBox pno & "枚の画像を挿入しました", vbInformation End Sub

  • VBA:Offsetから値が貼付けれない

    はじめまして。 VBAを利用してマクロを作っているのですが、 Range("a6:l6").Copy Worksheets("結果シート").Range("A65536").End(xlUp).Offset(1) というのは動くのですが、結果シートへの貼付けを「値」で行いたいと思い、 以下の通りValueを指定しても動きません。 Range("a6:l6").Copy Worksheets("結果シート") .Range("A65536").End(xlUp).Offset(1).value PasteSpecialを使うと良いのかと思い、 Range("a6:l6").Copy Worksheets("結果シート") .Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues としてもエラーが出ます。 数式の結果を取得して、別のシートの空白セルを探し、「値」として張付ける。 というのがしたいのですが、なにか上手い方法があれば、ご教授お願いします。

  • xyzzyの実用サンプル

    LISPを覚えるために、xyzzyを使うことに決めました。 手始めに便利な機能が設定できれば励みになるかと思い、いきなり敷居が高いですが、次の内容がしたいのです。 F1を押すと、xyzzyの下の欄でurlを打つと、エディタ部にヘッダーを含めたHTMLテキストが表示される (defun poor-http (host file) (interactive) (let ((st (connect host 80)) form) (write (concat "GET " file " HTTP/1.0\r\n\r\n") :stream st) (terpri st) (while (setq form (read st nil '#1=:eof)) (when (eq form #1#) (return)) (insert form)))) (poor-http '203.216.243.218' "/index.htm" ) ctrl+jと実行すると、関数がありませんとなります。 途中で挫折しましたが、これらの機能を満たす gethttpsrc.lを作成する方法が知りたいです。 今のところの知識は nil t が真偽値で()でS式を作成する、まではわかりました。(あっているのだろうか?)

  • 2分木を中順でなぞりたいのですが(pascal)

    課題で「2分探索木にデータを挿入する手続きを定義し、作った木を中順になぞって出力せよ」というのが出されました。       6      /  \     4    7     /     \    2      9     \   /  \     3   8   10            \            11               \              12 このような木を考えプログラムを組み実行できたのですが、結果が「2,3,4,6,7,8,9,10,11,12」となってしまいます。中順だと「3,2,4,6,8,9,12,11,10,7」のはずなので合いません。 どこがおかしいのかご指摘お願いします。 ソースは以下の通りです。 program tree_search (input,output); type elementtype = integer; pointertype = ^celltype; celltype = record element : elementtype; leftson : pointertype; rightson: pointertype end; var root : pointertype; procedure inorder( node:pointertype); begin if (node <> nil) then begin inorder( node^.leftson); write( node^.element); inorder( node^.rightson) end end; {中順になぞる} procedure insert( x:integer; var p:pointertype); begin if ( p = nil) then begin new( p ); p^.element := x; p^.leftson := nil; p^.rightson := nil end else if ( x < p^.element ) then insert( x,p^.leftson) else if ( x > p^.element ) then insert( x,p^.rightson) end; {木に挿入する} procedure create( var p:pointertype ); begin p:= nil end; {空の木を作る} begin create(root); insert( 6,root ); insert( 4,root ); insert( 2,root ); insert( 3,root ); insert( 7,root ); insert( 9,root ); insert( 8,root ); insert( 10,root ); insert( 11,root ); insert( 12,root ); inorder( root ) end.

専門家に質問してみよう