Đến nội dung


Hình ảnh
- - - - -

[Xin lisp] Scale hình vẽ thì block att, text, dim, hatch không đổi


  • Please log in to reply
13 replies to this topic

#1 kslethanh

kslethanh

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: 36 (tàm tạm)

Đã gửi 22 September 2013 - 12:57 AM

Ví dụ em có 1 hình bên dưới.

57563608.autocad2013drawing1.jpg

( Bên trái là chưa scale. Bên phải là scale mong muốn đạt được)

Vòng tròn kia là block att: cái này không đổi. scale hatch: không đổi. Dim: không đổi. Text: không đổi.

 

Em muốn scale hình này lên 2 lần. Em không muốn text, dim, hatch, block att nó thay đổi mà giữ nguyên như cũ ( text, block att vẫn ở tại tâm chính nó).

Em tìm hiểu thì có được các auto lisp sau nhưng không biết kết hợp sao cho nó hoàn chỉnh và gộp thành 1 lệnh duy nhất được. 

Nhờ các bác giúp em thử được không ạ. Em cảm ơn nhiều.

Đây là lisp scale hatch của 1 bác trên cadviet

http://www.cadviet.c.../3/53807_ch.lsp

Đây là lisp scale kích thước không đổi của 1 bác trên cadviet ( khi scale em không muốn kích thước và con số không đổi)

http://www.cadviet.c...3/53807_scc.lsp

Trên cadviet có lisp facedim của bác Hoành nữa. Không biết có kết hợp được không ạ.

http://www.cadviet.c...3/53807_ftd.lsp


  • 1
905921755

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 22 September 2013 - 05:11 PM

Quick code. Khái niệm Text, Mtext ở nguyên chính giữa của bạn hơi mơ hồ, vì cái này còn phụ thuộc Base Point trong lệnh scale nữa. Tạm đoán như này :

 

(defun c:CMG(/ lstHatch lstScale handent-next _fake _center ps p s adoc ss)
;Free from Member of CadmagicGroup
; Scale / unchange Text, Mtext, Block scale, Dim value
(vl-load-com)
(grtext -1 "Free from Member of CadmagicGroup")
;;;;;;;;;;;;;;   PRIVATE FUNCTION ;;;;;;;;;;
(defun handent-next (hex / lt id str)
 (setq str (vl-string-right-trim "F" hex) id (strlen str))
 (setq lt '(("0" . "1") ("1" . "2") ("2" . "3") ("3" . "4")
            ("4" . "5") ("5" . "6") ("6" . "7") ("7" . "8")
            ("8" . "9") ("9" . "A") ("A" . "B") ("B" . "C")
            ("C" . "D") ("D" . "E") ("E" . "F")))
 (cond ((= str "") (substr "1000000" 1 (1+ (strlen hex))))
       ((= str hex) (strcat (substr str 1 (1- id)) (cdr (assoc (substr str id) lt))))
       (t (strcat (substr str 1 (1- id)) (cdr (assoc (substr str id) lt)) (substr "000000" 1 (- (strlen hex) id))))))

;Fake dim value @THUYLINH	   
(defun _fake(obj / etg) 
	(if (wcmatch (vla-get-textoverride obj) "*<>*,")
		(progn
			(setq h (handent-next (vla-get-handle obj)))
			(while
				(if
				  (and
					   (setq h (handent-next h))
					   (setq etg (handent h))
					   (setq etg (entget etg))
					   (wcmatch (cdr (assoc 0 etg)) "*TEXT")
					   (equal (vlax-get obj 'textposition) (cdr (assoc 10 etg)) 0.0000000001)
					)
					(vla-put-textoverride obj (cdr (assoc 1 etg)))
					t
				)
			)
		)
	)
)
	   
(defun _center (x / p1 p2) 
			(vla-getboundingbox x 'p1 'p2)
			(mapcar  '(lambda (a b) (* 0.5 (+ a b)))
			(vlax-safearray->list p1) (vlax-safearray->list p2))
)

	
(if (setq ps (ssget))
  (progn
		(setq adoc (vla-get-activedocument (vlax-get-acad-object))
			  ss (vla-get-activeselectionset adoc)
		)
		(vlax-for obj ss
			(setq objName (vla-get-objectname obj))			
			(cond
				;Hatch - catch scale :
				((= objName "AcDbHatch")(setq lstHatch (append lstHatch (list (cons obj (vla-get-PatternScale obj))))))
				;Dimfake
				((wcmatch objName "AcDb*Dimension")(_fake obj))
				;Text, Mtext, Block
				((member objName '("AcDbText" "AcDbMText" "AcDbBlockReference"))(setq lstScale (cons obj lstScale)))
			)
		)
		(while 
			(not
				(and
					(setq p (getpoint "\nSpecify base point :"))
					(> (setq s (getdist p "\nSpecify scale factor :")) 0)
				)
			)
		)
					
		(vl-cmdf "_.scale" ps "" p s)
		;Reset Hatch' Scale
		(mapcar '(lambda(x)(vla-put-PatternScale (car x) (cdr x))) lstHatch)
		;Re-Scale Text, Mtext, Block :
		(mapcar '(lambda(x)(vla-ScaleEntity x (vlax-3d-point (_center x)) (/ 1.0 s))) lstScale)
	)
)
(princ)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 kslethanh

kslethanh

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: 36 (tàm tạm)

Đã gửi 22 September 2013 - 09:18 PM

Dạ cảm ơn bác nhiều ạ. Bác làm đúng ý em rồi ạ. Chỉ còn  đối tượng đó là text att nó vẫn còn bị . Và em chỉ muốn block att nó không đổi thôi. Còn block bình thường thì khi scale nó vẫn scale lên bình thường.

Đúng là tâm text mơ hồ thật bác ơi. Em scale thử vài hình thì không rút ra được cái điểm chung nào cho text. Lúc thì nó phải gần đường này. Lúc nó gần đường kia. Tốt nhất bác cho nó về điểm chèn của text khi chưa scale đó.

Đây là ví dụ. Base point trong lệnh scale là điểm mũi tên.

57573270.autocad201320130922213400.jpg

 

Hình 4 là kết quả của hình 2 (text nó scale ngược lại để được như ban đầu). Base point trong lệnh scale ngược là tâm của text (tâm màu vàng)

 

Chân thành cảm ơn bác ạ.


  • 0
905921755

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 22 September 2013 - 11:00 PM

DVH@KX: không theo nỗi những y/c kiểu này đâu.


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 kslethanh

kslethanh

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: 36 (tàm tạm)

Đã gửi 22 September 2013 - 11:04 PM

Hay các bác chỉ sửa cái block att thôi cũng được. Còn text em làm thủ  công.

Nếu được hết thì tốt bác ạ. Còn không thì cũng cảm ơn các bác nhiều lắm. Còn lại những gì thì em làm thủ công cũng được. Chúc các bác sức khỏe.


  • 0
905921755

#6 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 September 2013 - 12:17 AM

Nếu cho nó về điểm chèn của text khi chưa scale + chiều cao giữ nguyên = text k thay đổi vị trí. Nó khác với hình bạn muốn ^^

Có thể scale ngược lại tại điểm chèn như bạn viết sau thì khả dĩ hơn. Nhưng h mình không có máy rồi, mai ngồi máy mình lại sửa cho bạn. Hoặc bác nào sửa hộ bạn ấy giúp Ket thì càng tốt ^^

 

@Bác Hạ : cháu chỉ muốn nhấn mạnh phần ;; @ thôi :)


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 September 2013 - 12:33 AM

Mà thôi, tiện sửa bo, về lý thì như thế này sẽ chạy được, bạn còn thức thì test hộ mình. K biết có lỗi cú pháp không

 

(defun c:CMG(/ lstHatch lstBlkScale lstTScale handent-next _fake _center ps p s adoc ss)
;Free from Member of CadmagicGroup
; Scale / unchange Text, Mtext, Block scale, Dim value
(vl-load-com)
(grtext -1 "Free from Member of CadmagicGroup")
;;;;;;;;;;;;;;   PRIVATE FUNCTION ;;;;;;;;;;
(defun handent-next (hex / lt id str)
 (setq str (vl-string-right-trim "F" hex) id (strlen str))
 (setq lt '(("0" . "1") ("1" . "2") ("2" . "3") ("3" . "4")
            ("4" . "5") ("5" . "6") ("6" . "7") ("7" . "8")
            ("8" . "9") ("9" . "A") ("A" . "B") ("B" . "C")
            ("C" . "D") ("D" . "E") ("E" . "F")))
 (cond ((= str "") (substr "1000000" 1 (1+ (strlen hex))))
       ((= str hex) (strcat (substr str 1 (1- id)) (cdr (assoc (substr str id) lt))))
       (t (strcat (substr str 1 (1- id)) (cdr (assoc (substr str id) lt)) (substr "000000" 1 (- (strlen hex) id))))))

;Fake dim value @THUYLINH	   
(defun _fake(obj / etg) 
	(if (wcmatch (vla-get-textoverride obj) "*<>*,")
		(progn
			(setq h (handent-next (vla-get-handle obj)))
			(while
				(if
				  (and
					   (setq h (handent-next h))
					   (setq etg (handent h))
					   (setq etg (entget etg))
					   (wcmatch (cdr (assoc 0 etg)) "*TEXT")
					   (equal (vlax-get obj 'textposition) (cdr (assoc 10 etg)) 0.0000000001)
					)
					(vla-put-textoverride obj (cdr (assoc 1 etg)))
					t
				)
			)
		)
	)
)
	   
(defun _center (x / p1 p2) 
			(vla-getboundingbox x 'p1 'p2)
			(mapcar  '(lambda (a b) (* 0.5 (+ a b)))
			(vlax-safearray->list p1) (vlax-safearray->list p2))
)

	
(if (setq ps (ssget))
  (progn
		(setq adoc (vla-get-activedocument (vlax-get-acad-object))
			  ss (vla-get-activeselectionset adoc)
		)
		(vlax-for obj ss
			(setq objName (vla-get-objectname obj))			
			(cond
				;Hatch - catch scale :
				((= objName "AcDbHatch")(setq lstHatch (append lstHatch (list (cons obj (vla-get-PatternScale obj))))))
				;Dimfake
				((wcmatch objName "AcDb*Dimension")(_fake obj))
				;Block Att
				((and (= objName "AcDbBlockReference") (= (vla-get-HasAttributes obj) :vlax-true)) (setq lstBlkScale (cons obj lstBlkScale)))
				;Text, Mtext
				((member objName '("AcDbText" "AcDbMText" ))(setq lstTScale (cons obj lstTScale)))
			)
		)
		(while 
			(not
				(and
					(setq p (getpoint "\nSpecify base point :"))
					(> (setq s (getdist p "\nSpecify scale factor :")) 0)
				)
			)
		)
					
		(vl-cmdf "_.scale" ps "" p s)
		;Reset Hatch' Scale
		(mapcar '(lambda(x)(vla-put-PatternScale (car x) (cdr x))) lstHatch)
		;Re-Scale AttBlock :
		(mapcar '(lambda(x)(vla-ScaleEntity x (vlax-3d-point (_center x)) (/ 1.0 s))) lstBlkScale)
		;Re-Scale *Text
		(mapcar '(lambda(x)(vla-ScaleEntity x (vlax-3d-point (vlax-get x 'InsertionPoint)) (/ 1.0 s))) lstTScale)
	)
)
(princ)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#8 kslethanh

kslethanh

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: 36 (tàm tạm)

Đã gửi 23 September 2013 - 12:20 PM

Đúng rồi bác ơi. Em đã test và thành công như mong đợi rồi. Cảm ơn bác nhiều. 
Bác có thể chỉnh thêm 1 xíu nữa là Block Att thì khi scale tâm nó về lại vị trí ban đầu như text mà bác vừa sửa đó. Hiện tại thì tâm nó lại dịch chuyển như text trên kia. Xíu đó nữa là tuyệt vời luôn đó bác. 
57578142.autocad201320130922213400.jpg

 

Thứ 2 là theo lisp này thì dim nó là dim thật. Khi kéo chỉnh sửa. Nó thay đổi. Nhưng chiều cao text lại bị thay đổi theo tỉ lệ scale (em muốn chiều cao như ban đầu chưa scale)

http://www.cadviet.c...3/53807_scc.lsp

Hiện tại là bác làm theo lisp bác Hoàng. Text không đổi. Nhưng khi kéo chỉnh sửa thì nó lại không đúng nữa. Vì nó là dim face

http://www.cadviet.c...3/53807_ftd.lsp

 

Bác có thể chỉnh sửa lại 1 chút điểm này được không ạ. Theo lisp trên chứ không phải lisp bác Hoành. Nhưng chiều cao text là không đổi. Nhờ bác nhiều cũng ngại thật. Cảm ơn bác 1 lần nữa ạ.


  • 0
905921755

#9 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 September 2013 - 12:38 PM

Lần nào bạn cũng k nói tâm scale của bạn ở đâu => chịu k nhìn ra được quy luật


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#10 kslethanh

kslethanh

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: 36 (tàm tạm)

Đã gửi 23 September 2013 - 01:50 PM

Công nhận cái yêu cầu của em nhiều quá. Khi yêu cầu xong em mới thấy là những lỗi đó. Thành thật em cũng suy nghĩ kĩ trước khi post rồi đó bác. Nhưng vẫn không nhìn ra hết. Tâm scale của em là tâm bất kì. Tại vì không thể có tâm được. Vì nhiều hình có nhiều đối tượng ( text, block att, hatch, dim) Nên em không có tâm cố định được. Em đọc nhiều topic khác thấy yêu cầu đi, yêu cầu lại cũng mệt cho người giúp mình. Em đã cố gắng. Nhưng không được. Thôi thì bác giúp được thì giúp em lần chót này vậy. Chỉ còn 2 điểm như e nêu ở trên ( block att và dim). Cảm ơn bác nhiều lắm. Em không biết nói gì hơn. Chúc bác sức khỏe. Cảm ơn bác đã theo dõi và giúp em tới lúc này.  :) 


  • 0
905921755

#11 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 September 2013 - 05:01 PM

Block thì chắc ý bạn vầy :

(defun c:CMG(/ lstHatch lstBlkScale lstTScale handent-next _fake _center ps p s adoc ss)
;Free from Member of CadmagicGroup
; Scale / unchange Text, Mtext, Block scale, Dim value
(vl-load-com)
(grtext -1 "Free from Member of CadmagicGroup")
;;;;;;;;;;;;;;   PRIVATE FUNCTION ;;;;;;;;;;
(defun handent-next (hex / lt id str)
 (setq str (vl-string-right-trim "F" hex) id (strlen str))
 (setq lt '(("0" . "1") ("1" . "2") ("2" . "3") ("3" . "4")
            ("4" . "5") ("5" . "6") ("6" . "7") ("7" . "8")
            ("8" . "9") ("9" . "A") ("A" . "B") ("B" . "C")
            ("C" . "D") ("D" . "E") ("E" . "F")))
 (cond ((= str "") (substr "1000000" 1 (1+ (strlen hex))))
       ((= str hex) (strcat (substr str 1 (1- id)) (cdr (assoc (substr str id) lt))))
       (t (strcat (substr str 1 (1- id)) (cdr (assoc (substr str id) lt)) (substr "000000" 1 (- (strlen hex) id))))))

;Fake dim value @THUYLINH	   
(defun _fake(obj / etg) 
	(if (wcmatch (vla-get-textoverride obj) "*<>*,")
		(progn
			(setq h (handent-next (vla-get-handle obj)))
			(while
				(if
				  (and
					   (setq h (handent-next h))
					   (setq etg (handent h))
					   (setq etg (entget etg))
					   (wcmatch (cdr (assoc 0 etg)) "*TEXT")
					   (equal (vlax-get obj 'textposition) (cdr (assoc 10 etg)) 0.0000000001)
					)
					(vla-put-textoverride obj (cdr (assoc 1 etg)))
					t
				)
			)
		)
	)
)
	   
(defun _center (x / p1 p2) 
			(vla-getboundingbox x 'p1 'p2)
			(mapcar  '(lambda (a b) (* 0.5 (+ a b)))
			(vlax-safearray->list p1) (vlax-safearray->list p2))
)

	
(if (setq ps (ssget))
  (progn
		(setq adoc (vla-get-activedocument (vlax-get-acad-object))
			  ss (vla-get-activeselectionset adoc)
		)
		(vlax-for obj ss
			(setq objName (vla-get-objectname obj))			
			(cond
				;Hatch - catch scale :
				((= objName "AcDbHatch")(setq lstHatch (append lstHatch (list (cons obj (vla-get-PatternScale obj))))))
				;Dimfake
				((wcmatch objName "AcDb*Dimension")(_fake obj))				
				
				;Text, Mtext, Block ATT
				((or (member objName '("AcDbText" "AcDbMText" ))(and (= objName "AcDbBlockReference") (= (vla-get-HasAttributes obj) :vlax-true)))
					(setq lstTScale (cons obj lstTScale)))
			)
		)
		(while 
			(not
				(and
					(setq p (getpoint "\nSpecify base point :"))
					(> (setq s (getdist p "\nSpecify scale factor :")) 0)
				)
			)
		)
					
		(vl-cmdf "_.scale" ps "" p s)
		;Reset Hatch' Scale
		(mapcar '(lambda(x)(vla-put-PatternScale (car x) (cdr x))) lstHatch)
		;Re-Scale AttBlock :
		;(mapcar '(lambda(x)(vla-ScaleEntity x (vlax-3d-point (_center x)) (/ 1.0 s))) lstBlkScale)
		;Re-Scale *Text
		(mapcar '(lambda(x)(vla-ScaleEntity x (vlax-3d-point (vlax-get x 'InsertionPoint)) (/ 1.0 s))) lstTScale)
	)
)
(princ)
)

- Còn dim thì mình thua :) Thua là vì cách bạn truyền đạt ý tới mình. 

+ Bản chất của đối tượng Dim là không thay đổi chiều cao chữ khi scale, trừ khi bị đóng Block. Nếu bạn muốn nó vừa là dim thật, vừa k thay đổi chiều cao chữ trong lúc scale, thì chính là bình thường nó đã thế, k cần lisp can thiệp

 

+ Trong bài 1, bạn tô đậm chữ TEXT không đổi, đồng thời hình minh họa 1 của bạn, cả trước và sau nó đều là 5000, chiều cao chữ không đổi  => đương nhiên phải là dim fake, không thì lúc scale lên 2 nó phải là 10000 chứ => Mình đã phải copy đoạn xử lý fake dim rất dài cho vào code. Giờ bạn lại không ưng ý khi nó là dim fake => -_- . Nếu muốn nó không fake nữa thì code chỉ còn thế này thôi :

 

 

(defun c:CMG(/ lstHatch  lstTScale ps p s adoc ss)
;Free from Member of CadmagicGroup
; Scale / unchange Text, Mtext, Block scale, Dim value
(vl-load-com)
(grtext -1 "Free from Member of CadmagicGroup")
	
(if (setq ps (ssget))
  (progn
		(setq adoc (vla-get-activedocument (vlax-get-acad-object))
			  ss (vla-get-activeselectionset adoc)
		)
		(vlax-for obj ss
			(setq objName (vla-get-objectname obj))			
			(cond
				;Hatch - catch scale :
				((= objName "AcDbHatch")(setq lstHatch (append lstHatch (list (cons obj (vla-get-PatternScale obj))))))							
				
				;Text, Mtext, Block ATT
				((or (member objName '("AcDbText" "AcDbMText" ))(and (= objName "AcDbBlockReference") (= (vla-get-HasAttributes obj) :vlax-true)))
					(setq lstTScale (cons obj lstTScale)))
			)
		)
		(while 
			(not
				(and
					(setq p (getpoint "\nSpecify base point :"))
					(> (setq s (getdist p "\nSpecify scale factor :")) 0)
				)
			)
		)
					
		(vl-cmdf "_.scale" ps "" p s)
		;Reset Hatch' Scale
		(mapcar '(lambda(x)(vla-put-PatternScale (car x) (cdr x))) lstHatch)		
		;Re-Scale *Text
		(mapcar '(lambda(x)(vla-ScaleEntity x (vlax-3d-point (vlax-get x 'InsertionPoint)) (/ 1.0 s))) lstTScale)
	)
)
(princ)
)

Thật là ....


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#12 kslethanh

kslethanh

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: 36 (tàm tạm)

Đã gửi 23 September 2013 - 07:53 PM

Cảm ơn bác nhiều. Block att là bác chỉnh sửa đúng ý em rồi ạ. Còn cái dim em trình bày lại như sau.

Bác down lisp này về là bác hiểu ý em à.

http://www.cadviet.c...53807_scc_1.lsp

Có nghĩa là sau: Dim sau khi scale vẫn là dim thật. Và sử dụng được cho sau này. Tuy nhiên cái lisp kia thì chiều cao text lại thay đổi theo tỉ lệ scale [ Hình như nó liên quan đến biến này thì phải, trong lisp em gởi bác (command "dimtxt"(* 0.1 k)) ]. Theo em hiểu thì k là tỉ lệ scale. Nếu gán 0.1 là biến nào đó cho  chiều cao thì nó quay về được chiều cao text ban đầu.

Lisp của bác Biến "dim scale linear" (trong properties, mục primary units) vẫn là 1.

 Lisp em gởi bác biến "dim scale linear"  là 1/x (x là tỉ lệ scale). Nó liên quan chổ này nè bác.

Cảm ơn bác nhiều lắm.( Sao em không tks bác được nhỉ)

57582732.autocad201320130922213400.jpg


  • 0
905921755

#13 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 September 2013 - 10:29 PM

Giờ mới đẻ ra cái này :) - Không thấy đề cập ở các bài trước. Đáng ra mình chỉ cần 1 file Cad của bạn để xem vấn đề, và cũng chỉ 15p là xong cái code, nhưng tí lại thêm 1 cái ảnh :) , cuối cùng đều phải chờ nhau đến 2 ngày. Qua quá trình mô tả thì thấy bạn đang vẽ theo cách vẽ model và muốn mọi thứ thay đổi tự động khi scale . Thay đối Dimlfac đương nhiên mình làm được, nhưng khuyên bạn thật - chẳng ai lại làm thế cả - vì đấy là một cách vẽ khiến cho bạn không quản lý được cái bạn có trong tay. Nếu đã vẽ Model hãy tạo kiểu dim tương ứng với tỉ lệ định vẽ. Hãy tưởng tượng các dim rời rạc, cùng thuộc 1 Dimstyle nhưng qua quá trình chạy lisp thì Scale factor lại khác nhau => quá trình quản lý + sửa của bạn sẽ vất vả

 

Code thì đây, nếu bạn bảo vệ quan điểm

 

(defun c:CMG(/ lstHatch  lstTScale  ps p s adoc ss)
;Free from Member of CadmagicGroup
; Scale / unchange Text, Mtext, Block scale, Dim value
(vl-load-com)
(grtext -1 "Free from Member of CadmagicGroup")
	
(if (setq ps (ssget))
  (progn
		(setq adoc (vla-get-activedocument (vlax-get-acad-object))
			  ss (vla-get-activeselectionset adoc)
		)
		(vlax-for obj ss
			(setq objName (vla-get-objectname obj))			
			(cond
				;Hatch - catch scale :
				((= objName "AcDbHatch")(setq lstHatch (append lstHatch (list (cons obj (vla-get-PatternScale obj))))))
				;Dim
				((wcmatch objName "AcDb*Dimension")(setq lstDim (append lstDim (list (cons obj (vla-get-LinearScaleFactor obj))))))	
				;Text, Mtext, Block ATT
				((or (member objName '("AcDbText" "AcDbMText" ))(and (= objName "AcDbBlockReference") (= (vla-get-HasAttributes obj) :vlax-true)))
					(setq lstTScale (cons obj lstTScale)))
			)
		)
		(while 
			(not
				(and
					(setq p (getpoint "\nSpecify base point :"))
					(> (setq s (getdist p "\nSpecify scale factor :")) 0)
				)
			)
		)
					
		(vl-cmdf "_.scale" ps "" p s)
		;Reset Hatch' Scale
		(mapcar '(lambda(x)(vla-put-PatternScale (car x) (cdr x))) lstHatch)		
		;Re-Scale *Text
		(mapcar '(lambda(x)(vla-ScaleEntity x (vlax-3d-point (vlax-get x 'InsertionPoint)) (/ 1.0 s))) lstTScale)
		;Re-Dimlfac Dimension
		(mapcar '(lambda(x)(vla-put-LinearScaleFactor (car x) (/ (cdr x) s))) lstDim)
	)
)
(princ)
)

 

P/s : mình chưa down lisp nào bạn đưa lên, cũng không bắt chước làm giống ai đâu, tại nhìn hình to thế kia tưởng mình thông minh hiểu được ý bạn, nên biếng down. Bạn bảo làm theo nghe buồn. Chừ giờ cop của ai cũng ghi @ hết, k sau mình k hiểu k tìm được tác giả mà hỏi ^^ 

 

Lần này đoán ý mãi vẫn trật  :o Mình rút lui thôi, hehe ^^

 

Chúc bạn thành công -  


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#14 kslethanh

kslethanh

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: 36 (tàm tạm)

Đã gửi 23 September 2013 - 10:46 PM

Em thấy hổ hẹn về bản thân quá. Có nhiêu đó mà diễn giải mãi mới xong. Hic. Cảm ơn bác nhiều. Em cũng hiểu ý bác khuyên. Em làm bên tổng hợp file bác à. Nhiều cái không phải em vẽ. Ví dụ sếp em nhận file điện nước, kết cấu, y tế......... Bắt em phải chỉnh cái này lại cái này tí. tỉ lệ này lớn quá, bố trí cái này chưa hợp. Mà mỗi cá nhân làm thì lại không giống nhau, người làm bên model, người bên layout. Em phải có nhiệm vụ tổng hợp, nên em phải cực thế này.Nên em mới cần lisp như bác vừa làm xong cho em. Nó ít tốn time và công sức hơn tí. Có lẽ em dành thời gian để học thử lisp thôi.  Một lần nữa cảm ơn bác nhiều. Lần này thì đúng 100% ý của em rồi. Em ngại thật ^^. Chúc bác sức khỏe và thành công.  :)


  • 0
905921755