Đến nội dung


Hình ảnh
* * * - - 10 Bình chọn

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


  • Please log in to reply
131 replies to this topic

#121 PHAPLUONG

PHAPLUONG

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 27 August 2016 - 03:00 PM

Mình thấy lisp này rất hay rồi nhưng mình dùng sheetshet nên nhờ 2 pro là KangKun va Nhoclangbat giúp mình sửa líp #63-rev5 này thành mỗi layout là 1 viewport thì thất tuyệt vời, tôi xin chân thành cám ơn

mong bác bớt chút thời gian


  • 0

#122 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 07 September 2016 - 11:22 AM

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")


  • 2

#123 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 412 Bài viết
Điểm đánh giá: 88 (tàm tạm)

Đã gửi 07 September 2016 - 01:31 PM

@KangKung bác giúp em cái này được không? Nội dung có post trong bài dưới

 

http://www.cadviet.c...out-rieng-biet/

 

Em xin trích lại nội dung:

"Chào các bạn, 

Hiện tại mình có khá nhiều bản vẽ mà trong layout lại có nhiều khung Mview. Mình có tìm trên diễn đàn mà chưa có cách nào để tách nhanh khung mview thành các Layout riêng biệt mà vẫn giữ nguyên các thiết lập freeze của mview đó.
Các bạn giúp mình viết một lisp sau nhé:

1. Chạy lisp
2. Lisp yêu cầu người dùng chọn các khung mview cần tách
3. Người dùng chọn các khung mview
4. Lisp yêu cầu điền tên layout mới được tạo (ví dụ đặt tên là KH, thì các layout được tạo sẽ là KH1, KH2... đến khi hết khung Mview thì thôi)
5. Kết thúc lisp, lisp sẽ tách theo yêu cầu

Ghi chú: các layout mới được tạo từ các khung mview vẫn giữ nguyên các thiết lập về việc freeze layer của mview gốc.

Cảm ơn các bạn nhiều!


File ví dụ của mình:
- Trong file có layout Test có nhiều khung Mview, và các layout KH_1 ..v.v. là layout mong muốn khi thực hiện lisp
http://www.cadviet.com/upfiles/6/1969_drawing1.dwg "

Cảm ơn bác trước nhé!


  • 0

#124 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 07 September 2016 - 04:52 PM

Hình như mình đã từng làm cái #123 rồi.


  • 0

#125 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 412 Bài viết
Điểm đánh giá: 88 (tàm tạm)

Đã gửi 07 September 2016 - 05:16 PM

Hình như mình đã từng làm cái #123 rồi.

 

 

@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é!


  • 0

#126 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 07 September 2016 - 05:17 PM

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))))

  • 1

#127 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 07 September 2016 - 05:56 PM

@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.c...chviewports.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.
  • 1

#128 Han Tinh

Han Tinh

    biết vẽ pline

  • Members
  • PipPip
  • 63 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 07 September 2016 - 09:19 PM

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)
  )

  • 0

#129 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 08 September 2016 - 09:12 AM

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? 


  • 0

#130 Han Tinh

Han Tinh

    biết vẽ pline

  • Members
  • PipPip
  • 63 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 08 September 2016 - 06:45 PM

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
  • 0

#131 PHAPLUONG

PHAPLUONG

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 09 September 2016 - 11:12 AM

 

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...c0RhNzRuSzAyWms


  • 0

#132 quang_lac

quang_lac

    biết lệnh mirror

  • Members
  • PipPipPip
  • 151 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 21 September 2016 - 04:37 PM

Tìm thấy trong máy rồi:
http://www.cadviet.c...chviewports.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 độ


  • 0