[SD_6303] 断面図自動作成

並んだ平面図から断面の下書き線を作成するAutoLISPコマンドです。

このように平面図を1階から4階まで並べます。平面図は、縦に並んでいても、横に並んでいても構いません。
コマンド起動後、基点を聞かれますので、各平面図の基点を順にクリックしてください。基点はどこでも構いませんが、各図面で同じ基準点になるようにしてください。例えば1階でX1通りとY1通りの交点をクリックしたのであれば、他の全ての階で同じようにX1通りとY1通りの交点をクリックしてください。その基点を元に、断面図を作成します。

その後、切断線を聞かれますので、1階平面図に書かれた切断線（ポリラインに限ります）をクリックしてください。切断線は、途中で雁行しても構いません。切断線は1階だけに書いてあればOKです。他の階は、1階と同じ位置で切断します。

切断方向を聞かれますので選択

切断するレイヤーを聞かれますので、入力してください。通り芯・壁芯として３レイヤー、切断する壁の線として３レイヤーまで指定可能です。

このような断面図がマウスポインタにくっついてくるので、挿入点をクリックしてください。
もし図形が現れなければ、Ctrl-Vで図形がでてきます。

通り芯番号は、通り心似埋め込まれたXDATAを読み込んで、自動で表示します。
階高はデフォルトが4,000でこれは変更できませんので、手動でストレッチしてください。
通り芯に番号を埋め込むコマンドはこちら

AutoLISPソース

(defun c:SD_6303 (/ num0 p1 lst0 lst1 lst2 lst3 lst4 lst5 lst6 lst7 ss1 ss2 ss3 ss4 eb1 eb2 eb3 eb4 eb5 eb6 eb7 eb8 eb9 eb10 eb11 str1 dcl act rc fil1 obj1 obj2 Lay_Cen Lay_Cen2 Lay_Dim Lay_Txt1 Lay_Txt2 or1 num1 num2 num3 flag)
  (if (= SD:Lang "E")
    (princ "\n [SD_6303 ver.20221214]Section Generator")
    (princ "\n [SD_6303 ver.20221214]断面図自動作成")
  )
  (princ "\n **********************************")
  (load "SD_U")
  (setq *error* *myerror*)
  (OpeningRoutine)
  (if (= SD:Lang "E")
    (alert "To get the most out of the program's capacities, we recommend using second previous command to embed the grid number in each lines.")
    (alert "\n 2つ前のコマンドを使って通り芯番号を通り芯オブジェクトに埋め込むことより、自動で通り芯符号を作図可能です"))

  (while (setq p1 (if p1 (getpoint p1 (if (= SD:Lang "E") "\nSpecify base point: " "\n次の図面の基点を指示: "))(getpoint (if (= SD:Lang "E") "\nSpecify base point: " "\n切断線が書かれた最初の図面の基点を指示: "))))
    (setq lst0 (cons p1 lst0)))
  (setq lst0 (reverse lst0))
  (if (= SD:Lang "E")(princ "\nSelect cutting lines: ")(princ "\n切断線を選択: "))
  (setq ss1 (ssget ":S" '((0 . "LWPolyline"))))

  (setq  Path1 "HKEY_CURRENT_USER\\Software\\SpeedDraft\\SD_6303"
    str1 (strcat (getvar "tempprefix") "SD_6303.dcl"))

  (dialog1)
  (if (= act 1)(progn (vl-registry-write Path1 "rc" rc)(dialog2)))
  (if (= act 1)(do_6303))

  (ClosingRoutine)
  (setq *error* nil)
  (princ)
(princ)
)
(defun dialog1 ()
  (setq fil1 (open str1 "w"))
  (write-line (strcat "SD_6303:dialog{label=\"" (if (= SD:Lang "E") "Select view" "展開方向を選択") "\";") fil1)
  (write-line ":boxed_column{" fil1)
  (write-line ":radio_row{key=rc1;" fil1)
  (write-line "spacer_1;" fil1)
  (write-line (strcat ":radio_button{label=\"" (if (= SD:Lang "E") "A↑" "A↑") "\";key=rb1;}}") fil1)
  (write-line ":radio_row{key=rc2;" fil1)
  (write-line "spacer_1;" fil1)
  (write-line (strcat ":radio_button{label=\"" (if (= SD:Lang "E") "←D" "←D") "\";key=rb4;}") fil1)
  (write-line "spacer_1;" fil1)
  (write-line (strcat ":radio_button{label=\"" (if (= SD:Lang "E") "B→" "B→") "\";key=rb2;}}") fil1)
  (write-line ":radio_row{key=rc3;" fil1)
  (write-line "spacer_1;" fil1)
  (write-line (strcat ":radio_button{label=\"" (if (= SD:Lang "E") "C↓" "C↓") "\";key=rb3;}}}") fil1)
  (write-line "ok_cancel;}" fil1)
  (close fil1)

  (if (null (setq rc (vl-registry-read Path1 "rc")))(setq rc "rb1"))

  (setq dcl (load_dialog str1))
  (new_dialog "SD_6303" dcl)
  (set_tile "rc1" rc)(set_tile "rc2" rc)(set_tile "rc3" rc)
  (action_tile "rc1" "(if (get_tile \"rc2\")(set_tile (get_tile \"rc2\") \"0\"))(if (get_tile \"rc3\")(set_tile (get_tile \"rc3\") \"0\"))")
  (action_tile "rc2" "(if (get_tile \"rc1\")(set_tile (get_tile \"rc1\") \"0\"))(if (get_tile \"rc3\")(set_tile (get_tile \"rc3\") \"0\"))")
  (action_tile "rc3" "(if (get_tile \"rc1\")(set_tile (get_tile \"rc1\") \"0\"))(if (get_tile \"rc2\")(set_tile (get_tile \"rc2\") \"0\"))")
  (action_tile "accept" "(cond ((get_tile \"rc1\")(setq rc (get_tile \"rc1\"))) ((get_tile \"rc2\")(setq rc (get_tile \"rc2\"))) ((get_tile \"rc3\")(setq rc (get_tile \"rc3\"))))(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
  (setq act (start_dialog))
  (unload_dialog dcl)
)

(defun dialog2 ()
  (setq fil1 (open str1 "w"))
  (write-line (strcat "SD_6303:dialog{label=\"" (if (= SD:Lang "E") "Select lines" "線分を選択") "\";") fil1)
  (write-line (strcat ":text{value=\"" (if (= SD:Lang "E") "Wall center layer to show" "表示する壁芯のレイヤー") "\";key=t1;}") fil1)
  (write-line ":row{" fil1)
  (write-line ":edit_box{key=ebb1;}" fil1)
  (write-line ":button{label=\"...\";key=b1;}}" fil1)
  (write-line ":row{" fil1)
  (write-line ":edit_box{key=ebb2;}" fil1)
  (write-line ":button{label=\"...\";key=b2;}}" fil1)
  (write-line ":row{" fil1)
  (write-line ":edit_box{key=ebb3;}" fil1)
  (write-line ":button{label=\"...\";key=b3;}}" fil1)
  (write-line (strcat ":text{value=\"" (if (= SD:Lang "E") "Wall layer to show" "表示する壁のレイヤー") "\";key=t2;}") fil1)
  (write-line ":row{" fil1)
  (write-line ":edit_box{key=ebb4;}" fil1)
  (write-line ":button{label=\"...\";key=b4;}}" fil1)
  (write-line ":row{" fil1)
  (write-line ":edit_box{key=ebb5;}" fil1)
  (write-line ":button{label=\"...\";key=b5;}}" fil1)
  (write-line ":row{" fil1)
  (write-line ":edit_box{key=ebb6;}" fil1)
  (write-line ":button{label=\"...\";key=b6;}}" fil1)
  (write-line "ok_cancel;}" fil1)
  (close fil1)

  (mapcar '(lambda (x y)(if (null (set (read x)(vl-registry-read Path1 x)))(set (read x) y)))(setq lst1 '("ebb1" "ebb2" "ebb3" "ebb4" "ebb5" "ebb6"))'("A12" "A12" "A12" "A31" "A21" "A22"))
  
  (setq dcl (load_dialog str1))
  (setq act 2)
  (while (> act 1)
    (new_dialog "SD_6303" dcl)
    (mapcar '(lambda (x)(set_tile x (eval (read x)))) lst1)
    (action_tile "b1" "(done_dialog 2)")
    (action_tile "b2" "(done_dialog 3)")
    (action_tile "b3" "(done_dialog 4)")
    (action_tile "b4" "(done_dialog 5)")
    (action_tile "b5" "(done_dialog 6)")
    (action_tile "b6" "(done_dialog 7)")
    (action_tile "accept" "(mapcar '(lambda (x)(vl-registry-write Path1 x (set (read x) (get_tile x)))) lst1)(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
    (setq act (start_dialog))
    (if (> act 1)(select_6303 act))
  )
  (unload_dialog dcl)
)
(defun select_6303 (str1 / obj1 str2)
  (while (null obj1)
    (setq obj1 (entsel (if (= SD:Lang "E") "\nSelect object: " "xxx: ")))
    (if obj1 (setq str2 (cdr (assoc 8 (entget (car obj1)))))))  
  (set (read (strcat "ebb" (itoa (- str1 1)))) str2)
)
(defun do_6303 (/ obj3 ss4)
  (setq  Path1 "HKEY_CURRENT_USER\\Software\\SpeedDraft\\SD_6302")
  (mapcar '(lambda (x y)(if (null (set (read x) (vl-registry-read Path1 x)))(set (read x) y)))
    (setq lst1 '("eb1" "eb2" "eb3" "eb4" "eb5" "eb6" "eb7" "eb8" "eb9" "eb10" "eb11" "eb12" "eb13" "eb14" "eb15"))
    '("3000" "10" "7" "6" "8" "7" "14" "5" "24" "1" "10" "2.5" "3.0" "3.0" "3.0"))
  (mapcar '(lambda (x)(set (read x)(* (atof (eval (read x)))(getvar "userr1")))) (cdr lst1))
  (setq  Lay_Cen (Get_Layer "A11" T)
    Lay_Cen2 (Get_Layer "A12" T)
    Lay_Dim (Get_Layer "A62" T)
    Lay_Txt1 (Get_Layer "A71" T)
    Lay_Txt2 (Get_Layer "A72" T))
  (setq n 0)
  ;(while (setq obj1 (ssname ss1 n))
  ;  (setq lst2 (cons obj1 lst2) n (1+ n)))
  (setq obj1 (ssname ss1 0))
  (setq lst2 (cons obj1 lst2))
  (setq lst4 (mapcar '(lambda (y)
    (mapcar '(lambda (x / p1 p2)
      (vla-copy (vlax-ename->vla-object y))(vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point (car lst0))(vlax-3d-point x))(entlast)) (cdr lst0))) lst2))
  (mapcar 'makeall_6303 lst2 lst4)
  (mapcar 'entdel (apply 'append lst4))
)
(defun makeall_6303 (obj1 lst1 / p1 p2 ss1 ss2 flag lst6)
  (setq num3 0)
  (make_6303 obj1)
  (setq flag T)
  (mapcar 'make_6303 lst1)
  (setq ss3 (ssadd))
  (setq lst6 (mapcar '(lambda (x)(entmake x)(ssadd (entlast) ss3)(entlast)) lst6))
  (mapcar 'entdel lst7)
  (command ".copybase" "_non" '(0 0) ss3 "")
  (mapcar 'entdel lst6)
  (command "pasteclip" pause)
)
(defun make_6303 (obj1 / lst1 lst2 n obj2 ang1 lst4 ss2 num0)
  (setq  lst1 (mapcar 'cdr (vl-remove-if-not '(lambda (x)(= (car x) 10))(entget obj1)))
    ss2 (ssget "_f" lst1 (list '(0 . "LINE")(cons 8 (strcat ebb1 "," ebb2 "," ebb3 "," ebb4 "," ebb5 "," ebb6 "," Lay_Cen)))))
  (if ss2 (progn
    (setq eb1 "4000")
    (setq n 0)
    (while (setq obj2 (ssname ss2 n))
      (setq  p1 (vlax-invoke (vlax-ename->vla-object obj2) 'intersectWith (vlax-ename->vla-object obj1) acExtendNone)
        lay1 (cdr (assoc 8 (entget obj2)))
        ang1 (angle (cdr (assoc 10 (entget obj2)))(cdr (assoc 11 (entget obj2))))
        n (1+ n))
      (cond ((and (or (= rc "rb2")(= rc "rb4"))(or (equal ang1 (* 0.5 pi) 0.00001)(equal ang1 (* 1.5 pi) 0.00001))) nil)
        ((and (or (= rc "rb1")(= rc "rb3"))(or (equal ang1 0 0.00001)(equal ang1 pi 0.00001))) nil)
        (T (if (/= (car (car (cdr (assoc -3 (entget obj2 '("*")))))) "REVIT")
          (setq lst2 (cons (list p1 lay1 (cdr (cadr (cadr (assoc -3 (entget obj2 '("*"))))))) lst2))
          (setq lst2 (cons (list p1 lay1 nil) lst2)))))
    )
    (cond ((= rc "rb1")(setq lst2 (mapcar '(lambda (x)(list (car (car x))(cadr x) (nth 2 x))) lst2)
          lst2 (vl-sort lst2 '(lambda (e1 e2)(< (car e1)(car e2))))))
      ((= rc "rb2")(setq lst2 (mapcar '(lambda (x)(list (cadr (car x))(cadr x) (nth 2 x))) lst2)
          lst2 (vl-sort lst2 '(lambda (e1 e2)(> (car e1)(car e2))))))
      ((= rc "rb3")(setq lst2 (mapcar '(lambda (x)(list (car (car x))(cadr x) (nth 2 x))) lst2)
          lst2 (vl-sort lst2 '(lambda (e1 e2)(> (car e1)(car e2))))))
      ((= rc "rb4")(setq lst2 (mapcar '(lambda (x)(list (cadr (car x))(cadr x) (nth 2 x))) lst2)
          lst2 (vl-sort lst2 '(lambda (e1 e2)(< (car e1)(car e2)))))))
    (if (null num0)(setq num0 (car (car lst2))))
    (setq lst2 (mapcar '(lambda (x)(list (+ (abs (- (car x) num0)) eb9)(cadr x)(nth 2 x))) lst2))
    (if (null flag)(setq lst6 (cons (list '(0 . "LINE")(cons 8 Lay_Cen)(list 10 0 num3 0)(list 11 (+ (car (last lst2)) eb11) num3)) lst6)))
    (setq lst6 (cons (list '(0 . "LINE")(cons 8 Lay_Cen)(list 10 0 (+ (atof eb1) num3) 0)(list 11 (+ (car (last lst2)) eb11) (+ num3 (atof eb1)))) lst6))
    (mapcar '(lambda (x)
      (if (or (= (cadr x) ebb1)(= (cadr x) ebb2)(= (cadr x) ebb3))
        (setq num1 (- 0 eb2) num2 (+ (atof eb1) eb6)))
      (if (= (cadr x) Lay_Cen)
        (setq num1 (- 0 eb2) num2 (+ (atof eb1) eb6) lst4 (cons (list (car x) num1 0) lst4) lst5 (cons (last x) lst5))(setq num1 0 num2 (atof eb1)))
      (setq lst6 (cons (list '(0 . "LINE")(cons 8 (cadr x))(list 10 (car x) (+ num1 num3) 0)(list 11 (car x) (+ num2 num3))) lst6))) lst2)
    
    (setq doc1 (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))

    (vla-adddimrotated doc1 (vlax-3D-point (list 0 num3))(vlax-3D-point (list 0 (+ (atof eb1) num3)))(vlax-3D-point (list (- 0 eb7) num3)) (* 0.5 pi))
      (setq lst6 (cons (subst (cons 8 Lay_Dim)(assoc 8 (entget (entlast))) (entget (entlast))) lst6))
      (entdel (entlast))

    (if (null flag)
      (progn
      
      (mapcar '(lambda (x y)
      (vla-adddimrotated doc1 (vlax-3D-point x)(vlax-3D-point y)(vlax-3D-point (polar x (* 1.5 pi) eb3)) 0)
      (setq lst6 (cons (subst (cons 8 Lay_Dim)(assoc 8 (entget (entlast))) (entget (entlast))) lst6))
      (entdel (entlast))) lst4 (cdr lst4))

      (mapcar '(lambda (x y)(if y (progn
      (setq lst6 (cons (list '(0 . "CIRCLE")(cons 8 Lay_Dim)(cons 10 (polar x (* 1.5 pi)(+ eb3 eb4 (/ eb5 2.0))))(cons 40 (/ eb5 2.0))) lst6))))) lst4 lst5)

      (mapcar '(lambda (x y)(if y (progn
      (setq lst6 (cons (list '(0 . "TEXT")(cons 1 y)(cons 8 Lay_Dim)(cons 10 (polar x (* 1.5 pi)(+ eb3 eb4 (/ eb5 2.0))))
        (cons 11 (polar x (* 1.5 pi)(+ eb3 eb4 (/ eb5 2.0))))(cons 40 eb14)'(72 . 1)'(73 . 2)) lst6))))) lst4 lst5)

      (cond ((= rc "rb1")(setq str1 "A"))((= rc "rb2")(setq str1 "B"))((= rc "rb3")(setq str1 "C"))((= rc "rb4")(setq str1 "D")))
      (setq lst6 (cons (list '(0 . "TEXT")(cons 1 str1)(list 10 (/ (+ (car (last lst2)) eb11) 2.0)(- num3 eb2 eb3 eb4 (/ eb5 2.0)))(cons 40 eb14)) lst6))

      (setq lst6 (cons (list '(0 . "TEXT")(cons 1 "▽*FL")(cons 8 Lay_Txt2)(list 10 eb8 (+ 1 num3))(cons 40 eb14)) lst6))

      (setq lst6 (cons (list '(0 . "TEXT")(cons 1 "部屋名")(cons 8 Lay_Txt1)(list 10 eb8 (- num3 eb2))(cons 40 eb14)) lst6))))
    (setq num3 (+ num3 (atof eb1)))))
)
(princ)