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

[Yêu cầu] Lisp điều chỉnh vị trí text ghi kích thước trên đường dim

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

Vấn đề move text Dim này cũng khá hay, mong mọi người giúp đỡ lisp này nhé.

 

Yêu cầu lisp bên trên cũng khá lằng nhằng, mong muốn của em nó đơn giản hơn chút:

 

- Chạy lisp, lisp yêu cầu chọn dãy dim cần dãn text trùng

+ Người dùng chọn dãy dim

- Lisp nhận diện các text bị đè lên nhau và move text trùng xuống dưới hàng dim (khoảng cách move bằng 2 lần chiều cao text). Kết thúc lệnh

 

File ví dụ:

http://www.mediafire.com/file/4oczix0pcd0dred/Vidu2.dwg

Thử lisp này, thay lệnh test tùy ý nhé. ^_^

 

https://youtu.be/6NyEJFNnIwM

(defun c:test (/ ss lst _angle)
  (vl-load-com)
  (command "undo" "be")
  (if (setq ss (ssget '((0 . "DIMENSION"))))
    (progn
      (setq lst	(vl-remove-if
		  '(lambda (e) (> (cdr (assoc 42 (entget e))) 900.))
		  (vl-remove-if
		    'listp
		    (mapcar 'cadr (ssnamex ss))
		  )
		)
      )					;setq
      (setq _angle (angle (cdr (assoc 11 (entget (car lst))))
			  (cdr (assoc 11 (entget (cadr lst))))
		   )
      )
      (cond
	((or (= _angle 0)
	     (= _angle pi)
	 )
	 (dim_hor lst)
	)				;#cond1
	((or (= _angle (/ pi 2))
	     (= _angle (* pi 1.5))
	 )
	 (dim_ver lst)
	)				;#cond2
	(_angle
	 (dim_ lst _angle)
	)				;#cond3
      )					;#cond
    )					;progn
    (princ "\nBan da khong chon dim.!")
  )					;if
  (command "undo" "end")
  (princ)
)
(defun dim_hor (l / lst pt)
  (setq	lst (vl-sort l
		     '(lambda (e1 e2)
			(< (car (cdr (assoc 11 (entget e1))))
			   (car (cdr (assoc 11 (entget e2))))

			)
		      )
	    )
  )
  (foreach x lst
    (if	(= (rem (vl-position x lst) 2) 0)
      (progn
	(if (>=	(cadr (cdr (assoc 10 (entget x))))
		(cadr (cdr (assoc 14 (entget x))))
	    )

	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (* pi 1.5)
			  (* 2 (txt_height x))
		   )
	  )
	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (/ pi 2)
			  (* 2 (txt_height x))
		   )
	  )
	)
	(vlax-put (vlax-ename->vla-object x) 'TextPosition pt)
      )					;progn
    )					;if
  )					;foreach
)					;defun
(defun dim_ver (l / lst pt)
  (setq	lst (vl-sort l
		     '(lambda (e1 e2)
			(< (cadr (cdr (assoc 11 (entget e1))))
			   (cadr (cdr (assoc 11 (entget e2))))

			)
		      )
	    )
  )
  (foreach x lst
    (if	(= (rem (vl-position x lst) 2) 0)
      (progn
	(if (>=	(car (cdr (assoc 10 (entget x))))
		(car (cdr (assoc 14 (entget x))))
	    )

	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  pi
			  (* 2 (txt_height x))
		   )
	  )
	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  0.0
			  (* 2 (txt_height x))
		   )
	  )
	)
	(vlax-put (vlax-ename->vla-object x) 'TextPosition pt)
      )					;progn
    )					;if
  )					;foreach
)
(defun dim_ (l ang / lst pt)
  (setq	lst (vl-sort l
		     '(lambda (e1 e2)
			(< (cadr (cdr (assoc 11 (entget e1))))
			   (cadr (cdr (assoc 11 (entget e2))))

			)
		      )
	    )
  )
  (foreach x lst
    (if	(= (rem (vl-position x lst) 2) 0)
      (progn
	(if (>=	(car (cdr (assoc 10 (entget x))))
		(car (cdr (assoc 14 (entget x))))
	    )

	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (+ ang (* pi 1.5))
			  (* 2 (txt_height x))
		   )
	  )
	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (+ ang (* pi 1.5))
			  (* 2 (txt_height x))
		   )
	  )
	)
	(vlax-put (vlax-ename->vla-object x) 'TextPosition pt)
      )					;progn
    )					;if
  )					;foreach
)
(defun txt_height (ename / BlkEnt EntData height)
  (if
    (and
      (= (cdr (assoc 0 (setq EntData (entget ename))))
	 "DIMENSION"
      )
      (setq BlkEnt (tblobjname "block" (cdr (assoc 2 EntData))))
    )
     (while (setq BlkEnt (entnext BlkEnt))
       (if (= (cdr (assoc 0 (setq EntData (entget BlkEnt)))) "MTEXT")
	 (setq height (cdr (assoc 40 EntData)))
       )
     )
  )
  height
)
(princ)
  • 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
Bạn sửa dòng này :
(setq dxf11 (cdr(assoc 11 (entget ename)))
   dxf13 (cdr(assoc 13 (entget ename))) 
      pres (inters p1 p2 dxf11 (polar dxf11 (+ ang (/ pi 2.0)) 100.0) t)
)
thành dòng :
(setq dxf11 (cdr(assoc 11 (entget ename)))
   dxf13 (cdr(assoc 13 (entget ename))) 
      pres (inters p1 p2 dxf11 (polar dxf11 (+ ang (/ pi 2.0)) 100.0) nil)
)

Lisp của bác rất tốt. Phiền bác giúp em chỉnh lại lệnh để sau khi chọn text sẽ di chuyển vào vị trí giữa 2 đường gióng (extension lines) được không ạ? cảm ơn bác nhiều.

link ảnh:

http://www.upsieutoc.com/image/iQAys

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

 

Thử lisp này, thay lệnh test tùy ý nhé. ^_^

 

https://youtu.be/6NyEJFNnIwM

(defun c:test (/ ss lst _angle)
  (vl-load-com)
  (command "undo" "be")
  (if (setq ss (ssget '((0 . "DIMENSION"))))
    (progn
      (setq lst	(vl-remove-if
		  '(lambda (e) (> (cdr (assoc 42 (entget e))) 900.))
		  (vl-remove-if
		    'listp
		    (mapcar 'cadr (ssnamex ss))
		  )
		)
      )					;setq
      (setq _angle (angle (cdr (assoc 11 (entget (car lst))))
			  (cdr (assoc 11 (entget (cadr lst))))
		   )
      )
      (cond
	((or (= _angle 0)
	     (= _angle pi)
	 )
	 (dim_hor lst)
	)				;#cond1
	((or (= _angle (/ pi 2))
	     (= _angle (* pi 1.5))
	 )
	 (dim_ver lst)
	)				;#cond2
	(_angle
	 (dim_ lst _angle)
	)				;#cond3
      )					;#cond
    )					;progn
    (princ "\nBan da khong chon dim.!")
  )					;if
  (command "undo" "end")
  (princ)
)
(defun dim_hor (l / lst pt)
  (setq	lst (vl-sort l
		     '(lambda (e1 e2)
			(< (car (cdr (assoc 11 (entget e1))))
			   (car (cdr (assoc 11 (entget e2))))

			)
		      )
	    )
  )
  (foreach x lst
    (if	(= (rem (vl-position x lst) 2) 0)
      (progn
	(if (>=	(cadr (cdr (assoc 10 (entget x))))
		(cadr (cdr (assoc 14 (entget x))))
	    )

	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (* pi 1.5)
			  (* 2 (txt_height x))
		   )
	  )
	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (/ pi 2)
			  (* 2 (txt_height x))
		   )
	  )
	)
	(vlax-put (vlax-ename->vla-object x) 'TextPosition pt)
      )					;progn
    )					;if
  )					;foreach
)					;defun
(defun dim_ver (l / lst pt)
  (setq	lst (vl-sort l
		     '(lambda (e1 e2)
			(< (cadr (cdr (assoc 11 (entget e1))))
			   (cadr (cdr (assoc 11 (entget e2))))

			)
		      )
	    )
  )
  (foreach x lst
    (if	(= (rem (vl-position x lst) 2) 0)
      (progn
	(if (>=	(car (cdr (assoc 10 (entget x))))
		(car (cdr (assoc 14 (entget x))))
	    )

	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  pi
			  (* 2 (txt_height x))
		   )
	  )
	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  0.0
			  (* 2 (txt_height x))
		   )
	  )
	)
	(vlax-put (vlax-ename->vla-object x) 'TextPosition pt)
      )					;progn
    )					;if
  )					;foreach
)
(defun dim_ (l ang / lst pt)
  (setq	lst (vl-sort l
		     '(lambda (e1 e2)
			(< (cadr (cdr (assoc 11 (entget e1))))
			   (cadr (cdr (assoc 11 (entget e2))))

			)
		      )
	    )
  )
  (foreach x lst
    (if	(= (rem (vl-position x lst) 2) 0)
      (progn
	(if (>=	(car (cdr (assoc 10 (entget x))))
		(car (cdr (assoc 14 (entget x))))
	    )

	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (+ ang (* pi 1.5))
			  (* 2 (txt_height x))
		   )
	  )
	  (setq	pt (polar (cdr (assoc 11 (entget x)))
			  (+ ang (* pi 1.5))
			  (* 2 (txt_height x))
		   )
	  )
	)
	(vlax-put (vlax-ename->vla-object x) 'TextPosition pt)
      )					;progn
    )					;if
  )					;foreach
)
(defun txt_height (ename / BlkEnt EntData height)
  (if
    (and
      (= (cdr (assoc 0 (setq EntData (entget ename))))
	 "DIMENSION"
      )
      (setq BlkEnt (tblobjname "block" (cdr (assoc 2 EntData))))
    )
     (while (setq BlkEnt (entnext BlkEnt))
       (if (= (cdr (assoc 0 (setq EntData (entget BlkEnt)))) "MTEXT")
	 (setq height (cdr (assoc 40 EntData)))
       )
     )
  )
  height
)
(princ)

Thanks Bee nhiều! Lisp của bạn rất hay :D

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

Chào các bác pro. Em gặp vấn đề này mong các bác giúp đỡ.

Trong khi vẽ cad, do nhiều lý do nên có khi em phải thay đổi vị trí text ghi kích thước trên đường dim (mặc định là ghi kích thước vào giữa đường dim), làm như vậy với số lượng dim lớn thì rất mất thời gian. Mong các bác viết hộ em cái lisp để điểu chỉnh 1 lần duy nhất cho tất cả các dim (các dim này đã gióng thẳng hàng theo phương đứng), em xin cảm ơn các bác trước.

Chúc cả nhà một ngày vui.

Các bác xem chi tiết ở hình vẽ sau nhé http://www.mediafire.com/?dis7edjxaz2p2d5

 

Vấn đề của bạn mình nghĩ chỉ cần tick chọn như hình dưới trong dimmesion style là được

128900_untitled_1.jpg

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


×