Chuyển đến nội dung
Diễn đàn CADViet
bachngoctung

[Yêu cầu] Lisp tạo viewport từ khung chọn bên model.

Bởi bachngoctung , trong AutoLisp

Các bài được khuyến nghị

KangKung    250

KangKung
Đã đăng

Lisp theo yêu cầu của bạn conghoa đây

;==========LISP CHIA MOI VIEWPORT THANH 1 LAYOUT================
(defun C:CVP( / ACTDOC CLAYOUT LST_VIEWPORT)
  (vl-load-com)
  (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (if (= (getvar "TILEMODE") 0)
    (progn
      (if (/= (getvar "cvport") 1) (command "PSPACE"))
      (command "UNDO" "BE")
      (if (setq lst_Viewport (#SS->List (ssget '((0 . "VIEWPORT")))))
	(foreach viewport lst_Viewport
	  (command "layout" "N" (strcat "KH-" (itoa (1+ (vl-position viewport lst_Viewport)))))
	  (command "layout" "Set" (strcat "KH-" (itoa (1+ (vl-position viewport lst_Viewport)))))
	  (setq cLayout (vla-get-ActiveLayout ActDoc))
	  (vlax-invoke ActDoc 'CopyObjects (list (vlax-ename->vla-object viewport)) (vla-get-Block cLayout) nil)
	  (command "MOVE" "All" "" (Getvar "EXTMIN") (list 0 0))
	  (command "ZOOM" "E")
	  )
	)
      )
    )
  (princ)
  )
(Defun #SS->List (ss / i lst)
 (repeat (setq i (sslength ss))
  (setq lst (cons (ssname ss (setq i (1- i))) lst))))
  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

quocmanh04tt    634

quocmanh04tt
Đã đăng

@Quocmanh04tt mình có xem phần lớn các lisp bạn post và cái mà bạn bảo hình như đó lại là tách nhiều bản vẽ trong layout ra làm thành các file riêng thì phải.

 

Cái mình post bên trên là trong 1 layout có nhiều viewport, lisp sẽ tách các viewport đó (đã thiết lập việc freeze layer) ra thành các layout riêng vẫn giữ nguyên các thiết lập của viewport đó.

 

Các bác giúp em nhé!

Tìm thấy trong máy rồi:

http://www.cadviet.com/upfiles/6/141736_tachviewports.lsp

(defun c:tt (/ create-layout copy2layout sort-xy-lr acadapp acaddoc cur_tab e ent i layname ln lst lstp maxp minp obj ss ssold)

(setq acadapp (vlax-get-acad-object)

acaddoc (vla-get-ActiveDocument acadapp))

(defun create-layout (name)

(vl-catch-all-apply '(lambda () (vla-add (vla-get-layouts acaddoc) name)))

(vla-item (vla-get-layouts acaddoc) name))

(defun sort-xy-lr (ptlist delta-y)

(setq ptlist (vl-sort ptlist

'(lambda (x y)

(cond ((equal (caaar x) (caaar y) delta-y) (> (cadaar x) (cadaar y)))

((< (caaar x) (caaar y))))))))

(defun copy2layout (minp maxp layName / lobj n ss tab)

(setvar 'ctab cur_tab)

(if (setq ss (ssget "_C" minp maxp (list (cons 410 cur_tab))))

(progn (repeat (setq n (sslength ss))

(setq lobj (cons (vlax-ename->vla-object (ssname ss (setq n (1- n)))) lobj)))

(vlax-invoke acaddoc 'CopyObjects lobj (vla-get-block (vla-item (vla-get-layouts acaddoc) layName)))

(setvar 'Ctab layName)

(vla-ZoomExtents acadapp))))

;; *** MAIN ***

(vl-load-com)

(vla-startundomark acaddoc)

(if (and (setq ss (ssget (list '(0 . "VIEWPORT") (cons 410 (setq cur_tab (getvar "CTAB"))))))

(setq ln (getstring "\nTen Layout <No_>: ")))

(progn (if (eq ln "")

(setq ln "No_"))

(repeat (setq i (sslength ss))

(setq ent (ssname ss (setq i (1- i)))

obj (vlax-ename->vla-object ent))

(vla-getBoundingBox obj 'Minp 'Maxp)

(setq lstp (mapcar 'vlax-safearray->list (list Minp Maxp)))

(setq lst (cons (cons lstp ent) lst)))

(setq lst (sort-xy-lr lst 0))

(setq i 0)

(repeat (length lst)

(setq layName (strcat ln (itoa (1+ i))))

(create-layout layName)

(setvar 'Ctab layName)

(if (setq ssold (ssget "_X" (list (cons 410 layName))))

(mapcar '(lambda (e) (entdel e)) (mapcar 'cadr (ssnamex ssold))))

(copy2layout (car (car (nth i lst))) (cadr (car (nth i lst))) layName)

(setq i (1+ i)))))

(setvar 'ctab cur_tab)

(vla-endundomark acaddoc)

(princ))

P/s: Cái của bác KangKung hình như chưa đúng yêu cầu.

  • Like 1
  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Han Tinh    7

Han Tinh
Đã đăng

Với vấn đề này mình nhờ bạn KangKung chỉnh giúp mình sao cho:

khung tên bên layout luôn ở tỉ lệ 1:1(dùng khung tên xref), còn khung bên model thì có các tỉ lệ khác nhau như:

1:10, 1:15, 1:20, ... Khi ta dùng lệnh lsp thì tất cả các khung bản vẽ bên model sẽ nằm gọn trong khung tên layout đúng tỉ lệ 1:1

(hiện tại khi xuất qua layout thì có rất nhiều tỉ lệ

Chọn khung view bên model trước thì nó xuất qua bên layout trước

Mong bạn sửa giúp

========LISP TAO VIEWPORT TREN LAYOUT BANG CACH CHON O MODEL========
;============================REV5====================================
;=========THEM LUA CHON XOAY HCN NGHIENG VA XREF KHUNG TEN===========
(defun C:mtl( / os lst khung pt0 pt1 pt2 pt3 Y index taphop xrefFile xref)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0) 
  (setq taphop(ssget (LIST (CONS 0 "POLYLINE,LWPOLYLINE"))))
  (if (= Tyle nil)
    (setq Tyle1 1)
    (setq Tyle1 Tyle))
  (setq Tyle (getreal (strcat "\n Ty le: <" (rtos Tyle1 2 0) "> ")))
  (if (= Tyle nil)
    (setq Tyle Tyle1))
  (setq xref(getstring "\n Ban co muon chen file khung ten hay khong? <Y/N>:"))
  (if (= (strcase xref) "Y")
    (progn
      (if (not Path)
	(setq Path(getvar "dwgprefix")))
      (setq xrefFile(getfiled "Chon File khung ten" Path "dwg" 2))
      (setq Path xrefFile)))
  (setq soluong (sslength taphop))
  (setq index 0)
  (command "LAYOUT" "N" "Layout1")
  (command "LAYOUT" "S" "Layout1")
  (command "ERASE" "ALL" "")
  (command "ZOOM" "E")
  (command "MODEL")
  (setq Y 0)
  (command "ZOOM" "E")
  (while (< index soluong)
    (setq khung(ssname taphop index))
    (setq lst(acet-geom-vertex-list khung))
    (setq lst (vl-sort lst '(lambda (e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
    (setq pt0(nth 0 lst) pt3(nth 3 lst))
    (if (> (cadr (nth 1 lst)) (cadr (nth 2 lst)))
      (setq pt1(nth 1 lst) pt2(nth 2 lst))
      (setq pt1(nth 2 lst) pt2(nth 1 lst))
      )
    (command "LAYOUT" "S" "Layout1")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (command "RECTANG" (list 0 Y) (list (distance pt2 pt0) (+ Y (distance pt1 pt0))))
      (command "RECTANG" (list 0 Y) (list (distance pt1 pt0) (+ y (distance pt2 pt0))))
      )
    (command "SCALE" (entlast) "" (list 0 Y) (/ 1 tyle))
    (command "MVIEW" "O" (entlast))
    (if (= (strcase xref) "Y")
      (command "xref" "A" xrefFile (list 0 Y) "" "" ""))
    (command "MSPACE")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (command "DVIEW" khung "" "TW" (- 90 (* (/ (angle pt0 pt1) pi) 180)) "")
      (command "DVIEW" khung "" "TW" (- 0 (* (/ (angle pt0 pt1) pi) 180)) "")
      )
    (command "ZOOM" "W" pt0 pt3)
    (command "PSPACE")
    (command "TEXT" "J" "MR" (list -50 (+ Y (/ (distance pt1 pt0) (* 2 tyle)))) (* 25 tyle) "0" (strcat "VP " (rtos (1+ index) 2 0)) "")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (setq Y(- Y 50 (/ (distance pt1 pt0) tyle)))
      (setq Y(- Y 50 (/ (distance pt2 pt0) tyle)))
      )
    (command "ZOOM" "W" (list -100 (+ Y (distance pt3 pt0))) (list (distance pt3 pt0) (- Y 50 (distance pt3 pt0))))
    (setq index (+ index 1))
    )
  (command "ZOOM" "E")
  (command "MODEL")
  (command "UNDO" "END")
  (setvar "OSMODE" os)
  (princ)
  )

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Han Tinh    7

Han Tinh
Đã đăng

Chưa hiểu yêu cầu của bạn Han Tinh. Có thể cho 1 ví dụ cụ thể hơn bằng bản vẽ không?

Ví dụ: 1/ ở bên model có khung HCN là 4100x2970 nhưng khi xuất sang layout phải là 420x297 (bởi vì bên layout khung tên có tỉ lễ là 1:1 là 420x297)

2/ khi ta chọn khung HCN nào trước bên model thì nó xuất sang layout ở vị trí đầu tiên

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

PHAPLUONG    4

PHAPLUONG
Đã đăng

 

Của bạn đây.

 

71162_clo.jpg

 

Hướng dẫn: 

1. Lệnh CLO

2. Chọn máy in, khổ giấy, style...

3. Đặt tên Layout, tỉ lệ

4. Chọn các khung hình chữ nhật (Polyline) bên Model để tạo Viewport bên Layout. Khi quét chọn thì Lisp sẽ tự động căn các khung theo thứ tự từ trái sang phải.

5. Chọn Block hoặc file xref. Nếu không cần thì khỏi chọn.

6. Bấm OK, Lisp sẽ tạo mỗi bản vẽ trên một Layout.

;LISP TAO LAYOUT HANG LOAT BANG CACH CHON KHUNG VIEW BEN MODEL
(vl-load-com)
(defun Make_dcl	(/ ret)
  (if (= Printer nil) (setq Printer 0))
  (if (= Size nil) (setq Size 0))
  (if (= Style nil) (setq Style 0))
  (if (= Block nil) (setq Block 0))
  (if (= TenLayout nil) (setq TenLayout "Layout"))
  (if (= Tyle nil) (setq Tyle "1000"))
  (setq fl (vl-filename-mktemp "CLO" nil ".dcl"))
  (setq ret (open fl "w"))
  (write-line
    (strcat
      "CLO : dialog { label = \"Create Layout\";
      : column {
      : boxed_column {label = \"Page Setup\";
      : popup_list { key=\"Printer\"; label= \"Printer\";  value = \"" (itoa Printer) "\"; edit_width = 40;}
      : popup_list { key=\"PaperSize\"; label= \"Paper Size   \"; value = \"" (itoa Size) "\"; edit_width = 40;}
      : popup_list { key=\"Style\"; label= \"Style            \"; value = \"" (itoa Style) "\";edit_width = 40;}
      : edit_box {   key = \"LO_name\"; label = \"Layout Name  \"; value = \"" TenLayout "\";edit_width = 20;}
      : edit_box {   key = \"Tyle\"; label = \"Drawing Scale\"; value = \"" Tyle "\";edit_width = 20;}}
      : button { key = \"Chonkhung\"; label = \"Select Frame \"; }
      : boxed_column {
      label = \"\";
      :row {
      : button { key = \"TaoBlock\"; label = \"Create Title Block\"; is_default = false; width=30; fixed_width=true;}
      : popup_list {key=\"Block\"; label= \"Block\"; width=30; fixed_width=true; value = \"" (itoa Block) "\";}}
      : row {
      : button {key = \"Select_Xref\"; label = \"Xref Title Block\"; is_default = false; width=30; fixed_width=true;}
      : button {key = \"Remove\"; label = \"Remove Title Block\"; is_default = false; width=30; fixed_width=true;}}
      : list_box {label =\"\"; key = \"Xref_File\"; height = 3; value = \"0\";}
      }
      : boxed_row {
      : button { key = \"accept\"; label = \" OK \"; width=30; fixed_width=true; is_default = true;}
      : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; width=30; fixed_width=true;}}}} "
    )
    ret
  )
  (setq ret (close ret))
)
(defun *error* (msg) (vl-file-delete fl))
(defun Chon ()
  (vl-file-delete fl)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (Make_dcl)
  (setq ddiag 3)
)
(defun TaoBlock (/ taphop pt)
  (vl-file-delete fl)
  (alert "Chon doi tuong de tao Block khung ten")
  (if (/= (setq taphop(ssget)) nil)
    (progn
      (setq pt(getpoint "\n Chon Base point cua Block: "))
      (setq ten(lisped "Nhap ten cua Block"))
      (while (/= (tblsearch "Block" ten) nil)
	(setq ten(lisped "Trung ten Block da co. Nhap ten khac cho Block")))
      (command "BLOCK" ten pt taphop "")
      (setq dsblock(cons "" (tablelist "Block")))
      ))
  (Make_dcl)
  (setq ddiag 3)
)
(defun Update ()
  (vla-put-ConfigName (ActLay) (nth (atoi (get_tile "Printer")) dsmayin))
  (setq dsPaper (PaperList))
  (start_list "PaperSize" 3)
  (mapcar 'add_list dsPaper)
  (end_list)
)
(defun Chon_Xref ()
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq File(getfiled "Chon File khung ten" Path "dwg" 2))
  (if (/= File nil) (setq Path File dsFile (list File)))
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  )
(defun Remove_Xref ()
  (setq File "" dsFile (list File))
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  )
(defun ActLay () (vla-get-ActiveLayout(vla-get-activedocument(vlax-get-acad-object))))
(defun PlotDeviceNamesList ()
  (vla-RefreshPlotDeviceInfo (ActLay))
  (vlax-safearray->list(vlax-variant-value(vla-GetPlotDeviceNames (ActLay)))))
(defun PaperList (/ PLObj PSL)
  (setq PLObj (vla-GetCanonicalMediaNames (ActLay)))
  (foreach i (vlax-safearray->list (vlax-variant-value PLObj))
    (setq PSL (append PSL (list (vla-GetLocaleMediaName (ActLay) i))))))
(defun PlotStyleTableNamesList ()
  (vla-RefreshPlotDeviceInfo (ActLay))
  (vlax-safearray->list(vlax-variant-value(vla-GetPlotStyleTableNames(ActLay)))))
(defun tablelist (s / d r)
  (while (setq d (tblnext s (null d)))
    (setq r (cons (cdr (assoc 2 d)) r))))
(defun DeleteLayouts (/ layouts layout i)
  (vl-load-com)
  (setq	layouts	(vla-get-Layouts(vla-get-activedocument (vlax-get-acad-object))))
  (if (> (vla-get-count layouts) 2)
    (vlax-for layout layouts
      (if (= (vla-get-ModelType layout) :vlax-false)
	(if (< (vla-get-count (vla-get-block layout)) 2)
	  (vla-delete layout))))))
(setq dsmayin (PlotDeviceNamesList))
(setq dsStyle (PlotStyleTableNamesList))
(setq dsblock(cons "" (tablelist "Block")))
(defun hopthoai	()
  (setq dcl_id (load_dialog fl))
  (if (not (new_dialog "CLO" dcl_id)) (exit))
  (start_list "Printer" 3)
  (mapcar 'add_list dsmayin)
  (end_list)
  (Update)
  (action_tile "Printer" "(Update)")
  (action_tile "Chonkhung" "(setq ddiag 5)(saveVars)(done_dialog)")
  (action_tile "TaoBlock" "(setq ddiag 9)(saveVars)(done_dialog)")
  (start_list "Style" 3)
  (mapcar 'add_list dsStyle)
  (end_list)
  (start_list "Block" 3)
  (mapcar 'add_list dsBlock)
  (end_list)
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  (action_tile "Select_Xref" "(Chon_Xref)")
  (action_tile "Xref_File" "(Chon_Xref)")
  (action_tile "Remove" "(Remove_Xref)")
  
  (action_tile "cancel" "(setq ddiag 1)(done_dialog)")
  (action_tile "accept" "(setq ddiag 2)(setq tieptuc 1)(saveVars)(done_dialog)" )
  (start_dialog)
  (unload_dialog dcl_id)
)
(defun saveVars	()
  (setq Printer (atoi (get_tile "Printer")))
  (setq Size (atoi (get_tile "PaperSize")))
  (setq Style (atoi (get_tile "Style")))
  (setq Tyle (get_tile "Tyle"))
  (setq Block (atoi (get_tile "Block")))
  
  (setq Printer1 (nth Printer dsmayin))
  (setq Size1 (nth Size (PaperList)))
  (setq Style1 (nth Style dsStyle))
  (setq TenLayout (get_tile "LO_name"))
  
  (setq Tyle1 (/ (atof (get_tile "Tyle")) 1000))
  (setq Block1 (nth Block dsBlock))
)
(defun C:CLO (/ os)
  (setvar "CMDECHO" 0)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setvar "TILEMODE" 1)
  (setq dsblock(cons "" (tablelist "Block")))
  (if (= File nil) (setq dsFile (list "")))
  (setq tieptuc 0)
  (Make_dcl)
  (setq ddiag 3)
  (while (= ddiag 3)
    (hopthoai)
    (if	(= ddiag 5) (Chon))
    (if	(= ddiag 9) (TaoBlock))
  )
  (vl-file-delete fl)
  (if (= tieptuc 1)
    (progn
      (Sapxepkhung)
      (Make_Layout)
      (DeleteLayouts)
      )
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
(defun Sapxepkhung(/ index khung S1 S2 D1 D2)
  (setq index 0)
  (setq lst_Khung(list))
  (setq S1 0 S2 0)
  (while (< index (sslength taphop))
    (setq khung (ssname taphop index))
    (setq lst_Khung(append lst_Khung (list(list khung S1 S2))))
    (setq index (1+ index))
    )
  (setq lst_Khung(vl-sort lst_Khung '(lambda (e1 e2) (< (cadr(assoc 10 (entget(car e1)))) (cadr(assoc 10 (entget(car e2))))))))
  )
(defun Make_Layout (/ disp index khung lst pt0 pt1 pt2 pt3 P1 P2)
  (setq disp(getenv "CreateViewports"))
  (setenv "CreateViewports" "0")
  (setq index 1)
  (foreach khung1 lst_Khung
    (setq khung (car khung1))
    (setq lst (acet-geom-vertex-list khung))
    (setq lst (vl-sort lst '(lambda(e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
    (setq pt0 (nth 0 lst) pt3 (nth 3 lst))
    (if	(> (cadr (nth 1 lst)) (cadr (nth 2 lst)))
      (setq pt1	(nth 1 lst) pt2	(nth 2 lst))
      (setq pt1	(nth 2 lst) pt2	(nth 1 lst)))
    (command "LAYOUT" "N" (strcat TenLayout (itoa (+ 0 index))))
    (command "LAYOUT" "S" (strcat TenLayout (itoa (+ 0 index))))
    (command "ERASE" "ALL" "")
    (if (/= File nil) (command "xref" "A" file (list 0 0) "" "" ""))
    (if (/= Block1 "") (command "INSERT" Block1 (list 0 0) "" "" ""))
    (command "ZOOM" "E")
    (if	(> (distance pt2 pt0) (distance pt1 pt0))
      (command "RECTANG"  (list 0 0) (list (/ (distance pt2 pt0) tyle1) (/ (distance pt1 pt0) tyle1)))
      (command "RECTANG"  (list 0 0) (list (/ (distance pt1 pt0) tyle1) (/ (distance pt2 pt0) tyle1)))
      )
    (command "MVIEW" "O" (entlast))
    (command "MSPACE")
    (if	(> (distance pt2 pt0) (distance pt1 pt0))
      (command "DVIEW" khung "" "TW" (- 90 (* (/ (angle pt0 pt1) pi) 180)) "")
      (command "DVIEW" khung "" "TW" (- 0 (* (/ (angle pt0 pt1) pi) 180)) ""))
    (command "ZOOM" "W" pt0 pt3)
    (command "PSPACE")
    (command "ZOOM" "E")
    (Setq P1 (Getvar "EXTMIN") P2 (Getvar "EXTMAX"))
    (command "PLOT" "Y" "" printer1 size1 "M" "L" "N" "W" P1 P2 "1" "C" "Y" Style1 "Y" "N" "N" "N" "N" "Y" "N")
    (command "MODEL")
    (setq index (+ index 1))
  )
  (setenv "CreateViewports" disp)
  (princ)
)
(princ "\n           Type CLO to run program\n"

Cảm ơn bác!

thực sự thì lisp này rất hay rồi, tuy nhiên e vẫn muốn nhờ bác chỉnh sửa thêm một chút nữa phần tỷ lệ sao cho e để khung tên trong xref với khích thước thật khung A3 là 420x297 và khung chữ nhật ở model là 42000x29700 thì khi nhập tỷ lệ là 100 thì layout sẽ là các khung 420x297 vừa với khung xref luôn

và e cung được voi đòi hai bà Trưng nhừ bác viết giúp e 1 lisp nữa để kếp hợp với lisp trên. khi dùng lisp trên của bác e kếp hợp với đặt tên bản vẽ bằng sheetset bằng cách chèn field của sheetset name vào khung tên, như trong file e đính kèm bên dưới. Để giảm bớt thời gian cop tex giữa các layout bác có thể viết giúp e 1 lisp có tác dụng như sau: 

1. tạo mtext trong 1 layout dầu tiên

2. chạy lisp, chọn mtext vừa tạo thì tự động coppy và paste đúng tọa độ sang các layout còn lại

Cảm ơn bác trước

Link file của e: https://drive.google.com/open?id=0B42Bw9dLRUS0c0RhNzRuSzAyWms

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

quang_lac    32

quang_lac
Đã đăng

Tìm thấy trong máy rồi:

http://www.cadviet.com/upfiles/6/141736_tachviewports.lsp

(defun c:tt (/ create-layout copy2layout sort-xy-lr acadapp acaddoc cur_tab e ent i layname ln lst lstp maxp minp obj ss ssold)

(setq acadapp (vlax-get-acad-object)

acaddoc (vla-get-ActiveDocument acadapp))

(defun create-layout (name)

(vl-catch-all-apply '(lambda () (vla-add (vla-get-layouts acaddoc) name)))

(vla-item (vla-get-layouts acaddoc) name))

(defun sort-xy-lr (ptlist delta-y)

(setq ptlist (vl-sort ptlist

'(lambda (x y)

(cond ((equal (caaar x) (caaar y) delta-y) (> (cadaar x) (cadaar y)))

((< (caaar x) (caaar y))))))))

(defun copy2layout (minp maxp layName / lobj n ss tab)

(setvar 'ctab cur_tab)

(if (setq ss (ssget "_C" minp maxp (list (cons 410 cur_tab))))

(progn (repeat (setq n (sslength ss))

(setq lobj (cons (vlax-ename->vla-object (ssname ss (setq n (1- n)))) lobj)))

(vlax-invoke acaddoc 'CopyObjects lobj (vla-get-block (vla-item (vla-get-layouts acaddoc) layName)))

(setvar 'Ctab layName)

(vla-ZoomExtents acadapp))))

;; *** MAIN ***

(vl-load-com)

(vla-startundomark acaddoc)

(if (and (setq ss (ssget (list '(0 . "VIEWPORT") (cons 410 (setq cur_tab (getvar "CTAB"))))))

(setq ln (getstring "\nTen Layout <No_>: ")))

(progn (if (eq ln "")

(setq ln "No_"))

(repeat (setq i (sslength ss))

(setq ent (ssname ss (setq i (1- i)))

obj (vlax-ename->vla-object ent))

(vla-getBoundingBox obj 'Minp 'Maxp)

(setq lstp (mapcar 'vlax-safearray->list (list Minp Maxp)))

(setq lst (cons (cons lstp ent) lst)))

(setq lst (sort-xy-lr lst 0))

(setq i 0)

(repeat (length lst)

(setq layName (strcat ln (itoa (1+ i))))

(create-layout layName)

(setvar 'Ctab layName)

(if (setq ssold (ssget "_X" (list (cons 410 layName))))

(mapcar '(lambda (e) (entdel e)) (mapcar 'cadr (ssnamex ssold))))

(copy2layout (car (car (nth i lst))) (cadr (car (nth i lst))) layName)

(setq i (1+ i)))))

(setvar 'ctab cur_tab)

(vla-endundomark acaddoc)

(princ))

P/s: Cái của bác KangKung hình như chưa đúng yêu cầu.

 

Bác viết thêm tính năng khi tách thành các layout thì đồng thời move tất cả các viewport đó về 1 tọa độ (ví dụ tọa độ 0,0) để tiện cho việc copy tọa độ

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

minhchien89tb    0

minhchien89tb
Đã đăng

 

Của bạn đây.

 

71162_clo.jpg

 

Hướng dẫn: 

1. Lệnh CLO

2. Chọn máy in, khổ giấy, style...

3. Đặt tên Layout, tỉ lệ

4. Chọn các khung hình chữ nhật (Polyline) bên Model để tạo Viewport bên Layout. Khi quét chọn thì Lisp sẽ tự động căn các khung theo thứ tự từ trái sang phải.

5. Chọn Block hoặc file xref. Nếu không cần thì khỏi chọn.

6. Bấm OK, Lisp sẽ tạo mỗi bản vẽ trên một Layout.

;LISP TAO LAYOUT HANG LOAT BANG CACH CHON KHUNG VIEW BEN MODEL
(vl-load-com)
(defun Make_dcl	(/ ret)
  (if (= Printer nil) (setq Printer 0))
  (if (= Size nil) (setq Size 0))
  (if (= Style nil) (setq Style 0))
  (if (= Block nil) (setq Block 0))
  (if (= TenLayout nil) (setq TenLayout "Layout"))
  (if (= Tyle nil) (setq Tyle "1000"))
  (setq fl (vl-filename-mktemp "CLO" nil ".dcl"))
  (setq ret (open fl "w"))
  (write-line
    (strcat
      "CLO : dialog { label = \"Create Layout\";
      : column {
      : boxed_column {label = \"Page Setup\";
      : popup_list { key=\"Printer\"; label= \"Printer\";  value = \"" (itoa Printer) "\"; edit_width = 40;}
      : popup_list { key=\"PaperSize\"; label= \"Paper Size   \"; value = \"" (itoa Size) "\"; edit_width = 40;}
      : popup_list { key=\"Style\"; label= \"Style            \"; value = \"" (itoa Style) "\";edit_width = 40;}
      : edit_box {   key = \"LO_name\"; label = \"Layout Name  \"; value = \"" TenLayout "\";edit_width = 20;}
      : edit_box {   key = \"Tyle\"; label = \"Drawing Scale\"; value = \"" Tyle "\";edit_width = 20;}}
      : button { key = \"Chonkhung\"; label = \"Select Frame \"; }
      : boxed_column {
      label = \"\";
      :row {
      : button { key = \"TaoBlock\"; label = \"Create Title Block\"; is_default = false; width=30; fixed_width=true;}
      : popup_list {key=\"Block\"; label= \"Block\"; width=30; fixed_width=true; value = \"" (itoa Block) "\";}}
      : row {
      : button {key = \"Select_Xref\"; label = \"Xref Title Block\"; is_default = false; width=30; fixed_width=true;}
      : button {key = \"Remove\"; label = \"Remove Title Block\"; is_default = false; width=30; fixed_width=true;}}
      : list_box {label =\"\"; key = \"Xref_File\"; height = 3; value = \"0\";}
      }
      : boxed_row {
      : button { key = \"accept\"; label = \" OK \"; width=30; fixed_width=true; is_default = true;}
      : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; width=30; fixed_width=true;}}}} "
    )
    ret
  )
  (setq ret (close ret))
)
(defun *error* (msg) (vl-file-delete fl))
(defun Chon ()
  (vl-file-delete fl)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (Make_dcl)
  (setq ddiag 3)
)
(defun TaoBlock (/ taphop pt)
  (vl-file-delete fl)
  (alert "Chon doi tuong de tao Block khung ten")
  (if (/= (setq taphop(ssget)) nil)
    (progn
      (setq pt(getpoint "\n Chon Base point cua Block: "))
      (setq ten(lisped "Nhap ten cua Block"))
      (while (/= (tblsearch "Block" ten) nil)
	(setq ten(lisped "Trung ten Block da co. Nhap ten khac cho Block")))
      (command "BLOCK" ten pt taphop "")
      (setq dsblock(cons "" (tablelist "Block")))
      ))
  (Make_dcl)
  (setq ddiag 3)
)
(defun Update ()
  (vla-put-ConfigName (ActLay) (nth (atoi (get_tile "Printer")) dsmayin))
  (setq dsPaper (PaperList))
  (start_list "PaperSize" 3)
  (mapcar 'add_list dsPaper)
  (end_list)
)
(defun Chon_Xref ()
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq File(getfiled "Chon File khung ten" Path "dwg" 2))
  (if (/= File nil) (setq Path File dsFile (list File)))
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  )
(defun Remove_Xref ()
  (setq File "" dsFile (list File))
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  )
(defun ActLay () (vla-get-ActiveLayout(vla-get-activedocument(vlax-get-acad-object))))
(defun PlotDeviceNamesList ()
  (vla-RefreshPlotDeviceInfo (ActLay))
  (vlax-safearray->list(vlax-variant-value(vla-GetPlotDeviceNames (ActLay)))))
(defun PaperList (/ PLObj PSL)
  (setq PLObj (vla-GetCanonicalMediaNames (ActLay)))
  (foreach i (vlax-safearray->list (vlax-variant-value PLObj))
    (setq PSL (append PSL (list (vla-GetLocaleMediaName (ActLay) i))))))
(defun PlotStyleTableNamesList ()
  (vla-RefreshPlotDeviceInfo (ActLay))
  (vlax-safearray->list(vlax-variant-value(vla-GetPlotStyleTableNames(ActLay)))))
(defun tablelist (s / d r)
  (while (setq d (tblnext s (null d)))
    (setq r (cons (cdr (assoc 2 d)) r))))
(defun DeleteLayouts (/ layouts layout i)
  (vl-load-com)
  (setq	layouts	(vla-get-Layouts(vla-get-activedocument (vlax-get-acad-object))))
  (if (> (vla-get-count layouts) 2)
    (vlax-for layout layouts
      (if (= (vla-get-ModelType layout) :vlax-false)
	(if (< (vla-get-count (vla-get-block layout)) 2)
	  (vla-delete layout))))))
(setq dsmayin (PlotDeviceNamesList))
(setq dsStyle (PlotStyleTableNamesList))
(setq dsblock(cons "" (tablelist "Block")))
(defun hopthoai	()
  (setq dcl_id (load_dialog fl))
  (if (not (new_dialog "CLO" dcl_id)) (exit))
  (start_list "Printer" 3)
  (mapcar 'add_list dsmayin)
  (end_list)
  (Update)
  (action_tile "Printer" "(Update)")
  (action_tile "Chonkhung" "(setq ddiag 5)(saveVars)(done_dialog)")
  (action_tile "TaoBlock" "(setq ddiag 9)(saveVars)(done_dialog)")
  (start_list "Style" 3)
  (mapcar 'add_list dsStyle)
  (end_list)
  (start_list "Block" 3)
  (mapcar 'add_list dsBlock)
  (end_list)
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  (action_tile "Select_Xref" "(Chon_Xref)")
  (action_tile "Xref_File" "(Chon_Xref)")
  (action_tile "Remove" "(Remove_Xref)")
  
  (action_tile "cancel" "(setq ddiag 1)(done_dialog)")
  (action_tile "accept" "(setq ddiag 2)(setq tieptuc 1)(saveVars)(done_dialog)" )
  (start_dialog)
  (unload_dialog dcl_id)
)
(defun saveVars	()
  (setq Printer (atoi (get_tile "Printer")))
  (setq Size (atoi (get_tile "PaperSize")))
  (setq Style (atoi (get_tile "Style")))
  (setq Tyle (get_tile "Tyle"))
  (setq Block (atoi (get_tile "Block")))
  
  (setq Printer1 (nth Printer dsmayin))
  (setq Size1 (nth Size (PaperList)))
  (setq Style1 (nth Style dsStyle))
  (setq TenLayout (get_tile "LO_name"))
  
  (setq Tyle1 (/ (atof (get_tile "Tyle")) 1000))
  (setq Block1 (nth Block dsBlock))
)
(defun C:CLO (/ os)
  (setvar "CMDECHO" 0)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setvar "TILEMODE" 1)
  (setq dsblock(cons "" (tablelist "Block")))
  (if (= File nil) (setq dsFile (list "")))
  (setq tieptuc 0)
  (Make_dcl)
  (setq ddiag 3)
  (while (= ddiag 3)
    (hopthoai)
    (if	(= ddiag 5) (Chon))
    (if	(= ddiag 9) (TaoBlock))
  )
  (vl-file-delete fl)
  (if (= tieptuc 1)
    (progn
      (Sapxepkhung)
      (Make_Layout)
      (DeleteLayouts)
      )
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
(defun Sapxepkhung(/ index khung S1 S2 D1 D2)
  (setq index 0)
  (setq lst_Khung(list))
  (setq S1 0 S2 0)
  (while (< index (sslength taphop))
    (setq khung (ssname taphop index))
    (setq lst_Khung(append lst_Khung (list(list khung S1 S2))))
    (setq index (1+ index))
    )
  (setq lst_Khung(vl-sort lst_Khung '(lambda (e1 e2) (< (cadr(assoc 10 (entget(car e1)))) (cadr(assoc 10 (entget(car e2))))))))
  )
(defun Make_Layout (/ disp index khung lst pt0 pt1 pt2 pt3 P1 P2)
  (setq disp(getenv "CreateViewports"))
  (setenv "CreateViewports" "0")
  (setq index 1)
  (foreach khung1 lst_Khung
    (setq khung (car khung1))
    (setq lst (acet-geom-vertex-list khung))
    (setq lst (vl-sort lst '(lambda(e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
    (setq pt0 (nth 0 lst) pt3 (nth 3 lst))
    (if	(> (cadr (nth 1 lst)) (cadr (nth 2 lst)))
      (setq pt1	(nth 1 lst) pt2	(nth 2 lst))
      (setq pt1	(nth 2 lst) pt2	(nth 1 lst)))
    (command "LAYOUT" "N" (strcat TenLayout (itoa (+ 0 index))))
    (command "LAYOUT" "S" (strcat TenLayout (itoa (+ 0 index))))
    (command "ERASE" "ALL" "")
    (if (/= File nil) (command "xref" "A" file (list 0 0) "" "" ""))
    (if (/= Block1 "") (command "INSERT" Block1 (list 0 0) "" "" ""))
    (command "ZOOM" "E")
    (if	(> (distance pt2 pt0) (distance pt1 pt0))
      (command "RECTANG"  (list 0 0) (list (/ (distance pt2 pt0) tyle1) (/ (distance pt1 pt0) tyle1)))
      (command "RECTANG"  (list 0 0) (list (/ (distance pt1 pt0) tyle1) (/ (distance pt2 pt0) tyle1)))
      )
    (command "MVIEW" "O" (entlast))
    (command "MSPACE")
    (if	(> (distance pt2 pt0) (distance pt1 pt0))
      (command "DVIEW" khung "" "TW" (- 90 (* (/ (angle pt0 pt1) pi) 180)) "")
      (command "DVIEW" khung "" "TW" (- 0 (* (/ (angle pt0 pt1) pi) 180)) ""))
    (command "ZOOM" "W" pt0 pt3)
    (command "PSPACE")
    (command "ZOOM" "E")
    (Setq P1 (Getvar "EXTMIN") P2 (Getvar "EXTMAX"))
    (command "PLOT" "Y" "" printer1 size1 "M" "L" "N" "W" P1 P2 "1" "C" "Y" Style1 "Y" "N" "N" "N" "N" "Y" "N")
    (command "MODEL")
    (setq index (+ index 1))
  )
  (setenv "CreateViewports" disp)
  (princ)
)
(princ "\n           Type CLO to run prog

thank bạn

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

minhchien89tb    0

minhchien89tb
Đã đăng
Vào lúc 7/9/2016 tại 11:22, KangKung đã nói:

 

Của bạn đây.

 

71162_clo.jpg

 

Hướng dẫn: 

1. Lệnh CLO

2. Chọn máy in, khổ giấy, style...

3. Đặt tên Layout, tỉ lệ

4. Chọn các khung hình chữ nhật (Polyline) bên Model để tạo Viewport bên Layout. Khi quét chọn thì Lisp sẽ tự động căn các khung theo thứ tự từ trái sang phải.

5. Chọn Block hoặc file xref. Nếu không cần thì khỏi chọn.

6. Bấm OK, Lisp sẽ tạo mỗi bản vẽ trên một Layout. 


;LISP TAO LAYOUT HANG LOAT BANG CACH CHON KHUNG VIEW BEN MODEL
(vl-load-com)
(defun Make_dcl	(/ ret)
  (if (= Printer nil) (setq Printer 0))
  (if (= Size nil) (setq Size 0))
  (if (= Style nil) (setq Style 0))
  (if (= Block nil) (setq Block 0))
  (if (= TenLayout nil) (setq TenLayout "Layout"))
  (if (= Tyle nil) (setq Tyle "1000"))
  (setq fl (vl-filename-mktemp "CLO" nil ".dcl"))
  (setq ret (open fl "w"))
  (write-line
    (strcat
      "CLO : dialog { label = \"Create Layout\";
      : column {
      : boxed_column {label = \"Page Setup\";
      : popup_list { key=\"Printer\"; label= \"Printer\";  value = \"" (itoa Printer) "\"; edit_width = 40;}
      : popup_list { key=\"PaperSize\"; label= \"Paper Size   \"; value = \"" (itoa Size) "\"; edit_width = 40;}
      : popup_list { key=\"Style\"; label= \"Style            \"; value = \"" (itoa Style) "\";edit_width = 40;}
      : edit_box {   key = \"LO_name\"; label = \"Layout Name  \"; value = \"" TenLayout "\";edit_width = 20;}
      : edit_box {   key = \"Tyle\"; label = \"Drawing Scale\"; value = \"" Tyle "\";edit_width = 20;}}
      : button { key = \"Chonkhung\"; label = \"Select Frame \"; }
      : boxed_column {
      label = \"\";
      :row {
      : button { key = \"TaoBlock\"; label = \"Create Title Block\"; is_default = false; width=30; fixed_width=true;}
      : popup_list {key=\"Block\"; label= \"Block\"; width=30; fixed_width=true; value = \"" (itoa Block) "\";}}
      : row {
      : button {key = \"Select_Xref\"; label = \"Xref Title Block\"; is_default = false; width=30; fixed_width=true;}
      : button {key = \"Remove\"; label = \"Remove Title Block\"; is_default = false; width=30; fixed_width=true;}}
      : list_box {label =\"\"; key = \"Xref_File\"; height = 3; value = \"0\";}
      }
      : boxed_row {
      : button { key = \"accept\"; label = \" OK \"; width=30; fixed_width=true; is_default = true;}
      : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; width=30; fixed_width=true;}}}} "
    )
    ret
  )
  (setq ret (close ret))
)
(defun *error* (msg) (vl-file-delete fl))
(defun Chon ()
  (vl-file-delete fl)
  (setq taphop(ssget '((0 . "POLYLINE,LWPOLYLINE"))))
  (Make_dcl)
  (setq ddiag 3)
)
(defun TaoBlock (/ taphop pt)
  (vl-file-delete fl)
  (alert "Chon doi tuong de tao Block khung ten")
  (if (/= (setq taphop(ssget)) nil)
    (progn
      (setq pt(getpoint "\n Chon Base point cua Block: "))
      (setq ten(lisped "Nhap ten cua Block"))
      (while (/= (tblsearch "Block" ten) nil)
	(setq ten(lisped "Trung ten Block da co. Nhap ten khac cho Block")))
      (command "BLOCK" ten pt taphop "")
      (setq dsblock(cons "" (tablelist "Block")))
      ))
  (Make_dcl)
  (setq ddiag 3)
)
(defun Update ()
  (vla-put-ConfigName (ActLay) (nth (atoi (get_tile "Printer")) dsmayin))
  (setq dsPaper (PaperList))
  (start_list "PaperSize" 3)
  (mapcar 'add_list dsPaper)
  (end_list)
)
(defun Chon_Xref ()
  (if (not Path) (setq Path(getvar "dwgprefix")))
  (setq File(getfiled "Chon File khung ten" Path "dwg" 2))
  (if (/= File nil) (setq Path File dsFile (list File)))
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  )
(defun Remove_Xref ()
  (setq File "" dsFile (list File))
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  )
(defun ActLay () (vla-get-ActiveLayout(vla-get-activedocument(vlax-get-acad-object))))
(defun PlotDeviceNamesList ()
  (vla-RefreshPlotDeviceInfo (ActLay))
  (vlax-safearray->list(vlax-variant-value(vla-GetPlotDeviceNames (ActLay)))))
(defun PaperList (/ PLObj PSL)
  (setq PLObj (vla-GetCanonicalMediaNames (ActLay)))
  (foreach i (vlax-safearray->list (vlax-variant-value PLObj))
    (setq PSL (append PSL (list (vla-GetLocaleMediaName (ActLay) i))))))
(defun PlotStyleTableNamesList ()
  (vla-RefreshPlotDeviceInfo (ActLay))
  (vlax-safearray->list(vlax-variant-value(vla-GetPlotStyleTableNames(ActLay)))))
(defun tablelist (s / d r)
  (while (setq d (tblnext s (null d)))
    (setq r (cons (cdr (assoc 2 d)) r))))
(defun DeleteLayouts (/ layouts layout i)
  (vl-load-com)
  (setq	layouts	(vla-get-Layouts(vla-get-activedocument (vlax-get-acad-object))))
  (if (> (vla-get-count layouts) 2)
    (vlax-for layout layouts
      (if (= (vla-get-ModelType layout) :vlax-false)
	(if (< (vla-get-count (vla-get-block layout)) 2)
	  (vla-delete layout))))))
(setq dsmayin (PlotDeviceNamesList))
(setq dsStyle (PlotStyleTableNamesList))
(setq dsblock(cons "" (tablelist "Block")))
(defun hopthoai	()
  (setq dcl_id (load_dialog fl))
  (if (not (new_dialog "CLO" dcl_id)) (exit))
  (start_list "Printer" 3)
  (mapcar 'add_list dsmayin)
  (end_list)
  (Update)
  (action_tile "Printer" "(Update)")
  (action_tile "Chonkhung" "(setq ddiag 5)(saveVars)(done_dialog)")
  (action_tile "TaoBlock" "(setq ddiag 9)(saveVars)(done_dialog)")
  (start_list "Style" 3)
  (mapcar 'add_list dsStyle)
  (end_list)
  (start_list "Block" 3)
  (mapcar 'add_list dsBlock)
  (end_list)
  (start_list "Xref_File" 3)
  (mapcar 'add_list dsFile)
  (end_list)
  (action_tile "Select_Xref" "(Chon_Xref)")
  (action_tile "Xref_File" "(Chon_Xref)")
  (action_tile "Remove" "(Remove_Xref)")
  
  (action_tile "cancel" "(setq ddiag 1)(done_dialog)")
  (action_tile "accept" "(setq ddiag 2)(setq tieptuc 1)(saveVars)(done_dialog)" )
  (start_dialog)
  (unload_dialog dcl_id)
)
(defun saveVars	()
  (setq Printer (atoi (get_tile "Printer")))
  (setq Size (atoi (get_tile "PaperSize")))
  (setq Style (atoi (get_tile "Style")))
  (setq Tyle (get_tile "Tyle"))
  (setq Block (atoi (get_tile "Block")))
  
  (setq Printer1 (nth Printer dsmayin))
  (setq Size1 (nth Size (PaperList)))
  (setq Style1 (nth Style dsStyle))
  (setq TenLayout (get_tile "LO_name"))
  
  (setq Tyle1 (/ (atof (get_tile "Tyle")) 1000))
  (setq Block1 (nth Block dsBlock))
)
(defun C:CLO (/ os)
  (setvar "CMDECHO" 0)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setvar "TILEMODE" 1)
  (setq dsblock(cons "" (tablelist "Block")))
  (if (= File nil) (setq dsFile (list "")))
  (setq tieptuc 0)
  (Make_dcl)
  (setq ddiag 3)
  (while (= ddiag 3)
    (hopthoai)
    (if	(= ddiag 5) (Chon))
    (if	(= ddiag 9) (TaoBlock))
  )
  (vl-file-delete fl)
  (if (= tieptuc 1)
    (progn
      (Sapxepkhung)
      (Make_Layout)
      (DeleteLayouts)
      )
    )
  (setvar "OSMODE" os)
  (command "UNDO" "END")
  (princ)
  )
(defun Sapxepkhung(/ index khung S1 S2 D1 D2)
  (setq index 0)
  (setq lst_Khung(list))
  (setq S1 0 S2 0)
  (while (< index (sslength taphop))
    (setq khung (ssname taphop index))
    (setq lst_Khung(append lst_Khung (list(list khung S1 S2))))
    (setq index (1+ index))
    )
  (setq lst_Khung(vl-sort lst_Khung '(lambda (e1 e2) (< (cadr(assoc 10 (entget(car e1)))) (cadr(assoc 10 (entget(car e2))))))))
  )
(defun Make_Layout (/ disp index khung lst pt0 pt1 pt2 pt3 P1 P2)
  (setq disp(getenv "CreateViewports"))
  (setenv "CreateViewports" "0")
  (setq index 1)
  (foreach khung1 lst_Khung
    (setq khung (car khung1))
    (setq lst (acet-geom-vertex-list khung))
    (setq lst (vl-sort lst '(lambda(e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
    (setq pt0 (nth 0 lst) pt3 (nth 3 lst))
    (if	(> (cadr (nth 1 lst)) (cadr (nth 2 lst)))
      (setq pt1	(nth 1 lst) pt2	(nth 2 lst))
      (setq pt1	(nth 2 lst) pt2	(nth 1 lst)))
    (command "LAYOUT" "N" (strcat TenLayout (itoa (+ 0 index))))
    (command "LAYOUT" "S" (strcat TenLayout (itoa (+ 0 index))))
    (command "ERASE" "ALL" "")
    (if (/= File nil) (command "xref" "A" file (list 0 0) "" "" ""))
    (if (/= Block1 "") (command "INSERT" Block1 (list 0 0) "" "" ""))
    (command "ZOOM" "E")
    (if	(> (distance pt2 pt0) (distance pt1 pt0))
      (command "RECTANG"  (list 0 0) (list (/ (distance pt2 pt0) tyle1) (/ (distance pt1 pt0) tyle1)))
      (command "RECTANG"  (list 0 0) (list (/ (distance pt1 pt0) tyle1) (/ (distance pt2 pt0) tyle1)))
      )
    (command "MVIEW" "O" (entlast))
    (command "MSPACE")
    (if	(> (distance pt2 pt0) (distance pt1 pt0))
      (command "DVIEW" khung "" "TW" (- 90 (* (/ (angle pt0 pt1) pi) 180)) "")
      (command "DVIEW" khung "" "TW" (- 0 (* (/ (angle pt0 pt1) pi) 180)) ""))
    (command "ZOOM" "W" pt0 pt3)
    (command "PSPACE")
    (command "ZOOM" "E")
    (Setq P1 (Getvar "EXTMIN") P2 (Getvar "EXTMAX"))
    (command "PLOT" "Y" "" printer1 size1 "M" "L" "N" "W" P1 P2 "1" "C" "Y" Style1 "Y" "N" "N" "N" "N" "Y" "N")
    (command "MODEL")
    (setq index (+ index 1))
  )
  (setenv "CreateViewports" disp)
  (princ)
)
(princ "\n           Type CLO to run program\n")

Nhờ KangKun và mọi người  sửa giúp mình là thêm lựa chọn 

+Có thể sắp xếp theo thứ tự từ trái qua phải trước, hoặc từ trên xuống dưới trước

+ Có thể sắp xếp theo thứ tự chọn từng khung 1

thank bạn nhiều

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

congviet    29

congviet
Đã đăng
Vào lúc 30/4/2013 tại 20:56, KangKung đã nói:

Lisp tạo Layout hàng loạt cho bản đồ dạng tuyến.

http://www.cadviet.com/upfiles/3/71162_tlo.zip

File đính kèm là bản vẽ + khung tên + Lisp để cho bác nào có nhu cầu thì dùng thử rồi cho ý kiến để hoàn thiện Lisp nhé. Đang viết dở nên chưa post code lên. Khi nào hoàn thành bản cuối cùng sẽ chia sẻ cho các bác. Đây chỉ là bản Demo thôi. Bản vẽ dùng để Test là của bạn Khaosatheco. 

Sơ qua về Lisp tí:

1. Lệnh TLO để chạy. Hộp thoại hiện ra như sau:

71162_tlo.jpg

2. Sau đó chọn máy in, khổ giấy, Style

3. Chọn Khung View và tim tuyến bên Model

4. Có thể lựa chọn khung tên Xref hoặc Block

5. Có thể in ngay ra máy in nhưng chương trình sẽ dừng lại ở phần tạo ra các layout để người sử dụng kiểm soát lỗi trước khi in ấn.

6. Sau khi chạy Lisp sẽ điền Lý trình đầu cuối và Lý trình đoạn tuyến vào khung tên, đồng thời tự động đánh số bản vẽ. 

7. Khi chọn khung view bên Model cho dù có chọn xuôi hay ngược thì khi sắp xếp Layout, bản vẽ có lý trình nhỏ sẽ xếp trước sau đó tăng dần đến lý trình lớn nhất.

Vài dòng giới thiệu thế, các bác dùng thử rồi Test lỗi hộ nhé.

Cho xuất bản phiên bản mới đi bạn ơi. Bản cũ báo hết hạn sử dụng rồi. Cám ơn.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

minhquanxdkd7    1

minhquanxdkd7
Đã đăng

@KangKun cảm ơn bạn!

Mình thấy lisp này rất hay rút ngắn được các thao tác.

Tuy nhiên mình thấy khi setup phần in trong layout vẫn phải điều chỉnh lại tốn rất nhiều thời gian.

Nếu như có thể bỏ phần "tỷ lệ bản vẽ" đi à tự động scale khung MV về kích thước khổ giấy thì tuyệt vời hơn nữa.

Ví dụ:

B1:mình vào layuot cài đặt Plot trong layout (nét in, khổ giấy, chế độ hiển thị làm mờ nét "Plot transparency" cái này mình cần nhất khi dùng layout...)

B2: Dùng lệnh theo lisp. khi đó chỉ cần khai báo khung in là A3 thì lisp sẽ tự tạo khung mv và scale khung rectang trong model về kích thước khổ giấy.

B3: Mình chỉ việc in (khi mà khung Mview đã được thu lại ở vị trí vùng in A3 rồi)

Hi vọng lisp này sẽ được hoàn thiện, nó rất tiện khi phải quản lý và tập hợp và in hàng trăm bản vẽ trong 1 dự án.

Thanks!

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

anhGeodesy    2

anhGeodesy
Đã đăng
Vào lúc 26/2/2013 tại 11:09, KangKung đã nói:

 

Lisp mới tạo viewport cho tất cả hình chữ nhật có cạnh nằm ngang, đứng, ... ngồi biggrin.png hoặc nghiêng. Sơ qua về các đặc điểm của Lisp này:

1. Tạo viewport cho tất cả các khung hình chữ nhật

2. Thêm lựa chọn Xref khung tên bản vẽ

3. Các viewport được sắp xếp theo phương đứng thay vì phương ngang như các Lisp trước

Bác nào có nhu cầu thì down về rồi test thử và cho ý kiến nhé.

http://www.cadviet.com/upfiles/3/71162_mtl_rev5.lsp

P/S: Lisp này sẽ giảm rất nhiều thao tác và thời gian cho những ai biên tập bản đồ khu vực rộng đặc biệt là bản đồ dạng tuyến. 

@Nhoclangbat: Sẽ post Lisp theo yêu cầu của nhoc sau nhé. 

;========LISP TAO VIEWPORT TREN LAYOUT BANG CACH CHON O MODEL========
;============================REV5====================================
;=========THEM LUA CHON XOAY HCN NGHIENG VA XREF KHUNG TEN===========
(defun C:mtl( / os lst khung pt0 pt1 pt2 pt3 Y index taphop xrefFile xref)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0) 
  (setq taphop(ssget (LIST (CONS 0 "POLYLINE,LWPOLYLINE"))))
  (if (= Tyle nil)
    (setq Tyle1 1)
    (setq Tyle1 Tyle))
  (setq Tyle (getreal (strcat "\n Ty le: <" (rtos Tyle1 2 0) "> ")))
  (if (= Tyle nil)
    (setq Tyle Tyle1))
  (setq xref(getstring "\n Ban co muon chen file khung ten hay khong? <Y/N>:"))
  (if (= (strcase xref) "Y")
    (progn
      (if (not Path)
	(setq Path(getvar "dwgprefix")))
      (setq xrefFile(getfiled "Chon File khung ten" Path "dwg" 2))
      (setq Path xrefFile)))
  (setq soluong (sslength taphop))
  (setq index 0)
  (command "LAYOUT" "N" "Layout1")
  (command "LAYOUT" "S" "Layout1")
  (command "ERASE" "ALL" "")
  (command "ZOOM" "E")
  (command "MODEL")
  (setq Y 0)
  (command "ZOOM" "E")
  (while (< index soluong)
    (setq khung(ssname taphop index))
    (setq lst(acet-geom-vertex-list khung))
    (setq lst (vl-sort lst '(lambda (e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
    (setq pt0(nth 0 lst) pt3(nth 3 lst))
    (if (> (cadr (nth 1 lst)) (cadr (nth 2 lst)))
      (setq pt1(nth 1 lst) pt2(nth 2 lst))
      (setq pt1(nth 2 lst) pt2(nth 1 lst))
      )
    (command "LAYOUT" "S" "Layout1")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (command "RECTANG" (list 0 Y) (list (distance pt2 pt0) (+ Y (distance pt1 pt0))))
      (command "RECTANG" (list 0 Y) (list (distance pt1 pt0) (+ y (distance pt2 pt0))))
      )
    (command "SCALE" (entlast) "" (list 0 Y) (/ 1 tyle))
    (command "MVIEW" "O" (entlast))
    (if (= (strcase xref) "Y")
      (command "xref" "A" xrefFile (list 0 Y) "" "" ""))
    (command "MSPACE")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (command "DVIEW" khung "" "TW" (- 90 (* (/ (angle pt0 pt1) pi) 180)) "")
      (command "DVIEW" khung "" "TW" (- 0 (* (/ (angle pt0 pt1) pi) 180)) "")
      )
    (command "ZOOM" "W" pt0 pt3)
    (command "PSPACE")
    (command "TEXT" "J" "MR" (list -50 (+ Y (/ (distance pt1 pt0) (* 2 tyle)))) (* 25 tyle) "0" (strcat "VP " (rtos (1+ index) 2 0)) "")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (setq Y(- Y 50 (/ (distance pt1 pt0) tyle)))
      (setq Y(- Y 50 (/ (distance pt2 pt0) tyle)))
      )
    (command "ZOOM" "W" (list -100 (+ Y (distance pt3 pt0))) (list (distance pt3 pt0) (- Y 50 (distance pt3 pt0))))
    (setq index (+ index 1))
    )
  (command "ZOOM" "E")
  (command "MODEL")
  (command "UNDO" "END")
  (setvar "OSMODE" os)
  (princ)
  )

@kangkang Cho mình hỏi là Lisp này không chay đc trên Cad2019 là do đâu?  mong đc sự giải đáp. cảm ơn!

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

letuan0601    2

letuan0601
Đã đăng
Vào lúc 26/2/2013 tại 11:09, KangKung đã nói:

 

Lisp mới tạo viewport cho tất cả hình chữ nhật có cạnh nằm ngang, đứng, ... ngồi biggrin.png hoặc nghiêng. Sơ qua về các đặc điểm của Lisp này:

1. Tạo viewport cho tất cả các khung hình chữ nhật

2. Thêm lựa chọn Xref khung tên bản vẽ

3. Các viewport được sắp xếp theo phương đứng thay vì phương ngang như các Lisp trước

Bác nào có nhu cầu thì down về rồi test thử và cho ý kiến nhé.

http://www.cadviet.com/upfiles/3/71162_mtl_rev5.lsp

P/S: Lisp này sẽ giảm rất nhiều thao tác và thời gian cho những ai biên tập bản đồ khu vực rộng đặc biệt là bản đồ dạng tuyến. 

@Nhoclangbat: Sẽ post Lisp theo yêu cầu của nhoc sau nhé.

Mình muốn lisp này xuất ra từng layout riêng biệt, có đặt tên cho layout như rev1 thì sửa chỗ nào các bác? mong các bác chỉ giúp!

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Biet ve CAD    258

Biet ve CAD
Đã đăng
Vào lúc 14/9/2019 tại 16:08, letuan0601 đã nói:

Mình muốn lisp này xuất ra từng layout riêng biệt, có đặt tên cho layout như rev1 thì sửa chỗ nào các bác? mong các bác chỉ giúp!

Bạn tham khảo lisp này nhé:

 

  • Like 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

PhamYen    2

PhamYen
Đã đăng

Em mới sử dụng lisp này nhưng thấy 1 số bất cập mong anh chị trong diễn đàn sửa giúp ạ

- nếu khung chọn không sắp sếp theo thứ tự mình có thể chọn theo pline hoặc text (số thứ tự) ở hình 1h1.jpg.61e41350722367144d57c6ff04f8b332.jpg

b1: đánh lệnh

b2: quét theo pline hoặc text 

b3: nhập khoảng cách giữa các khung bên layout

- Trường hợp đã sắp sếp theo thứ tự thì tự động đánh số (hoặc vẽ pline...) hình 2h2.jpg.d8cb0f67690737c60742c0a5098227c7.jpg

các bước sau như phần ở trên ạ 

 

 

 

aaa.dwg

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

hg_aum    2

hg_aum
Đã đăng
Vào lúc 26/1/2013 tại 10:04, KangKung đã nói:

Lần này hi vọng mọi thứ đã đúng hết ý của bác.

1. Đã bổ sung thêm dòng nhắc hỏi kí tự đầu của Layout. Nếu không nhập gì thì mặc định tên là Layout1, Layout2, …

2. Đã bổ sung thêm tỷ lệ khung Viewport cho layout tạo ra. Ví dụ tỉ lệ bản vẽ là 1/1000 thì nhập số 1 ở dòng nhắc lệnh, 1/500 thì nhập số 0.5, nếu tỷ lệ 1/2000 thì nhập số 2

3. Mình vẫn để dòng nhắc chọn khổ giấy vì khi in ấn thì chắc chắn phải chọn khổ giấy rồi, vậy nên thay vì chọn thủ công khổ giấy cho từng Layout một thì ở đây lisp nó chọn hàng loạt cho mình luôn. Giả dụ bác có 1000 Layout, sau này in ấn mà phải chọn khổ giấy cho từng Layout thì chắc… hết muốn in luôn.

Chúc bác vui.

http://www.cadviet.c...62_mtl_rev2.lsp

Dạ em chào các bác ạ. Mới đây em mới biết đến Lisp MTL này, em dựa vào để sửa thành lisp thống kê tọa độ và điền số thứ tự vào các đỉnh Polyline. Nhưng em không biết tính chiều dài các đỉnh như thế nào, cách lặp lại đỉnh đầu tiên như thế nào(các dữ liệu em để màu đỏ) để có kết quả như hình. Mong các bác sửa hoặc hướng dẫn giúp em với ạ.

cad.jpg

tao doa do cho cac hinh.LSP

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

boyphochien    1

boyphochien
Đã đăng
Vào lúc 29/12/2022 tại 10:15, BELIFT đã nói:

NHỜ SỬA LISP XUẤT VIEWPORT BÊN LAYOUT TỪ PHƯƠNG Y SANG PHƯƠNG X, MÌNH CẢM ƠN NHIỀU !

;========LISP TAO VIEWPORT TREN LAYOUT BANG CACH CHON O MODEL========
;============================REV5====================================
;=========THEM LUA CHON XOAY HCN NGHIENG VA XREF KHUNG TEN===========
(defun C:33( / os lst khung pt0 pt1 pt2 pt3 Y index taphop xrefFile xref)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0) 
  (setq taphop(ssget (LIST (CONS 0 "POLYLINE,LWPOLYLINE"))))
  (if (= Tyle nil)
    (setq Tyle1 1)
    (setq Tyle1 Tyle))
  (setq Tyle (getreal (strcat "\n Ty le: <" (rtos Tyle1 2 0) "> ")))
  (if (= Tyle nil)
    (setq Tyle Tyle1))
  (setq xref(getstring "\n Ban co muon chen file khung ten hay khong? <Y/N>:"))
  (if (= (strcase xref) "Y")
    (progn
      (if (not Path)
    (setq Path(getvar "dwgprefix")))
      (setq xrefFile(getfiled "Chon File khung ten" Path "dwg" 2))
      (setq Path xrefFile)))
  (setq soluong (sslength taphop))
  (setq index 0)
  (command "LAYOUT" "N" "Layout1")
  (command "LAYOUT" "S" "Layout1")
  (command "ERASE" "ALL" "")
  (command "ZOOM" "E")
  (command "MODEL")
  (setq Y 0)
  (command "ZOOM" "E")
  (while (< index soluong)
    (setq khung(ssname taphop index))
    (setq lst(acet-geom-vertex-list khung))
    (setq lst (vl-sort lst '(lambda (e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
    (setq pt0(nth 0 lst) pt3(nth 3 lst))
    (if (> (cadr (nth 1 lst)) (cadr (nth 2 lst)))
      (setq pt1(nth 1 lst) pt2(nth 2 lst))
      (setq pt1(nth 2 lst) pt2(nth 1 lst))
      )
    (command "LAYOUT" "S" "Layout1")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (command "RECTANG" (list 0 Y) (list (distance pt2 pt0) (+ Y (distance pt1 pt0))))
      (command "RECTANG" (list 0 Y) (list (distance pt1 pt0) (+ y (distance pt2 pt0))))
      )
    (command "SCALE" (entlast) "" (list 0 Y) (/ 1 tyle))
    (command "MVIEW" "O" (entlast))
    (if (= (strcase xref) "Y")
      (command "xref" "A" xrefFile (list 0 Y) "" "" ""))
    (command "MSPACE")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (command "DVIEW" khung "" "TW" (- 90 (* (/ (angle pt0 pt1) pi) 180)) "")
      (command "DVIEW" khung "" "TW" (- 0 (* (/ (angle pt0 pt1) pi) 180)) "")
      )
    (command "ZOOM" "W" pt0 pt3)
    (command "PSPACE")
    (command "TEXT" "J" "MR" (list -150 (+ Y (/ (distance pt1 pt0) (* 2 tyle)))) (* 25 tyle) "0" (strcat "VP " (rtos (1+ index) 2 0)) "")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (setq Y(+ Y 150 (/ (distance pt1 pt0) tyle)))
      (setq Y(+ Y 150 (/ (distance pt2 pt0) tyle)))
      )
    (command "ZOOM" "W" (list -100 (+ Y (distance pt3 pt0))) (list (distance pt3 pt0) (- Y 150 (distance pt3 pt0))))
    (setq index (+ index 1))
    )
  (command "ZOOM" "E")
  (command "MODEL")
  (command "UNDO" "END")
  (setvar "OSMODE" os)
  (princ)
  )

  • Like 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

amateurday    15

amateurday
Đã đăng
Vào lúc 26/1/2013 tại 10:04, KangKung đã nói:

Lần này hi vọng mọi thứ đã đúng hết ý của bác.

1. Đã bổ sung thêm dòng nhắc hỏi kí tự đầu của Layout. Nếu không nhập gì thì mặc định tên là Layout1, Layout2, …

2. Đã bổ sung thêm tỷ lệ khung Viewport cho layout tạo ra. Ví dụ tỉ lệ bản vẽ là 1/1000 thì nhập số 1 ở dòng nhắc lệnh, 1/500 thì nhập số 0.5, nếu tỷ lệ 1/2000 thì nhập số 2

3. Mình vẫn để dòng nhắc chọn khổ giấy vì khi in ấn thì chắc chắn phải chọn khổ giấy rồi, vậy nên thay vì chọn thủ công khổ giấy cho từng Layout một thì ở đây lisp nó chọn hàng loạt cho mình luôn. Giả dụ bác có 1000 Layout, sau này in ấn mà phải chọn khổ giấy cho từng Layout thì chắc… hết muốn in luôn.

Chúc bác vui.

http://www.cadviet.c...62_mtl_rev2.lsp

Phiên bản này là ổn nhất, tuy nhiên vì phiên bản nguồn mở, free nên THEO QUY TRÌNH:

- Chọn Polyline (HÌNH CHỮ NHẬT) bằng pick chứ không nên quét, thứ tự sẽ theo pick. Mỗi khung sẽ nằm 1 layout riêng.

- Chèn khung tên vào từng layout.

- Gõ lệnh LAYOUTMERGE để gộp tất cả layout lại.

 

Hơi mất công, nhưng vẫn nhanh hơn so với việc copy VP, double click VP, zoom, pan đúng vị trí tiếp theo, ...

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Về Đầu Trang AutoLisp
×