[Nhờ giúp đỡ] lisp chia viewport trong layout

Tháng 4 19, 2013

em chào các anh ạ

các anh viết giúp em lisp như thế này với ạ

b1. chọn viewport cần chia

b2.chọn điểm cần chia

b3.viewport chọn đc chia thành 2 viewport tách rời nhau

ví dụ như thế này ạ

-em có 1 viewport như thế này trong layout

-sau đó chọn điểm cần chia ra

--viewport chọn chia thành 2 viewport

-kết quả cuối cùng

Tháng 4 20, 2013

Chào bạn Engineer0405! Ý tưởng rất hay. Vote bạn.

Còn đây là Lisp viết theo ý tưởng của bạn.

Khi dùng chỉ cần đánh lệnh rồi chọn Viewport (chọn bao nhiêu thì tùy ý nhưng chỉ có cái đầu tiên được chia thôi). Sau đó Lisp sẽ chia viewport đó thành 2 viewport nhỏ dựa theo điểm chia (điểm này có thể chọn bất kì trên đường thẳng đứng). Chia xong Lisp sẽ chờ người sử dụng chọn tiếp Viewport khác. Nếu không chọn nữa thì bấm Space, Esc, Enter hoặc chuột phải.

;==========LISP CHIA 1 VIEWPORT THANH 2 VIEWPORT==========
;==================KANGKUNG 20/04/2013====================
(defun C:CVP ( / Viewport vpdata centerpoint VP_Width VP_Height pt cPWp utObj mPt xPt lbCon trCon verLst tyle P1 P2)
  (vl-load-com)
  (if (= (getvar "TILEMODE") 0)
    (progn
      (if (/= (getvar "cvport") 1) (command "PSPACE"))
      (command "UNDO" "BE")
      (while (setq Viewport (ssget '((0 . "VIEWPORT"))))
	(setq vpdata(entget (ssname Viewport 0)))
	(setq n(cdr(assoc 69 vpdata)))
	(command "MSPACE") (setvar "cvport" n) (command "PSPACE")
	(setq centerpoint(cdr(assoc 10 vpdata))) (setq VP_Width(cdr(assoc 40 vpdata))) (setq VP_Height(cdr(assoc 41 vpdata)))
	(setq pt(getpoint "\n Chon diem chia: "))
	(if (not dist) (setq dist(atof(lisped "\n Nhap khoang cach giua cac Vport vao day.")))
	  (setq dist(atof(lisped (rtos dist 2 2)))))
	(setq cPWp(vlax-ename->vla-object (ssname Viewport 0))
	      utObj(vla-get-Utility(vla-get-ActiveDocument(vlax-get-acad-Object))))
	(vla-GetBoundingBox cPWp 'mPt 'xPt)
	(setq lbCon(vla-TranslateCoordinates utObj mPt acPaperSpaceDCS acDisplayDCS :vlax-false)
	      trCon(vla-TranslateCoordinates utObj xPt acPaperSpaceDCS acDisplayDCS :vlax-false))
	(if(and lbCon trCon) (setq verLst(list (vlax-safearray->list(vlax-variant-value lbCon)) (vlax-safearray->list(vlax-variant-value trCon)))))
	(setq os(getvar "OSMODE"))
	(setvar "OSMODE" 0)
	(setq tyle(/ VP_Width (- (car(cadr verLst)) (car(car verLst)))))
	(setq P1(list (+ (car (car verLst)) (/ (+ (/ VP_Width 2) (- (car pt) (car centerpoint))) tyle))
		      (cadr (cadr verLst)))
	       P2(list (car P1) (cadr (car verLst))))
	(command "MVIEW" (list (car pt) (+  (cadr centerpoint) (/ VP_Height 2))) (list (- (car centerpoint) (/ VP_Width 2)) (- (cadr centerpoint) (/ VP_Height 2))))
	(command "MSPACE") (command "ZOOM" (car verLst) P1) (command "PSPACE")
	(command "MVIEW" (list (+ (car pt) dist) (+  (cadr centerpoint) (/ VP_Height 2))) (list (+ (car centerpoint) dist (/ VP_Width 2)) (- (cadr centerpoint) (/ VP_Height 2))))
	(command "MSPACE") (command "ZOOM" P2 (cadr verLst)) (command "PSPACE")
	(command "ERASE" (ssname Viewport 0) "")
	(setvar "OSMODE" os)
	(command "UNDO" "END")
	)
      )
    (alert "Chuyen sang Layout truoc khi chay Lisp")
    )
  )
(defun *error* (msg)
  (if (/= os nil) (setvar "OSMODE" os))
  (command "UNDO" "END")
  )
(princ "\n              KangKung - 20/04/2013\n")
(princ "\n           Nhap CVP de chay chuong trinh\n")

Tháng 4 20, 2013

Bác ơi xem giúp hộ em lỗi này với :)

Tháng 4 20, 2013

Chào bạn Engineer0405! Ý tưởng rất hay. Vote bạn.

Còn đây là Lisp viết theo ý tưởng của bạn.

Khi dùng chỉ cần đánh lệnh rồi chọn Viewport (chọn bao nhiêu thì tùy ý nhưng chỉ có cái đầu tiên được chia thôi). Sau đó Lisp sẽ chia viewport đó thành 2 viewport nhỏ dựa theo điểm chia (điểm này có thể chọn bất kì trên đường thẳng đứng). Chia xong Lisp sẽ chờ người sử dụng chọn tiếp Viewport khác. Nếu không chọn nữa thì bấm Space, Esc, Enter hoặc chuột phải.

em cảm ơn anh ạ

lisp rất đúng ý em

chúc anh luôn may mắn ạ

Tháng 4 20, 2013

Bác ơi xem giúp hộ em lỗi này với :)

OMG! quên mất 1 dòng code trong Lisp. Đã thêm vào rồi bạn down lại nhé.

chúc anh luôn may mắn ạ

Thanks engineer. Bạn cũng vậy.

Tháng 4 21, 2013

Kangkung: bạn có thể sửa và thêm chia view theo chiều đứng được không. vì đôi khi chúng ta chia view của cột nhưng lại không cần phải xoay ngang nó ra như dầm và có thể cho nhập khoang các bằng 0 được không. hiện tịa chia view của bạn mới chỉ có thể chia view ngang còn view dọc thì hok thể chia được. và cũng có thể cho nó đi chuyên ra xa nhau hok hok tuy theo n gười dùng được hok. TKS

Tháng 4 21, 2013

Tất nhiên là được bạn ah. Không những chia view ngang, dọc mà còn có thể chia thành nhiều hàng nhiều cột bằng cách pick điểm liên tiếp vào viewport cần chia nữa cơ. Tuy nhiên cách chia như thế thì cần phải bắt điểm chính xác hơn chứ không thể bắt điểm thoải mái như chọn bừa 1 điểm trên đường thẳng song song với phương cần chia. Cụ thể bạn muốn thế nào thì minh họa bằng hình ảnh hoặc file Cad nhé, mình sẽ giúp.

Tháng 4 21, 2013

@KK : nhanh lên vậy ta, tks ngay ^^ Lisp ứng dụng tốt.

Mình đề nghị một cách đơn giản nữa để code :

Copy thêm 1 cái nữa rồi vpclip ^^

Tháng 4 22, 2013

Thanks ketxu. Một ý kiến hay.

Nhân đây mình post thêm version mới của Lisp chia Viewport. Sơ qua về Lisp mới này:

1. Cắt viewport theo phương ngang (nếu chọn điểm chia nằm trên cạnh ngang)

2. Cắt theo phương thẳng đứng (nếu chọn điểm chia nằm trên cạnh đứng)

3. Cắt viewport thành 4 viewport nếu chọn điểm cắt không thỏa mãn cả 2 điều kiện trên.

4. Có thể mở rộng viewport bằng cách chọn điểm cắt nằm ngoài khung viewport gốc.

Tất cả đều dùng chung 1 lệnh là CVP và kết quả sẽ ra 2 hoặc 4 viewport tùy thuộc vào vị trí chọn điểm chia. Lisp này thỏa mãn được nhiều nhu cầu chia khác nhau tuy nhiên cách chọn điểm cắt sẽ phải chính xác hơn Lisp #2. Các bạn xem hình minh họa dưới đây rồi Test thử xem có lỗi gì không. Thanks

;==========LISP CHIA 1 VIEWPORT THANH 2 VIEWPORT================
;==================KANGKUNG 21/04/2013==========================
;UPDATE THEM PHAN CHIA THEO CHIEU NGANG, DOC, HOAC THANH 4 VPORT
(defun C:CVP ( / Viewport vpdata centerpoint VP_Width VP_Height pt cPWp utObj mPt xPt lbCon trCon verLst tyle
	      pt1 pt2 pt3 pt4 pt1A pt1B pt2A pt2B pt3A pt3B pt4A pt4B P1 P2 P3 P4 P5 list_VP kd kn layer)
  (vl-load-com)
  (if (= (getvar "TILEMODE") 0)
    (progn
      (if (/= (getvar "cvport") 1) (command "PSPACE"))
      (command "UNDO" "BE")
      (while (setq Viewport (ssget '((0 . "VIEWPORT"))))
	(setq vpdata(entget (ssname Viewport 0)))
	(setq layer(cdr(assoc 8 vpdata)))
	(setq n(cdr(assoc 69 vpdata)))
	(command "MSPACE") (setvar "cvport" n) (command "PSPACE")
	(setq centerpoint(cdr(assoc 10 vpdata))) (setq VP_Width(cdr(assoc 40 vpdata))) (setq VP_Height(cdr(assoc 41 vpdata)))
	(setq pt(getpoint "\n Chon diem chia: "))
	(setq os(getvar "OSMODE"))
	(setvar "OSMODE" 0)
	(if (not dist) (setq dist(atof(lisped "Nhap khoang cach giua cac Vport vao day.")))
	  (setq dist(atof(lisped (rtos dist 2 2)))))
	(setq cPWp(vlax-ename->vla-object (ssname Viewport 0))
	      utObj(vla-get-Utility(vla-get-ActiveDocument(vlax-get-acad-Object))))
	(vla-GetBoundingBox cPWp 'mPt 'xPt)
	(setq lbCon(vla-TranslateCoordinates utObj mPt acPaperSpaceDCS acDisplayDCS :vlax-false)
	      trCon(vla-TranslateCoordinates utObj xPt acPaperSpaceDCS acDisplayDCS :vlax-false))
	(if(and lbCon trCon) (setq verLst(list (vlax-safearray->list(vlax-variant-value lbCon)) (vlax-safearray->list(vlax-variant-value trCon)))))
	(setq tyle(/ VP_Width (- (car(cadr verLst)) (car(car verLst)))))
	(setq pt1(list (- (car centerpoint) (/ VP_Width 2)) (+ (cadr centerpoint) (/ VP_Height 2)))
	      pt2(list (+ (car centerpoint) (/ VP_Width 2)) (+ (cadr centerpoint) (/ VP_Height 2)))
	      pt3(list (+ (car centerpoint) (/ VP_Width 2)) (- (cadr centerpoint) (/ VP_Height 2)))
	      pt4(list (- (car centerpoint) (/ VP_Width 2)) (- (cadr centerpoint) (/ VP_Height 2)))
	      pt1A pt1
	      pt1B(list (+ (car pt1) (abs(- (car pt1) (car pt)))) (- (cadr pt1) (abs(- (cadr pt1) (cadr pt)))))
	      pt2A(list (+ (car pt1) (abs(- (car pt1) (car pt))) dist) (cadr pt1))
	      pt2B(list (+ (car pt2A) (abs(- (car pt2) (car pt)))) (cadr pt1B))
	      pt3A(list (car pt2A) (- (cadr pt2B) dist))
	      pt3B(list (car pt2B) (- (cadr pt3A) (abs(- (cadr pt3) (cadr pt)))))
	      pt4A(list (car pt1A) (cadr pt3A))
	      pt4B(list (car pt1B) (cadr pt3B)))
	(setq P1(list (car (car verLst)) (cadr (cadr verLst)))
	      P2(cadr verLst)
	      P3(list (car (cadr verLst)) (cadr (car verLst)))
	      P4(car verLst)
	      P5(list (+ (car P4) (/ (- (car pt) (car pt4)) tyle))
		      (+ (cadr P4) (/ (- (cadr pt) (cadr pt4)) tyle))))
	(if (= (car pt) (car pt1)) (setq kn 1) (setq kn 0))
	(if (= (cadr pt) (cadr pt1)) (setq kd 1) (setq kd 0))
	(setq list_VP(list (list pt1A pt1B P1 P5)
			   (list pt2A pt2B P2 P5)
			   (list pt3A pt3B P3 P5)
			   (list pt4A pt4B P4 P5)))
	(foreach VP list_VP
	  (if (/= (* (- (car (car VP)) (car (cadr VP))) (- (cadr (car VP)) (cadr (cadr VP)))) 0)
	    (progn
	      (command "MVIEW" (car VP) (cadr VP))
	      (command "MOVE" (entlast) "" (car VP) (list (- (car (car VP)) (* kn dist)) (+ (cadr (car VP)) (* kd dist))))
	      (command "MSPACE") (command "ZOOM" (caddr VP) (cadddr VP)) (command "PSPACE")
	      (vla-put-layer (vlax-ename->vla-object (entlast)) layer)
	      (vla-put-displaylocked (vlax-ename->vla-object (entlast)) :vlax-true)
	      )
	    )
	  )
	(command "ERASE" (ssname Viewport 0) "")
	(setvar "OSMODE" os)
	(command "UNDO" "END")
	)
      )
    (alert "Chuyen sang Layout truoc khi chay Lisp")
    )
  )
(defun *error* (msg)
  (if (/= os nil) (setvar "OSMODE" os))
  (command "UNDO" "END")
  )
(princ "\n              KangKung - 21/04/2013\n")
(princ "\n           Nhap CVP de chay chuong trinh\n")

Minh họa tí cho sinh động:

Tháng 4 22, 2013

Thanks ketxu. Một ý kiến hay.

Nhân đây mình post thêm version mới của Lisp chia Viewport. Sơ qua về Lisp mới này:

1. Cắt viewport theo phương ngang (nếu chọn điểm chia nằm trên cạnh ngang)

2. Cắt theo phương thẳng đứng (nếu chọn điểm chia nằm trên cạnh đứng)

3. Cắt viewport thành 4 viewport nếu chọn điểm cắt không thỏa mãn cả 2 điều kiện trên.

4. Có thể mở rộng viewport bằng cách chọn điểm cắt nằm ngoài khung viewport gốc.

Tất cả đều dùng chung 1 lệnh là CVP và kết quả sẽ ra 2 hoặc 4 viewport tùy thuộc vào vị trí chọn điểm chia. Lisp này thỏa mãn được nhiều nhu cầu chia khác nhau tuy nhiên cách chọn điểm cắt sẽ phải chính xác hơn Lisp #2. Các bạn xem hình minh họa dưới đây rồi Test thử xem có lỗi gì không. Thanks

cảm ơn anh KangKung ạ:

em có ý kiến này anh có thể bổ sung vào lisp không ạ

1. vấn đề layer vẽ khung view port thì khi mình chia xong vẫn lấy layer của khung cũ chứ không phải chọn sang layer khác

2.lock tất cả các viewport đc chia sau khi chia xong

anh giúp luôn ạ

em cảm ơn anh

p/s: à anh KangKung có mail không cho em xin với

em có mấy vấn đề vướng

hi vọng anh có thể giúp em

Tháng 4 22, 2013

Chào bạn engineer. Mình đã sửa Lisp theo ý bạn. Down lại ở #9 nhé.

Đây là hòm thư của mình: hauvv@egssurvey.com

Rất sẵn lòng giúp đỡ bạn nếu có thể.

Tháng 5 25, 2013

Cái lisp chia CVP này của bạn có thể sửa thành chọn MV sau đó chia thành 4 khung nhỏ được ko ?

Tháng 5 25, 2013

có thể chia thành nhiều vp con hơn đc k kk?

Tháng 8 12, 2014

Thanks ketxu. Một ý kiến hay.

Nhân đây mình post thêm version mới của Lisp chia Viewport. Sơ qua về Lisp mới này:

1. Cắt viewport theo phương ngang (nếu chọn điểm chia nằm trên cạnh ngang)

2. Cắt theo phương thẳng đứng (nếu chọn điểm chia nằm trên cạnh đứng)

3. Cắt viewport thành 4 viewport nếu chọn điểm cắt không thỏa mãn cả 2 điều kiện trên.

4. Có thể mở rộng viewport bằng cách chọn điểm cắt nằm ngoài khung viewport gốc.

Tất cả đều dùng chung 1 lệnh là CVP và kết quả sẽ ra 2 hoặc 4 viewport tùy thuộc vào vị trí chọn điểm chia. Lisp này thỏa mãn được nhiều nhu cầu chia khác nhau tuy nhiên cách chọn điểm cắt sẽ phải chính xác hơn Lisp #2. Các bạn xem hình minh họa dưới đây rồi Test thử xem có lỗi gì không. Thanks

;==========LISP CHIA 1 VIEWPORT THANH 2 VIEWPORT================
;==================KANGKUNG 21/04/2013==========================
;UPDATE THEM PHAN CHIA THEO CHIEU NGANG, DOC, HOAC THANH 4 VPORT
(defun C:CVP ( / Viewport vpdata centerpoint VP_Width VP_Height pt cPWp utObj mPt xPt lbCon trCon verLst tyle
	      pt1 pt2 pt3 pt4 pt1A pt1B pt2A pt2B pt3A pt3B pt4A pt4B P1 P2 P3 P4 P5 list_VP kd kn layer)
  (vl-load-com)
  (if (= (getvar "TILEMODE") 0)
    (progn
      (if (/= (getvar "cvport") 1) (command "PSPACE"))
      (command "UNDO" "BE")
      (while (setq Viewport (ssget '((0 . "VIEWPORT"))))
	(setq vpdata(entget (ssname Viewport 0)))
	(setq layer(cdr(assoc 8 vpdata)))
	(setq n(cdr(assoc 69 vpdata)))
	(command "MSPACE") (setvar "cvport" n) (command "PSPACE")
	(setq centerpoint(cdr(assoc 10 vpdata))) (setq VP_Width(cdr(assoc 40 vpdata))) (setq VP_Height(cdr(assoc 41 vpdata)))
	(setq pt(getpoint "\n Chon diem chia: "))
	(setq os(getvar "OSMODE"))
	(setvar "OSMODE" 0)
	(if (not dist) (setq dist(atof(lisped "Nhap khoang cach giua cac Vport vao day.")))
	  (setq dist(atof(lisped (rtos dist 2 2)))))
	(setq cPWp(vlax-ename->vla-object (ssname Viewport 0))
	      utObj(vla-get-Utility(vla-get-ActiveDocument(vlax-get-acad-Object))))
	(vla-GetBoundingBox cPWp 'mPt 'xPt)
	(setq lbCon(vla-TranslateCoordinates utObj mPt acPaperSpaceDCS acDisplayDCS :vlax-false)
	      trCon(vla-TranslateCoordinates utObj xPt acPaperSpaceDCS acDisplayDCS :vlax-false))
	(if(and lbCon trCon) (setq verLst(list (vlax-safearray->list(vlax-variant-value lbCon)) (vlax-safearray->list(vlax-variant-value trCon)))))
	(setq tyle(/ VP_Width (- (car(cadr verLst)) (car(car verLst)))))
	(setq pt1(list (- (car centerpoint) (/ VP_Width 2)) (+ (cadr centerpoint) (/ VP_Height 2)))
	      pt2(list (+ (car centerpoint) (/ VP_Width 2)) (+ (cadr centerpoint) (/ VP_Height 2)))
	      pt3(list (+ (car centerpoint) (/ VP_Width 2)) (- (cadr centerpoint) (/ VP_Height 2)))
	      pt4(list (- (car centerpoint) (/ VP_Width 2)) (- (cadr centerpoint) (/ VP_Height 2)))
	      pt1A pt1
	      pt1B(list (+ (car pt1) (abs(- (car pt1) (car pt)))) (- (cadr pt1) (abs(- (cadr pt1) (cadr pt)))))
	      pt2A(list (+ (car pt1) (abs(- (car pt1) (car pt))) dist) (cadr pt1))
	      pt2B(list (+ (car pt2A) (abs(- (car pt2) (car pt)))) (cadr pt1B))
	      pt3A(list (car pt2A) (- (cadr pt2B) dist))
	      pt3B(list (car pt2B) (- (cadr pt3A) (abs(- (cadr pt3) (cadr pt)))))
	      pt4A(list (car pt1A) (cadr pt3A))
	      pt4B(list (car pt1B) (cadr pt3B)))
	(setq P1(list (car (car verLst)) (cadr (cadr verLst)))
	      P2(cadr verLst)
	      P3(list (car (cadr verLst)) (cadr (car verLst)))
	      P4(car verLst)
	      P5(list (+ (car P4) (/ (- (car pt) (car pt4)) tyle))
		      (+ (cadr P4) (/ (- (cadr pt) (cadr pt4)) tyle))))
	(if (= (car pt) (car pt1)) (setq kn 1) (setq kn 0))
	(if (= (cadr pt) (cadr pt1)) (setq kd 1) (setq kd 0))
	(setq list_VP(list (list pt1A pt1B P1 P5)
			   (list pt2A pt2B P2 P5)
			   (list pt3A pt3B P3 P5)
			   (list pt4A pt4B P4 P5)))
	(foreach VP list_VP
	  (if (/= (* (- (car (car VP)) (car (cadr VP))) (- (cadr (car VP)) (cadr (cadr VP)))) 0)
	    (progn
	      (command "MVIEW" (car VP) (cadr VP))
	      (command "MOVE" (entlast) "" (car VP) (list (- (car (car VP)) (* kn dist)) (+ (cadr (car VP)) (* kd dist))))
	      (command "MSPACE") (command "ZOOM" (caddr VP) (cadddr VP)) (command "PSPACE")
	      (vla-put-layer (vlax-ename->vla-object (entlast)) layer)
	      (vla-put-displaylocked (vlax-ename->vla-object (entlast)) :vlax-true)
	      )
	    )
	  )
	(command "ERASE" (ssname Viewport 0) "")
	(setvar "OSMODE" os)
	(command "UNDO" "END")
	)
      )
    (alert "Chuyen sang Layout truoc khi chay Lisp")
    )
  )
(defun *error* (msg)
  (if (/= os nil) (setvar "OSMODE" os))
  (command "UNDO" "END")
  )
(princ "\n              KangKung - 21/04/2013\n")
(princ "\n           Nhap CVP de chay chuong trinh\n")

Minh họa tí cho sinh động:

Lisp này rất hay tuy nhiên mình toàn chia luôn tại điểm chọn chuột, vì thế đưa ra bảng chọn khoảng cách view port thấy không cần thiết lắm, bạn sửa lại là bỏ lựa chọn đó đi, chia luôn tại điểm chọn chuột luôn giùm mình được không

Mình cám ơn nhiều

Tháng 8 13, 2014

Lisp này rất hay tuy nhiên mình toàn chia luôn tại điểm chọn chuột, vì thế đưa ra bảng chọn khoảng cách view port thấy không cần thiết lắm, bạn sửa lại là bỏ lựa chọn đó đi, chia luôn tại điểm chọn chuột luôn giùm mình được không

Mình cám ơn nhiều

Ko có bạn nào giúp mình được ah?

Tháng 8 14, 2014

Bạn thử cái này. Chọn viewport trong layout, nhấp chọn điểm a, kéo ngang thì chia làm 2 vp theo phương ngang, kéo đứng thì chia 2 vp theo phương đứng, còn enter thì chia thành 4 viewport tại a.

(defun c:cvp(/ os vp tt10 tt12 tt40 tt41 tyle p1 p2 b c)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun dtim (pt) (polar tt12 (angle tt10 pt) (* tyle (distance tt10 pt))))
  (defun make (a b)
    (command "mview" a b)
    (vla-put-CustomScale (vlax-ename->vla-object (entlast)) (/ 1.0 tyle))    
    (command "MSPACE")
    (command "zoom" (dtim a) (dtim b))
    (command "PSPACE")
  )
  
  (command "undo" "be")
  (setq os (getvar 'osmode))
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 1 0 0 0))
  (setq vp  (car (entsel "\nChon viewport: "))
tt10 (dxf 10 vp)
tt12 (dxf 12 vp)
tt40 (dxf 40 vp)
tt41 (dxf 41 vp)
tyle (/ (dxf 45 vp) tt41 1.0)
p1 (polar (polar tt10 pi (* 0.5 tt40)) (* -0.5 pi) (* 0.5 tt41))
p2 (polar (polar tt10 0 (* 0.5 tt40)) (* 0.5 pi) (* 0.5 tt41))
b (getpoint "\Diem chia: ")
c (getpoint b "\nTheo huong <Enter neu chia 4>: "))
 
  (cond ((eq (car b) (car c))
           (make p1 (list (car b) (cadr p2)))
  (make (list (car b) (cadr p1)) p2))
 
((eq (cadr b) (cadr c)) 
           (make p1 (list (car p2) (cadr b)))
  (make (list (car p1) (cadr b)) p2))
 
        (t (make p1 b) (make b p2)
  (make b (list (car p1) (cadr p2)))
  (make b (list (car p2) (cadr p1))))
  )
  (entdel vp)
  (command "undo" "e")
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 0 0 1 os))  
)

Tháng 8 14, 2014

Bạn thử cái này. Chọn viewport trong layout, nhấp chọn điểm a, kéo ngang thì chia làm 2 vp theo phương ngang, kéo đứng thì chia 2 vp theo phương đứng, còn enter thì chia thành 4 viewport tại a.

(defun c:cvp(/ os vp tt10 tt12 tt40 tt41 tyle p1 p2 b c)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun dtim (pt) (polar tt12 (angle tt10 pt) (* tyle (distance tt10 pt))))
  (defun make (a b)
    (command "mview" a b)
    (vla-put-CustomScale (vlax-ename->vla-object (entlast)) (/ 1.0 tyle))    
    (command "MSPACE")
    (command "zoom" (dtim a) (dtim b))
    (command "PSPACE")
  )
  
  (command "undo" "be")
  (setq os (getvar 'osmode))
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 1 0 0 0))
  (setq vp  (car (entsel "\nChon viewport: "))
tt10 (dxf 10 vp)
tt12 (dxf 12 vp)
tt40 (dxf 40 vp)
tt41 (dxf 41 vp)
tyle (/ (dxf 45 vp) tt41 1.0)
p1 (polar (polar tt10 pi (* 0.5 tt40)) (* -0.5 pi) (* 0.5 tt41))
p2 (polar (polar tt10 0 (* 0.5 tt40)) (* 0.5 pi) (* 0.5 tt41))
b (getpoint "\Diem chia: ")
c (getpoint b "\nTheo huong <Enter neu chia 4>: "))
 
  (cond ((eq (car b) (car c))
           (make p1 (list (car b) (cadr p2)))
  (make (list (car b) (cadr p1)) p2))
 
((eq (cadr b) (cadr c)) 
           (make p1 (list (car p2) (cadr b)))
  (make (list (car p1) (cadr b)) p2))
 
        (t (make p1 b) (make b p2)
  (make b (list (car p1) (cadr p2)))
  (make b (list (car p2) (cadr p1))))
  )
  (entdel vp)
  (command "undo" "e")
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 0 0 1 os))  
)

Cám ơn bạn Tot77 nhé. Tiện đây bạn xem giúp mình ko hiểu sao khi chia viewport thì thi thoảng CAD không hiện được hình trong viewport mặc dù in ra vẫn có, điều này làm xếp bản vẽ khó hơn, không hiểu là lỗi lisp hay lỗi file

Mình có kèm file bên dưới, có 3 viewport không hiện được, bạn xem hộ mình lỗi tại sao nhé

Mình cám ơn nhiều

http://www.mediafire.com/download/8qsbwbw09ems5c0/HT_ct_be_phot,_be_nuoc_mai.dwg

Tháng 8 14, 2014

Do bạn cho cái biến MAXACTVP nhỏ hơn số lượng viewport (tôi thấy chỉ có 5 trong khi số vport của bạn nhiều hơn 5), bạn cho = 10 thì sẽ hiện lên hết.

Tháng 8 14, 2014

Do bạn cho cái biến MAXACTVP nhỏ hơn số lượng viewport (tôi thấy chỉ có 5 trong khi số vport của bạn nhiều hơn 5), bạn cho = 10 thì sẽ hiện lên hết.

Cám ơn bạn nhiều nhé, đơn giản thế mà mình ko biết. Trước mình chỉ biết là mỗi layout có tối đa là 54 viewport, tưởng là mặc định như vậy cơ, ko biết là có biến chỉnh số viewport như vậy :)

Tháng 8 17, 2014

Bạn thử cái này. Chọn viewport trong layout, nhấp chọn điểm a, kéo ngang thì chia làm 2 vp theo phương ngang, kéo đứng thì chia 2 vp theo phương đứng, còn enter thì chia thành 4 viewport tại a.

(defun c:cvp(/ os vp tt10 tt12 tt40 tt41 tyle p1 p2 b c)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun dtim (pt) (polar tt12 (angle tt10 pt) (* tyle (distance tt10 pt))))
  (defun make (a b)
    (command "mview" a b)
    (vla-put-CustomScale (vlax-ename->vla-object (entlast)) (/ 1.0 tyle))    
    (command "MSPACE")
    (command "zoom" (dtim a) (dtim b))
    (command "PSPACE")
  )
  
  (command "undo" "be")
  (setq os (getvar 'osmode))
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 1 0 0 0))
  (setq vp  (car (entsel "\nChon viewport: "))
tt10 (dxf 10 vp)
tt12 (dxf 12 vp)
tt40 (dxf 40 vp)
tt41 (dxf 41 vp)
tyle (/ (dxf 45 vp) tt41 1.0)
p1 (polar (polar tt10 pi (* 0.5 tt40)) (* -0.5 pi) (* 0.5 tt41))
p2 (polar (polar tt10 0 (* 0.5 tt40)) (* 0.5 pi) (* 0.5 tt41))
b (getpoint "\Diem chia: ")
c (getpoint b "\nTheo huong <Enter neu chia 4>: "))
 
  (cond ((eq (car b) (car c))
           (make p1 (list (car b) (cadr p2)))
  (make (list (car b) (cadr p1)) p2))
 
((eq (cadr b) (cadr c)) 
           (make p1 (list (car p2) (cadr b)))
  (make (list (car p1) (cadr b)) p2))
 
        (t (make p1 b) (make b p2)
  (make b (list (car p1) (cadr p2)))
  (make b (list (car p2) (cadr p1))))
  )
  (entdel vp)
  (command "undo" "e")
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 0 0 1 os))  
)

Lisp này rất tốt nhưng có 1 điều là nó đang tự động đổi layer của viewport theo layer hiện hành. Viewport toàn ở layer defpoint, ko để ý khi chia viewport mà layer hiện hành không phải là defpoint là nó đổi ngay theo layer hiện hành. khi in ra thấy ngay viewport. Bạn sửa lại giúp mình là khi chia viewport thì nó tự đổi layer của viewport là layer defpoint nhé

Mình cám ơn nhiều

Tháng 8 18, 2014

Bạn thêm dòng này ở đầu ct : (setvar 'clayer "defpoints")

Tháng 8 18, 2014

anh @Tot77 ơi anh có thể sữa lips 1 chút xíu là sau khi chia vp sẽ trả lại layer cũ của vp đồng thời khóa các vp đã đc chia ^^

thanks anh nhiều

Tháng 8 18, 2014

Bạn dùng cái này.

(defun c:cvp(/ os vp tt10 tt12 tt40 tt41 tyle p1 p2 b c layer)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun dtim (pt) (polar tt12 (angle tt10 pt) (* tyle (distance tt10 pt))))
  (defun make (a b / obj)
    (command "mview" a b)
    (vla-put-CustomScale (setq obj (vlax-ename->vla-object (entlast))) (/ 1.0 tyle))
    (vla-put-Layer obj layer)    
    (command "MSPACE")
    (command "zoom" (dtim a) (dtim b))
    (command "PSPACE")
    (vla-put-DisplayLocked obj :vlax-true)
  )
  
  (command "undo" "be")
  (setq os (getvar 'osmode))
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 1 0 0 0))
  (setq vp  (car (entsel "\nChon viewport: "))
tt10 (dxf 10 vp)
tt12 (dxf 12 vp)
tt40 (dxf 40 vp)
tt41 (dxf 41 vp)
layer (dxf 8 vp)
tyle (/ (dxf 45 vp) tt41 1.0)
p1 (polar (polar tt10 pi (* 0.5 tt40)) (* -0.5 pi) (* 0.5 tt41))
p2 (polar (polar tt10 0 (* 0.5 tt40)) (* 0.5 pi) (* 0.5 tt41))
b (getpoint "\Diem chia: ")
c (getpoint b "\nTheo huong <Enter neu chia 4>: "))
 
  (cond ((eq (car b) (car c))
           (make p1 (list (car b) (cadr p2)))
  (make (list (car b) (cadr p1)) p2))
 
((eq (cadr b) (cadr c)) 
           (make p1 (list (car p2) (cadr b)))
  (make (list (car p1) (cadr b)) p2))
 
        (t (make p1 b) (make b p2)
  (make b (list (car p1) (cadr p2)))
  (make b (list (car p2) (cadr p1))))
  )
  (entdel vp)
  (command "undo" "e")
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 0 0 1 os))  
)

Tháng 8 18, 2014

Bạn dùng cái này.

(defun c:cvp(/ os vp tt10 tt12 tt40 tt41 tyle p1 p2 b c layer)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun dtim (pt) (polar tt12 (angle tt10 pt) (* tyle (distance tt10 pt))))
  (defun make (a b / obj)
    (command "mview" a b)
    (vla-put-CustomScale (setq obj (vlax-ename->vla-object (entlast))) (/ 1.0 tyle))
    (vla-put-Layer obj layer)    
    (command "MSPACE")
    (command "zoom" (dtim a) (dtim b))
    (command "PSPACE")
    (vla-put-DisplayLocked obj :vlax-true)
  )
  
  (command "undo" "be")
  (setq os (getvar 'osmode))
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 1 0 0 0))
  (setq vp  (car (entsel "\nChon viewport: "))
tt10 (dxf 10 vp)
tt12 (dxf 12 vp)
tt40 (dxf 40 vp)
tt41 (dxf 41 vp)
layer (dxf 8 vp)
tyle (/ (dxf 45 vp) tt41 1.0)
p1 (polar (polar tt10 pi (* 0.5 tt40)) (* -0.5 pi) (* 0.5 tt41))
p2 (polar (polar tt10 0 (* 0.5 tt40)) (* 0.5 pi) (* 0.5 tt41))
b (getpoint "\Diem chia: ")
c (getpoint b "\nTheo huong <Enter neu chia 4>: "))
 
  (cond ((eq (car b) (car c))
           (make p1 (list (car b) (cadr p2)))
  (make (list (car b) (cadr p1)) p2))
 
((eq (cadr b) (cadr c)) 
           (make p1 (list (car p2) (cadr b)))
  (make (list (car p1) (cadr b)) p2))
 
        (t (make p1 b) (make b p2)
  (make b (list (car p1) (cadr p2)))
  (make b (list (car p2) (cadr p1))))
  )
  (entdel vp)
  (command "undo" "e")
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 0 0 1 os))  
)

Bạn Tot77 sửa lại lisp trên giúp mình là chuyển layer vp thành defpoint được không. Lisp trên mình cho thêm dòng (setvar 'clayer "defpoints") vào nhưng không được

Mình cám ơn nhiều

Tháng 8 18, 2014

BẠn dùng cái lsp ở #23 cũng được.

Đăng nhập

[Nhờ giúp đỡ] lisp chia viewport trong layout

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

engineer0405 2

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

KangKung 250

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

thanhtungvnn 2

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

engineer0405 2

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

KangKung 250

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

hantinh 45

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

KangKung 250

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

ketxu 2.984

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

KangKung 250

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

engineer0405 2

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

KangKung 250

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

NguyenNgocSon 43

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

sonnv36 12

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

proconeng86 7

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

proconeng86 7

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

Tot77 508

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

proconeng86 7

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

Tot77 508

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

proconeng86 7

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

proconeng86 7