连续模料带排版

726613

         图一

     图二

     图三




(defun c:pb ()
    (setq dcl_id (load_dialog "pb.dcl"))
    (if (< dcl_id 0) (exit))
    (if (not (new_dialog "pb" dcl_id)) (exit))
    (setq sld-list '("PB"))
    (setq key-list '("a1"))
    (mapcar 'l2show key-list sld-list)      
    (action_tile "w" "(setq w (l2check_real (distof (get_tile $key)) $key))")
    (action_tile "p" "(setq p (l2check_real (distof (get_tile $key)) $key))")
    (action_tile "y" "(setq y (l2check_real (distof (get_tile $key)) $key))")
    (action_tile "a" "(setq a (l2check_real (distof (get_tile $key)) $key))")
    (action_tile "l" "(setq l (l2check_real (distof (get_tile $key)) $key))")
    (set_tile "w" "50")
    (set_tile "p" "20")
    (set_tile "y" "3")
    (set_tile "a" "0")
    (set_tile "l" "10")
    (action_tile "accept" "(l2ok)")
    (setq nn (start_dialog))
    (if (= nn 2)
     (l2 w p y a l))
    (unload_dialog dcl_id)
  (princ)
)
(defun l2show(key sld)
  (setq x (dimx_tile key))
  (setq y (dimy_tile key))
  (start_image key)
  (fill_image 0 0 x y -2)
  (slide_image (+ 5 0) -15 (+ 10 x) y sld)
  (end_image)
)

     在输入PB命令之后，提示请“选取排版对象（如图一）”，出现图三，编辑图三对话框按确定出现如图二
    程序不能实现图二，请高手指点，我将以2个明经币以资鼓励，谢谢

alwtyp

1.先把产品按角度旋转；
2.用阵列的方法把产品排列出去。
3.再取得产品的最小包围盒，得到MIN尺寸和MAX尺寸，以此加上留边宽，得到材料的宽度（这里对话框里的料宽就没有什么用了），画出上下两边料边

726613

alwtyp 发表于 2013-4-14 17:10
1.先把产品按角度旋转；
2.用阵列的方法把产品排列出去。
3.再取得产品的最小包围盒，得到MIN尺寸和MAX尺 ...

那程序如何修改呢

alwtyp

你的程序就没有这个功能，只是把对话框界面显出来。相当要新写一个功能。我写程序很慢的，加上也没时间，可能要好几天才能搞完，你要等得话我就试着写写看

ScmTools

论坛以前有发过，你可以参考一下: http://bbs.mjtd.com/thread-99601-1-1.html

726613

alwtyp 发表于 2013-4-14 21:51
你的程序就没有这个功能，只是把对话框界面显出来。相当要新写一个功能。我写程序很慢的，加上也没时间，可 ...

我等着你啊

alwtyp

我把距离给去掉了。这个参数没什么意义。当然，你也可以自己加上。同时感谢GU版的帮助。

(Defun Sld (Key Sld_Name / X Y)
  (Start_Image Key)
  (Setq  X(Dimx_Tile Key)
         Y(Dimy_Tile Key)
         )
  (Fill_Image 0 0 X Y 0)
  (Slide_Image 0 0 X Y Sld_Name)
  (End_Image)
  (Princ)
  )

(Defun C:Pb (/ Cp Pmax Pmin Ang Num Pitch)
    (Setvar 'Cmdecho 1)
    (Setq Osmode (Getvar 'Osmode)) (Setvar 'Osmode 0)
    (Vl-Cmdf "Undo" "Be")
    (Setq Cp (Entsel "\n 请选择产品:"))
    (While (= Cp Nil)
           (Setq Cp (Entsel "\n 请选择产品:")))
    (Setq Dcl_Id(Load_Dialog "Pb.Dcl"))
    (If (< Dcl_Id 0)
        (Exit))
    (If (Not (New_Dialog "pb" Dcl_Id))
        (Exit))
    (Sld "A1" "Pb")   
    (Set_Tile "W" "50")
    (Set_Tile "P" "20")
    (Set_Tile "Y" "3")
    (Set_Tile "A" "0")
    (Set_Tile "L" "10")
    (Setq Ang 0 Num 10 Pitch 20 Width 50)
    (Action_Tile "Accept" " (Done_Dialog)")
    (Action_Tile "W" "(Setq Width (Atof $Value))")
    (Action_Tile "A" "(Setq Ang (Atof $Value))")
    (Action_Tile "L" "(Setq Num (Atoi $Value))")
    (Action_Tile "P" "(Setq Pitch (Atof $Value))")
    (Setq AA (Start_Dialog))
    (If (= aa 1) (Draw))
    (Unload_Dialog Dcl_Id)
    (Setvar 'Osmode Osmode)
    (Setvar 'Cmdecho 1)
    (Princ)
)


(Defun Wx (Ent /)
    (Vla-Getboundingbox (Vlax-Ename->Vla-Object Ent) 'Minpoint 'Maxpoint)
    (Setq Pmax (Trans (Vlax-Safearray->List Maxpoint) 0 1)
          Pmin (Trans (Vlax-Safearray->List Minpoint) 0 1))
  )

(Defun Draw()
      (Wx (Car Cp))
    (Vl-Cmdf ".Rotate" Cp "" Pmin Ang)
    (Wx (Car Cp))
    (Vl-Cmdf ".Array" Cp "" "R" 1 Num Pitch)
    (Setq Pmin1 Pmin
          La (Entlast))
    (Wx La)
    (Setq Pmax2 Pmax
          Wl (/ Width 2)
          Mid (List (Car Pmin1) (+ (Cadr Pmin1) (/ (- (Cadr Pmax2) (Cadr Pmin1)) 2)))
          P1 (List (Car Pmin1) (- (Cadr Mid) Wl))
          P2 (List (Car Pmax2) (- (Cadr Mid) Wl))
          P3 (List (Car Pmin1) (+ (Cadr Mid) Wl))
          P4 (List (Car Pmax2) (+ (Cadr Mid) Wl)))
    (Vl-Cmdf ".Line" P1 P2 "" ".Line" P3 P4 ""
             "Undo" "E")
)
        

feng83

不错，学习。。。