Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Nguyen Hoanh

Viết lisp theo yêu cầu [phần 2]

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

-Bạn nào có lisp có chức năng như sau thì cho mình nhé:

+ Đo và điền giá trị diện tích hatch

+ Cộng tổng diện tích các hatch được chọn rồi ghi ra text

>>> Chân thành cảm ơn

Mình đâu cần phải dùng lisp mà cũng tính đc thôi mà bạn.

Dùng lệnh BO để bao kín vùng hath. Đó là những đường PL khép kín. Sau đó dùng lênh AA/A/O chọn tất cả đối tượng là đường PL khép kín. Nó sẽ tính đc tổng diện tích đó bạn. Cũng không mất thời gian lắm đâ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
Tue_NV    3.841
Cảm ơn Bác Tuệ đã giúp đỡ!

Bác Tuệ sữa lại giúp út tí nữa nha.

1. Nếu mình quét tấc cả các text nhưng chỉ những text đè lên nhau thì mới sắp xếp lại còn những text không đè lên nhau thì vẫn đứng yên.

2. Thứ hai là khoảng cách các text nếu không nhập lai thì mặt đinh chọn khoảng cách vừa chọn trước đó.

3. thứ 3 là các text được canh về hai phía chứ không phải một phía.

file cad: http://www.cadviet.com/upfiles/2/thu_2.dwg

Yêu cầu này của Út thì Tue_NV đã làm rồi nhưng không thành công. Tue_NV chỉ có thể làm được yêu cầu thứ 2 và thứ 3 của Út khi Út chỉ chọn 1 nhóm Text đè lên nhau hoặc không đè lên nhau thôi nhé.

Đây là Lisp giãn Text đều ra 2 phía chỉ thực hiện với 1 nhóm Text

Yêu cầu thứ 2 và thứ 3 của Út được đáp ứng

Út chạy thử code này nhé :

(defun c:sxtt(/ ss kc i obj lispobj lisdau lisobj diemBcuoi tdi spt des)
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(if (not kco) (setq kco (cdr(assoc 40 (entget(ssname ss 0))))) )
(setq kc (getdist (strcat "\n Khoang cach giua cac Text  :")))
(if (not kc) (setq kc kco) (setq kco kc))

(while (	(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
(setq lispobj (cons (cons (list (safearray-value tl) (safearray-value bl)) obj) lispobj))
(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
		'(lambda (x y)
			(			 )
      )
)
(setq lisdau (mapcar 'caar lispobj))
;(setq liscuoi (mapcar 'cadar lispobj))
(setq lisobj (mapcar 'cdr lispobj))
(setq diemBcuoi (list (car (last lisdau)) (cadr (last lisdau)) 0))

(setq tdi (tdiem (car lisdau) diemBcuoi))
(setq spt (/ (float (length lispobj)) 2) i spt)
;(if (= (rem i 1) 0) 
   (progn
(setq i (- i 0.5)) (setq j 0) 
(foreach x lisobj
	(setq des (list (- (car tdi) (* i kc)) (cadr (nth j lisdau)) 0))
	(vla-move x (vlax-3d-point (nth j lisdau)) (vlax-3d-point tdi))
	(vla-move x (vlax-3d-point tdi) (vlax-3d-point des))
	(setq i (1- i)) (setq j (1+ j))

      )
   )

(princ "Chuc ban lam viec hieu qua _ Tue_NV")
)
;
(defun tdiem(x y)
(list (/ (+ (car x) (car y)) 2) (/ (+ (cadr x) (cadr y)) 2) 0)
)

Không biết khẩu AKA (ACA) của bác trinhvqh có giải quyết được vụ này không :( ? Nếu có thể giải quyết trọn vẹn thì phiền bác cho khẩu AKA của bác giúp Útcưng tí nhé.

Thanks bác

:rolleyes:

Chỉnh sửa theo Tue_NV
  • Vote tăng 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
trinhvqh    222
Không biết khẩu AKA (ACA) của bác trinhvqh có giải quyết được vụ này không :( ? Nếu có thể giải quyết trọn vẹn thì phiền bác cho khẩu AKA của bác giúp Útcưng tí nhé.

Thanks bác

:rolleyes:

 

Tue_NV bữa ni biết dzỡn rồi đấy

Ut_cung nó tham lam quá (được voi đòi tiên)

Lisp sxtt của Tue_NV cũng tạm ổn rồi

 

Nếu dùng ACA thì nó cũng giải quyết sắp xếp từng nhóm thôi

Có lẽ Tue_NV nên tham khảo một chút để hoàn thành LISP sxtt

Ở đây không phải bao giờ cũng canh chính giữa

Giữa (theo Ut_cung chỉ là tương đối)

 

Khi sử dụng Space Evenly của ACA nó ưu điểm hơn một chút là chọn khoảng cách 02 điểm rồi sắp xếp Text trong phạm vi 02 điểm đó

Nhưng nhược điểm là nó không lưu khoảng cách đó

http://www.cadviet.com/upfiles/2/space.rar

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
anhthuhoa    6
Yêu cầu này của Út thì Tue_NV đã làm rồi nhưng không thành công. Tue_NV chỉ có thể làm được yêu cầu thứ 2 và thứ 3 của Út khi Út chỉ chọn 1 nhóm Text đè lên nhau hoặc không đè lên nhau thôi nhé.

Đây là Lisp giãn Text đều ra 2 phía chỉ thực hiện với 1 nhóm Text

Yêu cầu thứ 2 và thứ 3 của Út được đáp ứng

Út chạy thử code này nhé :

(defun c:sxtt(/ ss kc i obj lispobj lisdau lisobj diemBcuoi tdi spt des)
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(if (not kco) (setq kco (cdr(assoc 40 (entget(ssname ss 0))))) )
(setq kc (getdist (strcat "\n Khoang cach giua cac Text :")))
(if (not kc) (setq kc kco) (setq kco kc))

(while (< i (sslength ss))
(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
(setq lispobj (cons (cons (list (safearray-value tl) (safearray-value bl)) obj) lispobj))
(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
		'(lambda (x y)
			(< (caaar x) (caaar y))
		 )
      )
)
(setq lisdau (mapcar 'caar lispobj))
;(setq liscuoi (mapcar 'cadar lispobj))
(setq lisobj (mapcar 'cdr lispobj))
(setq diemBcuoi (list (car (last lisdau)) (cadr (last lisdau)) 0))

(setq tdi (tdiem (car lisdau) diemBcuoi))
(setq spt (/ (float (length lispobj)) 2) i spt)
;(if (= (rem i 1) 0) 
   (progn
(setq i (- i 0.5)) (setq j 0) 
(foreach x lisobj
	(setq des (list (- (car tdi) (* i kc)) (cadr (nth j lisdau)) 0))
	(vla-move x (vlax-3d-point (nth j lisdau)) (vlax-3d-point tdi))
	(vla-move x (vlax-3d-point tdi) (vlax-3d-point des))
	(setq i (1- i)) (setq j (1+ j))

      )
   )

(princ "Chuc ban lam viec hieu qua _ Tue_NV")
)
;
(defun tdiem(x y)
(list (/ (+ (car x) (car y)) 2) (/ (+ (cadr x) (cadr y)) 2) 0)
)

Không biết khẩu AKA (ACA) của bác trinhvqh có giải quyết được vụ này không :( ? Nếu có thể giải quyết trọn vẹn thì phiền bác cho khẩu AKA của bác giúp Útcưng tí nhé.

Thanks bác

:rolleyes:

Tôi đã xem bản vẽ minh hoạ "thu_2.dwg" và xử lý theo yêu cầu của tác giả. Xin mời bạn tham khảo:

1- Xoay toàn bộ hàng một góc -90o bàng lệnh "rotate";

2- Vào: Expres--> Text--> Convert Text To Mtext;

3- Dùng lệnh "properties" điều chỉnh giá trị "Line Space Distance" tạo khoảng cách theo ý;

4- Xoay Mtext một góc 90o bàng lệnh "rotate";

5- Dùng lệnh "Explode" nếu bạn cần;

Mô tả thì hơi dài nhưng làm nhanh thôi.

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
luu_quang    0
Đây là phần tiếp theo của topic Viết lisp theo yêu cầu, mời các bạn tiếp tục thảo luận.

 

các bác ơi giup em, làm sao để copy các đối tượng từ một file Cad này sang một file Cad khác mà các layout của đối tượng gốc thay đổi theo layout của file mới:

ví dụ như

* đối tượng của flie gốc gồm các layout nét khuất tên Đường Đứt. màu đỏ.

* đối tượng trong file nhận có nét đứt tên khuất, màu xanh,

vạy làm sao để sau copy các layout file gốc không qua bên file nhận nếu có thể được thì có thể chuyển tên Đường Đứt, màu đỏ thành Khuất, màu xanh không.

vì khi copy thì các layout file gốc thường làm rối layout file nhận,.

cảm ơn các bác :(

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
phamthanhbinh    3.123
Thank you Bác, thôi thì Bác viết giúp em 1 cái Lisp mới vậy.

Merry Christmas and Happy New Year!

 

Lisp này có thể sửa lại để select các Circles và Line rồi ghi text như bản vẽ đã upload.

;; free lisp from cadviet.com
 

Hề hề hề,

Đúng là viết mới nhanh hơn sửa cái bác gửi bác phiphi ạ.

Nó đây nè. Bác coi xem đã ưng ý chưa nhé. Ở bảng BEND LINE POINTS có dư một cột NOTES. Ấy là do mình lười không muốn căn lại cái bảng. Nếu bác muốn bỏ nó đi thì nên căn lại cái bảng cho nó đèm đẹp là được bác ạ.

(defun c:tabc ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq col (getvar "cecolor"))
(setvar "osmode" 0)
(setq pc (getpoint "\n Chon diem chuan kich thuoc")
     xc (car pc)
     yc (cadr pc))
(setvar "pdmode" 3)
(setvar "cecolor" "1")
(command "point" pc)
(princ "\n Chon cac holes theo trat tu hien thi")
(setq ssci (ssget '((0 . "CIRCLE")))
     n (sslength ssci)
     i 0
     lstx (list)
     lsty (list)
     lstr (list))
(while ((setq cir (ssname ssci i)
     lstx (append lstx (list (- (cadr (assoc 10 (entget cir))) xc)) )
     lsty (append lsty (list (- (caddr(assoc 10 (entget cir))) yc)) )
     lstr (append lstr (list (cdr (assoc 40 (entget cir)))) )
     i (1+ i))
)
(setq pb (getpoint "\n Chon diem dat bang kich thuoc")
     h (getreal "\n Nhap chieu cao text: ")
     pt (getpoint "\n Chon diem dat text bat ky"))
(command "text" "j" "m" pt h 0 (rtos (nth 0 lstx) 2 4))
(setq tb (textbox (entget(entlast)))
     d (distance (car tb) (cadr tb)))
(entdel (entlast))
(setvar "cecolor" "2")
(command "text" "j" "m" pb (* 1.5 h) 0 "HOLES LOCATION")
(setq p1 (list (- (car pb) (* 2 d)) (- (cadr pb) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "DIA")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "X axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "Y axis")
(setq j 0)
(while ((setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h (1+ j))))
(command "text" "j" "m" p11 h 0 (rtos (1+ j) 2 0))     
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (* 2 (nth j lstr)) 2 1)) 
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (nth j lstx) 2 0)) 
(setq p44 (polar p33 0 (* 1.5 d)))
(command "text" "j" "m" p44 h 0 (rtos (nth j lsty) 2 0))
(setq j (1+ j))
)
(setq ans (getstring "\n Ban co muon tao bang toa do duong uon : "))
(if (= ans "y")
(progn
(setq p0 (getpoint "\n Chon diem dat bang"))
(command "text" "j" "m" p0 (* 1.5 h) 0 "BEND LINE POINTS")
(setq p1 (list (- (car p0) (* 2 d)) (- (cadr p0) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "X axis")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "Y axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "NOTES")
(setq lst (entget (car (entsel "\n Chon bend line"))))
(setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h)))
(command "text" "j" "m" p11 h 0 "P1")     
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (- (cadr (assoc 10 lst)) xc) 2 0)) 
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (- (caddr (assoc 10 lst)) yc) 2 0)) 
(setq p111 (polar p1 (- (/ pi 2)) (* 3 h)))
(command "text" "j" "m" p111 h 0 "P2")     
(setq p222 (polar p111 0 (* 1.5 d)))
(command "text" "j" "m" p222 h 0 (rtos (- (cadr (assoc 11 lst)) xc) 2 0)) 
(setq p333 (polar p222 0 (* 1.5 d)))
(command "text" "j" "m" p333 h 0 (rtos (- (caddr (assoc 11 lst)) yc) 2 0)) 
)
)
(setvar "cecolor" col) 
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
)

Chúc bác Giáng sinh vui vẻ. Hề hề hề.

  • 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
Phiphi-    175
Hề hề hề,

Đúng là viết mới nhanh hơn sửa cái bác gửi bác phiphi ạ.

Nó đây nè. Bác coi xem đã ưng ý chưa nhé. Ở bảng BEND LINE POINTS có dư một cột NOTES. Ấy là do mình lười không muốn căn lại cái bảng. Nếu bác muốn bỏ nó đi thì nên căn lại cái bảng cho nó đèm đẹp là được bác ạ.

...

Chúc bác Giáng sinh vui vẻ. Hề hề hề.

Các bảng kết quả in ra của Lisp Bác viết đúng là đẹp hết ý luôn. Nhưng còn cần phải đánh số/chữ của các Point như bản vẽ minh hoạ nữa Bác ạ.

Xin phiền Bác tý nhé. Luôn tiện Bác cho thêm các option hỏi có còn thêm cái BEND LINE POINTS nữa không (vì cũng có khi phải có 2 đường uốn trong 1 plate)

Cám ơn Bác nhiều và chúc Noel zui zẻ.

  • 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
phamthanhbinh    3.123
Các bảng kết quả in ra của Lisp Bác viết đúng là đẹp hết ý luôn. Nhưng còn cần phải đánh số/chữ của các Point như bản vẽ minh hoạ nữa Bác ạ.

Xin phiền Bác tý nhé. Luôn tiện Bác cho thêm các option hỏi có còn thêm cái BEND LINE POINTS nữa không (vì cũng có khi phải có 2 đường uốn trong 1 plate)

PP có sưu tầm 1 cái Lisp này được viết cách đây đến 21 năm, gởi Bác xem ntn. ( Nhớ chọn Option 1 nhé)

Cám ơn Bác nhiều và chúc Noel zui zẻ.

Chào Bác Phi phi,

Cái này bác xem được chưa???

Yêu cầu nếu có nhiều BEND LINE thì mình sẽ phải viết lại một chút nữa. Bác chờ nhé.

Thôi chết còn quên hai cái mũi tên chỉ hướng trục và tên trục. Xin lỗi bác mình sẽ bổ sung sau nhé. Đến giờ nhậu rồi, hề hề hề.

(defun c:tabc ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq col (getvar "cecolor"))
(setvar "osmode" 0)
(setq pc (getpoint "\n Chon diem chuan kich thuoc")
     xc (car pc)
     yc (cadr pc))
(setvar "pdmode" 3)
(setvar "cecolor" "1")
(command "point" pc)
(princ "\n Chon cac holes theo trat tu hien thi")
(setq ssci (ssget '((0 . "CIRCLE")))
     n (sslength ssci)
     i 0
     h (getreal "\n Nhap chieu cao text: ")
     lstx (list)
     lsty (list)
     lstr (list))
(while ((setq cir (ssname ssci i)
     lstx (append lstx (list (- (cadr (assoc 10 (entget cir))) xc)) )
     lsty (append lsty (list (- (caddr(assoc 10 (entget cir))) yc)) )
     lstr (append lstr (list (cdr (assoc 40 (entget cir)))) )
     p (list (+ (cadr (assoc 10 (entget cir))) (* (cdr (assoc 40 (entget cir))) 3)) (caddr (assoc 10 (entget cir))))
     i (1+ i))
(command "text" "j" "m" p h 0 (rtos i 2 0))
)
(setq pb (getpoint "\n Chon diem dat bang kich thuoc")
     pt (getpoint "\n Chon diem dat text bat ky"))
(command "text" "j" "m" pt h 0 (rtos (nth 0 lstx) 2 4))
(setq tb (textbox (entget(entlast)))
     d (distance (car tb) (cadr tb)))
(entdel (entlast))
(setvar "cecolor" "2")
(command "text" "j" "m" pb (* 1.5 h) 0 "HOLES LOCATION")
(setq p1 (list (- (car pb) (* 2 d)) (- (cadr pb) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "DIA")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "X axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "Y axis")
(setq j 0)
(while ((setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h (1+ j))))
(command "text" "j" "m" p11 h 0 (rtos (1+ j) 2 0))     
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (* 2 (nth j lstr)) 2 1)) 
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (nth j lstx) 2 0)) 
(setq p44 (polar p33 0 (* 1.5 d)))
(command "text" "j" "m" p44 h 0 (rtos (nth j lsty) 2 0))
(setq j (1+ j))
)
(setq ans (getstring "\n Ban co muon tao bang toa do duong uon : "))
(if (= ans "y")
(progn
(setq p0 (getpoint "\n Chon diem dat bang"))
(command "text" "j" "m" p0 (* 1.5 h) 0 "BEND LINE POINTS")
(setq p1 (list (- (car p0) (* 2 d)) (- (cadr p0) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "X axis")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "Y axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "NOTES")
(setq lst (entget (car (entsel "\n Chon bend line"))))
(setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h)))
(command "text" "j" "m" p11 h 0 "P1") 
(setq p5 (cdr (assoc 10 lst))
     p55 (polar p5 pi 15))
(command "text" "j" "m" p55 h 0 "P1")    
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (- (cadr (assoc 10 lst)) xc) 2 0)) 
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (- (caddr (assoc 10 lst)) yc) 2 0)) 
(setq p111 (polar p1 (- (/ pi 2)) (* 3 h)))
(command "text" "j" "m" p111 h 0 "P2") 
(setq p6 (cdr (assoc 11 lst))
     p66 (polar p6 0 15))
(command "text" "j" "m" p66 h 0 "P2")    
(setq p222 (polar p111 0 (* 1.5 d)))
(command "text" "j" "m" p222 h 0 (rtos (- (cadr (assoc 11 lst)) xc) 2 0)) 
(setq p333 (polar p222 0 (* 1.5 d)))
(command "text" "j" "m" p333 h 0 (rtos (- (caddr (assoc 11 lst)) yc) 2 0)) 
)
)
(setvar "cecolor" col) 
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
)

Cám ơn bác về đoạn code bác gửi.

  • Vote tăng 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
Phiphi-    175
Chào Bác Phi phi,

Cái này bác xem được chưa???

Lisp này thì quá đạt yêu cầu rồi bác phamthanhbinh ạ. Rất cảm ơn công sức của Bác đã giúp đở. Bác không cần thêm hai cái mũi tên chỉ hướng trục và tên trục nữa đâu.

Tiếc là PC của Bác đã không run được Lisp TABCORD của ASMI mà PP có upload trong bài #598. Nhưng Bác có thể xem ở đây:

http://www.asmitools.com/Files/Lisps/Tabcord.html (PP có độ lại để dùng cho việc như trên).

Đây là 1 mẫu bv của người khác đã vẽ: http://www.cadviet.com/upfiles/2/89.jpg

PP chưa thực hiện bv kiểu này, mới chỉ làm mấy model 3D như trong link này:

http://www.cadviet.com/forum/index.php?sho...c=11939&hl=

Thanks you.

  • 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
phamthanhbinh    3.123
Lisp này thì quá đạt yêu cầu rồi bác phamthanhbinh ạ. Rất cảm ơn công sức của Bác đã giúp đở. Bác không cần thêm hai cái mũi tên chỉ hướng trục và tên trục nữa đâu.

Tiếc là PC của Bác đã không run được Lisp TABCORD của ASMI mà PP có upload trong bài #598. Nhưng Bác có thể xem ở đây:

http://www.asmitools.com/Files/Lisps/Tabcord.html (PP có độ lại để dùng cho việc như trên).

Đây là 1 mẫu bv của người khác đã vẽ: http://www.cadviet.com/upfiles/2/89.jpg

PP chưa thực hiện bv kiểu này, mới chỉ làm mấy model 3D như trong link này:

http://www.cadviet.com/forum/index.php?sho...c=11939&hl=

Thanks you.

Chào bác Phiphi,

Cái này sẽ di chuyển gốc tọa độ về điểm chuẩn giống như trên bản vẽ bác gửi. Còn cái vụ nhiều Bend line thì bác chờ thêm chút xíu nha.

Cái trang web bác gửi WWW.asmitools.com mình vào không được bác ạ. Các model 3D của bác xem khá đẹp và có lẽ mình cũng cần tìm hiểu thêm về phần mềm này. Cám ơn bác đã chia sẻ.

(defun c:tabc ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq col (getvar "cecolor"))
(setvar "osmode" 0)
(command "ucs" "World")
(setq pc (getpoint "\n Chon diem chuan kich thuoc")
     xc (car pc)
     yc (cadr pc))
(setvar "pdmode" 3)
(setvar "cecolor" "1")
(command "point" pc)
(princ "\n Chon cac holes theo trat tu hien thi")
(setq ssci (ssget '((0 . "CIRCLE")))
     n (sslength ssci)
     i 0
     h (getreal "\n Nhap chieu cao text: ")
     lstx (list)
     lsty (list)
     lstr (list))
(while ((setq cir (ssname ssci i)
     lstx (append lstx (list (- (cadr (assoc 10 (entget cir))) xc)) )
     lsty (append lsty (list (- (caddr(assoc 10 (entget cir))) yc)) )
     lstr (append lstr (list (cdr (assoc 40 (entget cir)))) )
     p (list (+ (cadr (assoc 10 (entget cir))) (* (cdr (assoc 40 (entget 

cir))) 3)) (caddr (assoc 10 (entget cir))))
     i (1+ i))
(command "text" "j" "m" p h 0 (rtos i 2 0))
)
(setq pb (getpoint "\n Chon diem dat bang kich thuoc")
     pt (getpoint "\n Chon diem dat text bat ky"))
(command "text" "j" "m" pt h 0 (rtos (nth 0 lstx) 2 4))
(setq tb (textbox (entget(entlast)))
     d (distance (car tb) (cadr tb)))
(entdel (entlast))
(setvar "cecolor" "2")
(command "text" "j" "m" pb (* 1.5 h) 0 "HOLES LOCATION")
(setq p1 (list (- (car pb) (* 2 d)) (- (cadr pb) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "DIA")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "X axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "Y axis")
(setq j 0)
(while ((setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h (1+ j))))
(command "text" "j" "m" p11 h 0 (rtos (1+ j) 2 0))     
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (* 2 (nth j lstr)) 2 1)) 
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (nth j lstx) 2 0)) 
(setq p44 (polar p33 0 (* 1.5 d)))
(command "text" "j" "m" p44 h 0 (rtos (nth j lsty) 2 0))
(setq j (1+ j))
)
(setq ans (getstring "\n Ban co muon tao bang toa do duong uon : 

"))
(if (= ans "y")
(progn
(setq p0 (getpoint "\n Chon diem dat bang"))
(command "text" "j" "m" p0 (* 1.5 h) 0 "BEND LINE POINTS")
(setq p1 (list (- (car p0) (* 2 d)) (- (cadr p0) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "X axis")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "Y axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "NOTES")
(setq lst (entget (car (entsel "\n Chon bend line"))))
(setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h)))
(command "text" "j" "m" p11 h 0 "P1") 
(setq p5 (cdr (assoc 10 lst))
     p55 (polar p5 pi 15))
(command "text" "j" "m" p55 h 0 "P1")    
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (- (cadr (assoc 10 lst)) xc) 2 0)) 
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (- (caddr (assoc 10 lst)) yc) 2 0)) 
(setq p111 (polar p1 (- (/ pi 2)) (* 3 h)))
(command "text" "j" "m" p111 h 0 "P2") 
(setq p6 (cdr (assoc 11 lst))
     p66 (polar p6 0 15))
(command "text" "j" "m" p66 h 0 "P2")    
(setq p222 (polar p111 0 (* 1.5 d)))
(command "text" "j" "m" p222 h 0 (rtos (- (cadr (assoc 11 lst)) xc) 2 0)) 
(setq p333 (polar p222 0 (* 1.5 d)))
(command "text" "j" "m" p333 h 0 (rtos (- (caddr (assoc 11 lst)) yc) 2 0)) 
)
)
(setvar "cecolor" col) 
(setvar "osmode" om )
(setvar "cmdecho" 1)
(command "ucs" "m" pc)
(command "ucsicon" "or")
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
)

Chúc bác luôn vui.

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
phamthanhbinh    3.123
Lisp này thì quá đạt yêu cầu rồi bác phamthanhbinh ạ. Rất cảm ơn công sức của Bác đã giúp đở. Bác không cần thêm hai cái mũi tên chỉ hướng trục và tên trục nữa đâu.

Tiếc là PC của Bác đã không run được Lisp TABCORD của ASMI mà PP có upload trong bài #598. Nhưng Bác có thể xem ở đây:

http://www.asmitools.com/Files/Lisps/Tabcord.html (PP có độ lại để dùng cho việc như trên).

Đây là 1 mẫu bv của người khác đã vẽ: http://www.cadviet.com/upfiles/2/89.jpg

PP chưa thực hiện bv kiểu này, mới chỉ làm mấy model 3D như trong link này:

http://www.cadviet.com/forum/index.php?sho...c=11939&hl=

Thanks you.

Chào bác Phiphi-,

Hề hề hề,

Hy vọng cái lisp này sẽ làm bác có được Giáng sinh xôm trò. Nó giải quyết được cả việc bác có nhiều BEND LINES. Tuy nhiên bác phải nhớ rằng các BEND LINES này dứt khoát phải là các LINE bác nhé. Bác mà xài BEND LINE bằng LWPOLYLINE hay POLYLINE là hỏng hết bánh kẹo đó nha. Nó cũng sẽ đưa hệ trục tọa độ về cái điểm chuẩn mà bác đã chọn.

Khi lisp hỏi bác có muốn lập bảng tọa độ của BEND LINE thì bác trả lời "y", sau đó nó sẽ yêu cầu bác chọn tất cả các bend line bác có và nó sẽ cho ra bảng tọa độ mà bác muốn bác ạ.

Bác xài thử coi nhé.

(defun c:tabc ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq col (getvar "cecolor"))
(setvar "osmode" 0)
(command "ucs" "World")
(setq pc (getpoint "\n Chon diem chuan kich thuoc")
     xc (car pc)
     yc (cadr pc))
(setvar "pdmode" 3)
(setvar "cecolor" "1")
(command "point" pc)
(princ "\n Chon cac holes theo trat tu hien thi")
(setq ssci (ssget '((0 . "CIRCLE")))
     n (sslength ssci)
     i 0
     h (getreal "\n Nhap chieu cao text: ")
     lstx (list)
     lsty (list)
     lstr (list))
(while ((setq cir (ssname ssci i)
     lstx (append lstx (list (- (cadr (assoc 10 (entget cir))) xc)) )
     lsty (append lsty (list (- (caddr(assoc 10 (entget cir))) yc)) )
     lstr (append lstr (list (cdr (assoc 40 (entget cir)))) )
     p (list (+ (cadr (assoc 10 (entget cir))) (* (cdr (assoc 40 (entget cir))) 3)) (caddr (assoc 10 (entget cir))))
     i (1+ i))
(command "text" "j" "m" p h 0 (rtos i 2 0))
)
(setq pb (getpoint "\n Chon diem dat bang kich thuoc")
     pt (getpoint "\n Chon diem dat text bat ky"))
(command "text" "j" "m" pt h 0 (rtos (nth 0 lstx) 2 4))
(setq tb (textbox (entget(entlast)))
     d (distance (car tb) (cadr tb)))
(entdel (entlast))
(setvar "cecolor" "2")
(command "text" "j" "m" pb (* 1.5 h) 0 "HOLES LOCATION")
(setq p1 (list (- (car pb) (* 2 d)) (- (cadr pb) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "DIA")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "X axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "Y axis")
(setq j 0)
(while ((setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h (1+ j))))
(command "text" "j" "m" p11 h 0 (rtos (1+ j) 2 0))     
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (* 2 (nth j lstr)) 2 1)) 
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (nth j lstx) 2 0)) 
(setq p44 (polar p33 0 (* 1.5 d)))
(command "text" "j" "m" p44 h 0 (rtos (nth j lsty) 2 0))
(setq j (1+ j))
)
(setq ans (getstring "\n Ban co muon tao bang toa do duong uon : "))
(if (= ans "y")
(progn
(setq p0 (getpoint "\n Chon diem dat bang"))
(command "text" "j" "m" p0 (* 1.5 h) 0 "BEND LINE POINTS")
(setq p1 (list (- (car p0) (* 2 d)) (- (cadr p0) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "X axis")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "Y axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "NOTES")
(setq ssln (ssget '((0 . "LINE")))
     m (sslength ssln)
     k 0)
(while ((setq lstl (entget (ssname ssln k))
     p5 (cdr (assoc 10 lstl))
     p6 (cdr (assoc 11 lstl))
     p55 (polar p5 pi 15)
     p66 (polar p6 0 15))
(command "text" "j" "m" p55 h 0 (strcat "P" (rtos (1+ (* 2 k)) 2 0)))
(command "text" "j" "m" p66 h 0 (strcat "P" (rtos (+ 2 (* 2 k)) 2 0)))
(setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h (+ 1 (* 2 k)))))
(command "text" "j" "m" p11 h 0 (strcat "P" (rtos (+ 1 (* 2 k)) 2 0)))
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (- (car p5) xc) 2 0))
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (- (cadr p5) yc) 2 0))
(setq p111 (polar p11 (- (/ pi 2)) (* 1.5 h)))
(command "text" "j" "m" p111 h 0 (strcat "P" (rtos (+ 2 (* 2 k)) 2 0)))
(setq p222 (polar p111 0 (* 1.5 d)))
(command "text" "j" "m" p222 h 0 (rtos (- (car p6) xc) 2 0))
(setq p333 (polar p222 0 (* 1.5 d)))
(command "text" "j" "m" p333 h 0 (rtos (- (cadr p6) yc) 2 0))
(setq k (1+ k))
)
)
)
(setvar "cecolor" col) 
(setvar "osmode" om )
(setvar "cmdecho" 1)
(command "ucs" "m" pc)
(command "ucsicon" "or")
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
)

Chúc bác một năm mới thành công. Hề hề hề.....

  • Vote tăng 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
Phiphi-    175
Chào bác Phiphi-,

Hề hề hề,

Hy vọng cái lisp này sẽ làm bác có được Giáng sinh xôm trò. Nó giải quyết được cả việc bác có nhiều BEND LINES. Tuy nhiên bác phải nhớ rằng các BEND LINES này dứt khoát phải là các LINE bác nhé. Bác mà xài BEND LINE bằng LWPOLYLINE hay POLYLINE là hỏng hết bánh kẹo đó nha. Nó cũng sẽ đưa hệ trục tọa độ về cái điểm chuẩn mà bác đã chọn.

Khi lisp hỏi bác có muốn lập bảng tọa độ của BEND LINE thì bác trả lời "y", sau đó nó sẽ yêu cầu bác chọn tất cả các bend line bác có và nó sẽ cho ra bảng tọa độ mà bác muốn bác ạ.

Bác xài thử coi nhé.

Chào bác phamthanhbinh.

Lisp Bác viết chạy rất tốt, cám ơn Bác nhiều.

Nếu Bác xem cái bản vẽ mẫu PP post ở bài trên thì còn phải lập thêm bảng PLATE CONTOUR thì mới đầy đủ chi tiết.

PP phải dùng Lisp Plate contour dưới đây. Vì đường bao của plate là 1 Pline nên chỉ cần select nó thì cái bảng hiện ra liền, sau đó rồi phải Explode, Erase lines & sắp xếp lại Text.

Chắc sau Noel sẽ nhờ Bác lần nữa rồi. Với bảng PLATE CONTOUR thì các ID points đánh theo mẫu tự A,B,C ...

Have a great Christmas!

;; ============================================================	;;
;;                                                              ;;
;;  TABCORD.LSP - Fills the table in co-ordinates of LwPolyline ;;
;;                vertexes, and also the centres and radiuses   ;;
;;                of arc segments. Marks vertexes of LwPolyline ;;
;;                accordingly data in the table by digits or    ;;
;;                letters. Look section 'ADJUSTMENT' for        ;;
;;                acquaintance with options.                    ;;
;;                                                            	;;
;; ============================================================	;;
;;                                                            	;;
;;  Command(s) to call: PLC =Plate contour                      ;;
;;                                                          	;;
;;  Select LwPolyline and after the table will be generated     ;;
;;  insert it into the necessary place. After that vertexes of  ;;
;;  polylines will be marked by figures or letters.             ;;
;;                                                            	;;
;; ============================================================	;;
;;                                                             	;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD	;;
;;  ON ANY MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS	;;
;;  PROGRAM OR PARTS OF IT ABSOLUTELY FREE.                 	;;
;;                                                              ;;
;;  THIS PROGRAM PROVIDES THIS PROGRAM 'AS IS' WITH ALL FAULTS	;;
;;  AND SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF		;;
;;  MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.            ;;
;;                                                            	;;
;; ============================================================	;;
;;                                                              ;;
;;  V1.3, 14th Aug 2008, Riga, Latvia                           ;;
;;  © Aleksandr Smirnov (ASMI)                          	;;
;;  For AutoCAD 2005 - 2008 (isn't tested in a next versions)	;;
;;                                                              ;;
;;                                   [url="http://www.asmitools.com"]http://www.asmitools.com[/url]   ;;
;;                                                            	;;
;; ============================================================ ;;


(defun c:PLC(/ aCen cAng cCen cPl cRad cReg
	fDr it lCnt lLst mSp pCen pT1
	pT2 ptLst R tHt tLst vlaPl vlaTab
	vLst cTxt oldCol nPl clFlg actDoc
	tPt1 tPt2 cAng tiPt oSnp *error*
	mType mHt oZin cAcu dHead hStr
	hHt w1 w2 w3 isPer isAre pMul aMul
	lWrt aVal xVal yVal)


;;;  ****************************************************************
;;;  *************************** ADJUSTMENT *************************
;;;  ****************************************************************

 (setq mType NIL) 	; Markups mode. T - digits, NIL - letters

 (setq tHt -1.0)    	; Table text size. Positive - absolute,
                       ; negative multiplayer to TEXTSIZE variable

 (setq mHt -1.0)	; Markups text size. Positive - absolute,
                       ; negative - multiplayer to TEXTSIZE variable

 (setq cAcu 0)    	; Precision of coordinates (from 0 to 8)

 (setq dHead nil)   	; If T delete table header, if NIL not delete

 (setq hStr "PLATE CONTOUR") ; Standard header (if dHead not equal T)

 (setq hHt -1.0)      ; Header text size. Positive - absolute,			(setq hHt -1.25) 
                       ; negative - multiplayer to TEXTSIZE variable

 (setq w1 -5.0)       ; 'Point' column width. Positive - absolute,
                       ; negative - multiplayer to TEXTSIZE variable

 (setq w2 -5.0)       ; 'X' and 'Y' colums width. Positive - absolute,
                       ; negative - multiplayer to TEXTSIZE variable

 (setq w3 -5.0)       ; 'Radius' column width. Positive - absolute,
                       ; negative - multiplayer to TEXTSIZE variable

 (setq isPer nil)	; if T adds perimeter row

 (setq isAre nil)        ; if T adds area row

 (setq isGCen nil)       ; if T adds center of gravity row

 (setq pMul 1)   	  ; perimeter multiplayer 0.001-1

 (setq aMul 1) 	 ; area  multiplayer 0.000001-1

;;;  ****************************************************************
;;;  ************************* END ADJUSTMENT ***********************
;;;  ****************************************************************

 (if(minusp tHt)
   (setq tHt(getvar "TEXTSIZE"))
   ); end if

 (if(minusp mHt)
   (setq mHt(*(abs mHt)(getvar "TEXTSIZE")))
   ); end if

   (if(minusp hHt)
   (setq hHt(*(abs hHt)(getvar "TEXTSIZE")))
   ); end if

 (if(minusp w1)
   (setq w1(*(abs w1)(getvar "TEXTSIZE")))
   ); end if

 (if(minusp w2)
   (setq w2(*(abs w2)(getvar "TEXTSIZE")))
   ); end if

 (if(minusp w3)
   (setq w3(*(abs w3)(getvar "TEXTSIZE")))
   ); end if

 (vl-load-com)

 (defun Get_Acad_Ver(Gen_Only)
   (if Gen_Only
    (substr(getvar "ACADVER") 1 2)
    (substr(getvar "ACADVER") 1 4)
   ); end if
 ); and of Get_Acad_Ver

 (defun Extract_DXF_Values(Ent Code)
   (mapcar 'cdr
    (vl-remove-if-not
     '(lambda(a)(=(car a)Code))
 (entget Ent)))
   ); end of


 (defun *error*(msg)
   (setvar "CMDECHO" 1)
   (if oSnp(setvar "OSMODE" oSnp))
   (if oZin(setvar "DIMZIN" oZin))
   (if mSp(vla-EndUndoMark actDoc))
   (princ)
   ); end of *error*

 (defun Alph_Num(Counter / lLst cRes)
 (setq lLst '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J"
       "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
       "U" "V" "W" "X" "Y" "Z"))
 (if(<= 1.0(setq cRes(/ Counter 26.0)))
    (strcat(itoa(fix cRes))
   (nth(- Counter(* 26(fix cRes)))lLst))
    (nth Counter lLst)
   ); end if
 ); end of Alph_Num


(if(<= 16.1(atof(Get_Acad_Ver nil)))
 (progn
 (if
   (and
     (setq cPl(entsel "\nSelect LwPoliline > "))
     (= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0)))
     ); end and
(progn
  (princ "\nPlease Wait... \n")
  (setq vlaPl(vlax-ename->vla-object(car cPl))
	ptLst(mapcar 'append
		       (setq vLst(Extract_DXF_Values(car cPl)10))
		       (mapcar 'list(Extract_DXF_Values(car cPl)42)))
	r 2 lCnt 0
	tLst '((1 0 "PT#")(1 1 "X axis")(1 2 "Y axis")(1 3 "Radius"))
	actDoc(vla-get-ActiveDocument
	       (vlax-get-acad-object))
	mSp(vla-get-ModelSpace actDoc)
	    ); end setq
    (setvar "CMDECHO" 0)
    (setq oSnp(getvar "OSMODE"))
    (setq oZin(getvar "DIMZIN"))
    (setvar "DIMZIN" 0)
    (vla-StartUndoMark actDoc)
    (foreach vert ptLst
      (setq vert(trans vert 0 1)
	    tLst(append tLst
		  (list(list r 0(if mType
				  (itoa(1+ lCnt))
				    (Alph_Num lCnt)))
		  (list r 1(rtos(car vert)2 cAcu))
		  (list r 2(rtos(cadr vert)2 cAcu))
		  (list r 3 ""))))
      (if(and
	   (/= 0.0(last vert))
	    (setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt))
	    (setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt)))
	   ); end and
	(setq r(1+ r)
	      cRad(abs(/(distance pt1 pt2)
		  2(sin(/(* 4(atan(abs(last vert))))2))))
	      aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt))
	      fDr(vlax-curve-getFirstDeriv vlaPl
		   (vlax-curve-getParamAtPoint vlaPl aCen))
	      pCen(trans
		    (polar aCen(-(if(minusp(last vert)) pi(* 2 pi))
		      (atan(/(car fDr)(cadr fDr))))cRad)0 1)
	      tLst(append tLst(list
		    (list r 0 "Center")
		    (list r 1(rtos(car pCen)2 cAcu))
		    (list r 2(rtos(cadr pCen)2 cAcu))
		    (list r 3(rtos cRad 2 cAcu))))
	      ); end setq
	); end if
      (setq r(1+ r) lCnt(1+ lCnt))
      ); end foreachplc_blp_hl
  (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))
		(+ 1(/(length tLst)4)) 4 (* 3 tHt)w2))
  (foreach i tLst
    (vl-catch-all-apply 'vla-SetText(cons vlaTab i))  
    (vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt)
    (vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter)
    ); end foreach
  (if(or isPer isAre)
    (progn
   (vla-InsertRows vlaTab r(* 0.05 tHt)1)
   (vla-SetCellTextHeight vlaTab r 0(* 0.05 tHt))
   (setq r(1+ r))
      ); end progn
    ); end if
  (if isPer
    (progn
      (if(= :vlax-true(vla-get-Closed vlaPl))
        (setq lWrt "Perimeter")
	(setq lWrt "Length")
       ); end if
      (vla-InsertRows vlaTab r tHt 1)
      (vla-SetText vlaTab r 0 lWrt)
      (vla-SetText vlaTab r 1
	(rtos(*(vla-get-Length vlaPl)pMul)2 cAcu))
      (vla-SetCellTextHeight vlaTab r 0 tHt)
      (vla-SetCellTextHeight vlaTab r 1 tHt)
      (setq r(1+ r))
      ); end progn
    ); end if
  (if isAre
    (progn
      (if(= :vlax-true(vla-get-Closed vlaPl))
        (setq aVal (rtos(*(vla-get-Area vlaPl)aMul)2 cAcu))
	(setq aVal "Not closed contour")
       ); end if
      (vla-InsertRows vlaTab r tHt 1)
      (vla-SetText vlaTab r 0 "Area")
      (vla-SetText vlaTab r 1 aVal)
      (vla-SetCellTextHeight vlaTab r 0 tHt)
      (vla-SetCellTextHeight vlaTab r 1 tHt)
      (setq r(1+ r))
      ); end progn
    ); end if
  (if(= :vlax-true(vla-get-Closed vlaPl))
    (progn
     (setq nPl(vla-Copy vlaPl))
     (command "_.region" (entlast) "")
     (setq cCen(vlax-get(setq cReg
	 (vlax-ename->vla-object(entlast)))'Centroid))
      (vla-Delete cReg)
      (setq clFlg T)
     ); end progn
    ); end if
  (if isAre
    (progn
      (if cCen
        (setq xVal(rtos(car cCen)2 cAcu)
	      yVal (rtos(cadr cCen)2 cAcu))
	(setq xVal "-"
	      yVal "-")
       ); end if
      (vla-InsertRows vlaTab r tHt 1)
      (vla-SetText vlaTab r 0 "Gravity Center")
      (vla-SetText vlaTab r 1 xVal)
      (vla-SetText vlaTab r 2 yVal)
      (vla-SetCellTextHeight vlaTab r 0 tHt)
      (vla-SetCellTextHeight vlaTab r 1 tHt)
      (vla-SetCellTextHeight vlaTab r 2 tHt)
      (setq r(1+ r))
      ); end progn
    ); end if
  (vla-put-VertCellMargin vlaTab (* 0.75 tHt))
  (vla-SetColumnWidth vlaTab 0 w1)
  (vla-SetColumnWidth vlaTab 3 w3)
  (if(vlax-property-available-p vlaTab 'RepeatTopLabels)
    (vla-put-RepeatTopLabels vlaTab :vlax-true)
    ); end if
  (if(vlax-property-available-p vlaTab 'BreakSpacing)
    (vla-put-BreakSpacing vlaTab (* 3 tHt))
    ); end if
   (if dHead
     (vla-DeleteRows  vlaTab 0 1)
     (progn
       (vla-SetText vlaTab 0 0 hStr)
       (vla-SetCellTextHeight vlaTab 0 0 hHt)
      ); end progn
    ); end if
  (vla-put-Height vlaTab(* 1.75(/(length tLst)4)))
  (princ "\n<<< Place Table >>> ")
  (command "_.copybase" (trans '(0 0 0)0 1)(entlast) "")
  (command "_.erase" (entlast) "")
  (command "_.pasteclip" pause)
  (setq lCnt 0)
  (foreach v vLst
    (if clFlg
      (setq cAng(angle cCen(trans v 0 1))
            iPt(polar v cAng (* 2 mHt)))
      (setq tPt1(vlax-curve-GetPointAtParam vlaPl
		  (- lCnt 0.0000001))
	    tPt2(vlax-curve-GetPointAtParam vlaPl
		  (+ lCnt 0.0000001))
	    iPt(polar v(+(* pi 0.5)(if(minusp
		(setq cAng(angle tPt1(if tPt2 tPt2
		   (polar tPt1(* 0.5 pi)0.0000001)))))
		cAng(- cAng)))(* 2 mHt))
	    ); end setq
      ); end if
    (setvar "OSMODE" 0)
    (setq cTxt(vla-AddText mSp
	      (if mType(itoa(1+ lCnt))(Alph_Num lCnt))
	       (vlax-3d-point iPt) mHt)
	  tiPt(vla-get-InsertionPoint cTxt)
	  lCnt(1+ lCnt)
	  ); end setq
    (vla-put-Alignment cTxt 10)
    (vla-put-TextAlignmentPoint cTxt tiPt)
    (setq oldCol(getvar "CECOLOR"))
    (setvar "CECOLOR" "1")
   ; (command "_.circle"(trans v 0 1) (/ mHt 4))
    (setvar "CECOLOR" oldCol)
    ); end foreach
  (setvar "DIMZIN" oZin)
  (setvar "OSMODE" oSnp)
  (setvar "CMDECHO" 1)
  (vla-EndUndoMark actDoc)
  ); end progn
    (princ "\n It isn't LwPolyline! Quit.  ")
   ); end if
  ); end progn
 (princ "\n This program works in AutoCAD 2005+ only!  " )
 );end if
   (gc)
 (princ)
); end of c:tabcord
(princ "\n*** Type PLC to fill table of LwPolyline coordinates *** ")

  • 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
gia_bach    1.442
Cám ơn tất cả các bác đã nhiệt tình giúp đỡ . Lisp của bác gia_bach rất hay , và rất đúng ý em . Tuy nhiên , vẫn còn thiếu việc đặt tên ,chèn vào table cho point đó (trước khi pick chọn point ấy) và định chiều cao của text như mong muôn . Em cũng đã làm được cách đây vài ngày rùi , nhưng phải mất vài bước nhập qua nhập lại nên hơi mất công , nên thử xem có phương án nào hay hơn nữa không .

Bài này lâu rồi, không biết bạn có cần nữa không ?

Tuy nhiên thử phương án này có khá hơn không?

Update 30/12/09.

Lisp xuất ra bảng tọa độ của các POINT.

- đặt tên : theo thứ tự từ trái qua phải, từ trên xuống duới.

- số chữ số thập phân : lấy theo giá trị mặc định (Format-> Units... ) hay biến hệ thống LUPREC.

(defun c:Pid(/ cen doc i h height lst msp ov pt row str stt tblobj vl width x y) ;Point ID out
;;  By : Gia Bach, Copyrightゥ December 2009                    ;;
;;  Contact : gia_bach @  www.CadViet.com                      ;;
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0) (progn
 (princ "\nChon cac POINT de xuat ra Bang toa do :")
 (if (ssget '((0 . "POINT")))
   (progn
     (vl-load-com)
     (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
    msp (vla-get-modelspace doc))
     (vlax-for e (vla-get-ActiveSelectionSet doc)
(setq cen (vlax-safearray->list (variant-value (vla-get-Coordinates e)))
      lst (cons (list (car cen)(cadr cen) )lst))
);vlax-for
     (setq lst (vl-sort lst '(lambda (x y) (or	(< (car x) (car y));Check X
					(and (> (cadr x) (cadr y));Check Y
					     (= (car x) (car y));Equal X
					     )	) ) ))
     (setq vl '("dimzin" "cmdecho")    ; Sys Var list  
    ov  (mapcar 'getvar vl))    ; Get Old values
     (mapcar 'setvar vl '(0 0))
     (or *h* (setq *h* 175))
     (initget 6)
     (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
     (if h (setq *h* h) (setq h *h*) )
     (setq str (last lst))
     (if (> (car str)(cadr str) )
(setq str (car str))
(setq str (cadr str)))
     (setq width (* 2(TxtWidth (rtos str) h msp))
    width1 (* 2 (TxtWidth "STT" h msp))
    height (* 2 h))
     (if (> h 3)
(setq width (* (fix (/ width 10))10)
      width1 (* (fix (/ width1 10))10)
      height (* (fix (/ height 5))5)))
     (setq i 1
    row 2
    pt (getpoint "\nDiem dat Bang :")
    TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 height width))
     (vla-put-vertcellmargin TblObj (/ h 4))
     (vla-SetColumnWidth TblObj 0 width1)
     (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
      (list acTitleRow acHeaderRow acDataRow) )
     (mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
      (list acTitleRow acHeaderRow acDataRow))
     (vla-setText TblObj 0 0 "Bang toa do")
     (vla-setText TblObj 1 0 "STT")
     (vla-setText TblObj 1 1 "X")
     (vla-setText TblObj 1 2 "Y")
     (foreach pt lst
(setq stt (itoa i)) 
(vla-AddText msp stt (vlax-3d-point (polar pt (/ pi 4) (/ h 4))) h)
(vla-setText TblObj row 0 stt)
(vla-setText TblObj row 1 (rtos (car pt)))
(vla-setText TblObj row 2 (rtos (cadr pt)))
(setq row (1+ row) i (1+ i))
)
     (vlax-release-object TblObj)
     (mapcar 'setvar vl ov)                     ;reset Sys Vars
     (princ)      
     )
   )
 )
 (alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)")
 )
 )

(defun TxtWidth (val h msp / txt minp maxp)
 (setq	txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h))
 (vla-getBoundingBox txt 'minp 'maxp )
 (vla-Erase txt)
 (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp)))
 )

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

Chào các bác.

các bác có thể viết cho em một file lisp với nội dung như sau:

+ copy hoặc move các đối tượng với thứ tự được chọn tương ứng với khoảng cách mình nhập tọa độ

+ chọn lần lượt các đối tượng 1,2,3,...n-1,n. Sau đó nhập tọa độ lần lượt tương ứng với vị trí cần dời đế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
trinhvqh    222
Bài này lâu rồi, không biết bạn có cần nữa không ?

Tuy nhiên thử phương án này có khá hơn không?

- đặt tên : theo thứ tự từ trái qua phải, từ duới lên trên.

- số chữ số thập phân : lấy theo giá trị mặc định (Format-> Units... ) hay biến hệ thống LUPREC.

 

Công nhận gia_bach viết LISP quá ghê!

Để tạo ra Pid.lsp chắc phải tốn rất nhiều công phu

 

Sau khi Test có vài nhận xét sau:

- Việc đặt tên Point có lẽ nên định hướng lại

Từ trái sang phải thì phải từ trên xuống dưới (theo quy luật đọc văn bản)

- Chỉnh sửa tí xíu về khoảng cách Text trong Table so với đường ngang bên dưới (hơi sát quá)

 

Ngoài lề một chút (làm khó tác giả tí)

- Lisp trên chạy tốt rồi nhưng vẫn còn những giới hạn

- Nếu sau khi đặt tên và xuất Table cho Point nếu có một chỉnh sửa nhỏ xảy ra ví dụ di chuyển Point chẳng hạn thì sẽ xuất hiện những lố bịch ngay

Lúc đó người dùng sẽ phải gọi lệnh lại vừa phải xoá đi table và Tên point đã đánh

Tác giả nghiên cứu thêm có thể update table sau khi modify được k? (xem ra việc này hơi khó nhỉ!!!)

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
Phiphi-    175

Nhờ các Bác viết giúp đoạn code dùng để thêm vào các Lisp có sẳn.

1. Tự động Find và Replace các text trong bv. Thí dụ: Tìm thay các text "2009" thành "2010"

2. Xoá các block có tên "2009"

Thanks you.

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
thiep    263

Gởi bác Phiphi:

Lisp này không cần LWPOLYLINE có sẵn, chỉ cần pick các tâm lỗ đục (nếu dùng lệnh HL). Pick các điểm đầu của BEND LINE (nếu dùng lệnh BLP)

heicell = 1.5*tHt

Tự động điền số thứ tự của lỗ đục, hay các điểm đầu cuối của Bend line

 

;; ============================================================	;;
;;                                                              ;;
;;  TABCORD.LSP - Fills the table in co-ordinates of LwPolyline ;;
;;                vertexes, and also the centres and radiuses   ;;
;;                of arc segments. Marks vertexes of LwPolyline ;;
;;                accordingly data in the table by digits or    ;;
;;                letters. Look section 'ADJUSTMENT' for        ;;
;;                acquaintance with options.                    ;;
;;                                                            	;;
;; ============================================================	;;
;;                                                            	;;
;;  Command(s) to call: BLP = BEND LINE POINTS                  ;;
;;             to call: HL  = HOLES LOCATION                   	;;
;;                                                            	;;
;; ============================================================	;;
;;                                                             	;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD	;;
;;  ON ANY MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS	;;
;;  PROGRAM OR PARTS OF IT ABSOLUTELY FREE.                 	;;
;;                                                              ;;
;;  THIS PROGRAM PROVIDES THIS PROGRAM 'AS IS' WITH ALL FAULTS	;;
;;  AND SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF		;;
;;  MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.            ;;
;;                                                            	;;
;; ============================================================	;;
;;                                                              ;;
;;  V1.3, 14th Aug 2008, Riga, Latvia                           ;;
;;  © Aleksandr Smirnov (ASMI)                          	;;
;;  For AutoCAD 2005 - 2008 (isn't tested in a next versions)	;;
;;                                                              ;;
;;                                   [url="http://www.asmitools.com"]http://www.asmitools.com[/url]   ;;
;;                                                            	;;
;; ============================================================ ;;
;; Require: install Expess tool

(defun c:BLP (/ hStr tLst)
 (setq	hStr "BEND LINE POINTS"
tLst '((1 0 "PT#") (1 1 "X axis") (1 2 "Y axis") (1 3 ""))
 )
 (tabcord hStr tLst)
)
(defun c:HL (/ hStr tLst)
 (setq	hStr "HOLES LOCATION"
tLst '((1 0 "PT#") (1 1 "X axis") (1 2 "Y axis") (1 3 "DIA"))
 )
 (tabcord hStr tLst)
)
(vl-load-com)
(defun Text (model k po h / obj)
 (setq	obj (vla-AddText
      model
      (itoa k)
      (vlax-3d-point po)
      h
    )
 )
 (vla-put-Alignment obj acAlignmentmiddleleft)
 (vla-put-TextAlignmentPoint obj (vlax-3d-point po))
)
(defun tabcord (hStr tLst   /	   r	  k	 Xv	Yv     lCnt
	     lLst   mSp	   ptLst  vlaTab actDoc	oSnp   *error*
	     mType  oZin   cAcu	  hHt	 w1	isPer  heicell poText
	    )


;;;  *************************** ADJUSTMENT *************************
;;;  ****************************************************************

 (setq mType T)			; Markups mode. T - digits, NIL - letters

 (setq cAcu 1)				; Precision of coordinates (from 0 to 8)

;;;  (setq dHead nil)   	; If T delete table header, if NIL not delete

;;;  ************************* END ADJUSTMENT ***********************
;;;  ****************************************************************
(setq	tHt (cond	(tHt)
		(5)
	  )
 )
 (setq oldtHt tHt)
 (setq	tHt (getreal (strcat "\nSelect height text <"
			   (rtos oldtHt 2 1)
			   "> : "

		   )
	  )
 )
 (if (null tHt)
   (setq tHt oldtHt)
 )
 (setq	hHt (* 1.25 tHt)
w1  (* 6 tHt)
heicell (* 1.5 tHt)
 )
(defun Get_Acad_Ver (Gen_Only)
   (if	Gen_Only
     (substr (getvar "ACADVER") 1 2)
     (substr (getvar "ACADVER") 1 4)
   )					; end if
 )					; and of Get_Acad_Ver
 (defun DXF (code en) (cdr (assoc code (entget en)))) ; end of
 (defun *error* (msg)
   (setvar "CMDECHO" 1)
   (if	oSnp
     (setvar "OSMODE" oSnp)
   )
   (if	oZin
     (setvar "DIMZIN" oZin)
   )
   (if	mSp
     (vla-EndUndoMark actDoc)
   )
   (princ)
 )					; end of *error*
 (defun Alph_Num (Counter / lLst cRes)
   (setq lLst '("A"   "B"   "C"   "D"	 "E"   "F"   "G"   "H"	 "I"
	 "J"   "K"   "L"   "M"	 "N"   "O"   "P"   "Q"	 "R"
	 "S"   "T"   "U"   "V"	 "W"   "X"   "Y"   "Z"
	)
   )
   (if	(<= 1.0 (setq cRes (/ Counter 26.0)))
     (strcat (itoa (fix cRes))
      (nth (- Counter (* 26 (fix cRes))) lLst)
     )
     (nth Counter lLst)
   )					; end if
 )					; end of Alph_Num
 (setvar "CMDECHO" 0)
 (setq oSnp (getvar "OSMODE"))
 (setq oZin (getvar "DIMZIN"))
 (setvar "DIMZIN" 0)
 (setvar "OSMODE" 13)
 (if (<= 16.1 (atof (Get_Acad_Ver nil)))
   (progn
     (setq ptLst  (reverse (ACET-UI-FENCE-SELECT))
    r	   2
    lCnt   0
    actDoc (vla-get-ActiveDocument
	     (vlax-get-acad-object)
	   )
   summary (vla-get-SummaryInfo actDoc)
    mSp	   (vla-get-ModelSpace actDoc)
     )					; end setq

     (vla-StartUndoMark actDoc)
     (setq k 1)
     (foreach vert ptLst
(setq poText (list (+ (* 2 Tht) (car vert)) (cadr vert) 0))
(Text mSp k poText tHt) 
(setq Xv (rtos (car vert) 2 cAcu)
      Yv (rtos (cadr vert) 2 cAcu)
)
(setq vert (trans vert 0 1)
      tLst (append tLst
		   (list (list r
			       0
			       (if mType
				 (itoa (1+ lCnt))
				 (Alph_Num lCnt)
			       )
			 )
			 (list r 1 Xv)
			 (list r 2 Yv)
			 (list r 3 "")
		   )
	   )
)
(setq r	   (1+ r)
      lCnt (1+ lCnt)
)
(setq k (1+ k))
     )					; end foreach
     (if (< (strlen Yv) 7)
(setq W2 (+ 1 (* 7 tHt)))
(setq W2 (+ 1 (* (strlen Yv) tHt)))
     )
     (setq vlaTab (vla-AddTable
	     mSp
	     (vlax-3D-point '(0 0 0))
	     (+ 1 (/ (length tLst) 4))
	     4
	     heicell
	     w2
	   )
     )
     (foreach i tLst
(vl-catch-all-apply 'vla-SetText (cons vlaTab i))
(vla-SetCellTextHeight vlaTab (car i) (cadr i) tHt)
(vla-SetCellAlignment
  vlaTab
  (car i)
  (cadr i)
  acMiddleCenter
)
     )					; end foreach
     (vla-SetColumnWidth vlaTab 0 w1)
     (vla-SetColumnWidth vlaTab 3 w1)
     (vla-SetText vlaTab 0 0 hStr)
     (vla-SetCellTextHeight vlaTab 0 0 hHt)

     (setq en (entlast)
    ss (acet-list-to-ss (list en))
     )
     (setq
p2 (acet-ss-drag-move
     ss
     '(0 0 0)
     "\n<<< Pick a point for set place of Table >>> "
   )
     )
     (vla-move	vlaTab
	(vlax-3d-point '(0 0 0))
	(vlax-3d-point p2)
     )
     (setq lCnt 0)
     (setvar "DIMZIN" oZin)
     (setvar "OSMODE" oSnp)
     (setvar "CMDECHO" 1)
     (vla-EndUndoMark actDoc)
     (vla-put-Author summary
"THIEP 0918841230"
     )
     (vla-put-Comments summary
(setq chuc "Chuc cac ban thanh cong! THIEP")
     )
   )
   (princ
     "\n This program works in AutoCAD 2005+ only!  "
   )
 )					;end if
 (gc)
 (princ (strcat "\n" chuc))
); end of defun tabcord

Happy Christmas!

  • 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
Phiphi-    175

Chào bác Thiệp.

Khi xài lệnh HL thì Lisp cần phải thống kê cả đuờng kính các lổ. Bác xem lại các đề nghị trong bv PP post để sao cho đúng như đã trình bày. Luôn tiện nhờ bác chỉnh lại độ cao của Table sao cho bằng 1.5 Text height.

Lưu ý là các lổ đục chưa có đánh số thứ tự trước đâu nhé bác. User sẽ quyết định thứ tự để Lisp đánh số rồi lập bảng toạ độ.

 

Nếu Drafters nào muốn trình bày kiểu Table thì sẽ xài các Lisp này hoặc là xài Lisp của bác phamthanhbinh với Text mà thôi.

(Từ một TABCORD.LSP của ASMI, PP độ thành 3 lệnh để sử dụng cho bản vẽ chi tiết như đã minh hoạ).

 

Nhờ Bác viết giúp đoạn code dùng để thêm vào các Lisp có sẳn.

1. Tự động Find và Replace các text trong bv. Thí dụ: Tìm thay các text "2009" thành "2010"

2. Xoá các block có tên "2009"

Thanks you.

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
thiep    263
Chào bác Thiệp.

Khi xài lệnh HL thì Lisp cần phải thống kê cả đuờng kính các lổ. Bác xem lại các đề nghị trong bv PP post để sao cho đúng như đã trình bày. Luôn tiện nhờ bác chỉnh lại độ cao của Table sao cho bằng 1.5 Text height.

Lưu ý là các lổ đục chưa có đánh số thứ tự trước đâu nhé bác. User sẽ quyết định thứ tự để Lisp đánh số rồi lập bảng toạ độ.

 

Nếu Drafters nào muốn trình bày kiểu Table thì sẽ xài các Lisp này hoặc là xài Lisp của bác phamthanhbinh với Text mà thôi.

(Từ một TABCORD.LSP của ASMI, PP độ thành 3 lệnh để sử dụng cho bản vẽ chi tiết như đã minh hoạ).

 

Nhờ Bác viết giúp đoạn code dùng để thêm vào các Lisp có sẳn.

1. Tự động Find và Replace các text trong bv. Thí dụ: Tìm thay các text "2009" thành "2010"

2. Xoá các block có tên "2009"

Thanks you.

Chào bác Phi, Thiep đã edit lại lisp, bác tải lại nhé. Theo Thiep thì độ cao của Table sao cho bằng 1.5 Text height có quá thấp không, nếu thấy thấp thì sửa lại biến heicell tại dòng heicell (* 1.5 tHt)

1. Tự động Find và Replace các text:: Dùng lệnh Find trong Cad, không cần lisp.

2. Xoá các block có tên "abc...": bác Phi dùng lisp sau:

(defun c:EraseBlock ( / layout i)
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
bn (getstring "\nten block can xoa: "))
 (vlax-for layout (vla-get-layouts doc)
   (vlax-for i	(vla-get-block layout)
     (if (and
    (= (vla-get-objectname i) "AcDbBlockReference")
    (= (strcase (vla-get-name i)) (strcase bn))
  )
(vla-Delete i)
     )
   )
 )
)

Happy Christmas!

  • 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
phamthanhbinh    3.123
Chào bác phamthanhbinh.

Lisp Bác viết chạy rất tốt, cám ơn Bác nhiều.

Nếu Bác xem cái bản vẽ mẫu PP post ở bài trên thì còn phải lập thêm bảng PLATE CONTOUR thì mới đầy đủ chi tiết.

PP phải dùng Lisp Plate contour dưới đây. Vì đường bao của plate là 1 Pline nên chỉ cần select nó thì cái bảng hiện ra liền, sau đó rồi phải Explode, Erase lines & sắp xếp lại Text.

Chắc sau Noel sẽ nhờ Bác lần nữa rồi. Với bảng PLATE CONTOUR thì các ID points đánh theo mẫu tự A,B,C ...

Have a great Christmas!

Hề hề hề, bác Phiphi- ơi, có phải bác muốn món quà này không nhỉ???

Mình loay hoay mất một chút mới làm được cái món quà này, hy vọng bác sẽ hài lòng.

(defun c:tabc (/ xc yc n i h j k m  d e p  p0 pb p1 p2 p3 p4 p5 p6 pc pt 
p11 p22 p33 p44 p55 p66 p111 p222 p333 ssci ssln lstx lsty lstr lstl tb 
ans lstp enlst)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq col (getvar "cecolor"))
(setvar "osmode" 0)
(command "ucs" "World")
(setq pc (getpoint "\n Chon diem chuan kich thuoc")
     xc (car pc)
     yc (cadr pc))
(setvar "pdmode" 3)
(setvar "cecolor" "1")
(command "point" pc)
(princ "\n Chon cac holes theo trat tu hien thi")
(setq ssci (ssget '((0 . "CIRCLE")))
     n (sslength ssci)
     i 0
     h (getreal "\n Nhap chieu cao text: ")
     lstx (list)
     lsty (list)
     lstr (list))
(while ((setq cir (ssname ssci i)
     lstx (append lstx (list (- (cadr (assoc 10 (entget cir))) xc)) )
     lsty (append lsty (list (- (caddr(assoc 10 (entget cir))) yc)) )
     lstr (append lstr (list (cdr (assoc 40 (entget cir)))) )
     p (list (+ (cadr (assoc 10 (entget cir))) (* (cdr (assoc 40 (entget 
cir))) 3)) (caddr (assoc 10 (entget cir))))
     i (1+ i))
(command "text" "j" "m" p h 0 (rtos i 2 0))
)
(setq pb (getpoint "\n Chon diem dat bang kich thuoc")
     pt (getpoint "\n Chon diem dat text bat ky"))
(command "text" "j" "m" pt h 0 (rtos (nth 0 lstx) 2 4))
(setq tb (textbox (entget(entlast)))
     d (distance (car tb) (cadr tb)))
(entdel (entlast))
(setvar "cecolor" "2")
(command "text" "j" "m" pb (* 1.5 h) 0 "HOLES LOCATION")
(setq p1 (list (- (car pb) (* 2 d)) (- (cadr pb) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "DIA")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "X axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "Y axis")
(setq j 0)
(while ((setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h (1+ j))))
(command "text" "j" "m" p11 h 0 (rtos (1+ j) 2 0))     
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (* 2 (nth j lstr)) 2 1)) 
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (nth j lstx) 2 0)) 
(setq p44 (polar p33 0 (* 1.5 d)))
(command "text" "j" "m" p44 h 0 (rtos (nth j lsty) 2 0))
(setq j (1+ j))
)
(setq ans (getstring "\n Ban co muon tao bang toa do duong uon : 
"))
(if (= ans "y")
(progn
(setq p0 (getpoint "\n Chon diem dat bang"))
(command "text" "j" "m" p0 (* 1.5 h) 0 "BEND LINE POINTS")
(setq p1 (list (- (car p0) (* 2 d)) (- (cadr p0) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "X axis")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "Y axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "NOTES")
(setq ssln (ssget '((0 . "LINE")))
     m (sslength ssln)
     k 0)
(while ((setq lstl (entget (ssname ssln k))
     p5 (cdr (assoc 10 lstl))
     p6 (cdr (assoc 11 lstl))
     p55 (polar p5 pi 15)
     p66 (polar p6 0 15))
(command "text" "j" "m" p55 h 0 (strcat "P" (rtos (1+ (* 2 k)) 2 0)))
(command "text" "j" "m" p66 h 0 (strcat "P" (rtos (+ 2 (* 2 k)) 2 0)))
(setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h (+ 1 (* 2 k)))))
(command "text" "j" "m" p11 h 0 (strcat "P" (rtos (+ 1 (* 2 k)) 2 0)))
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (- (car p5) xc) 2 0))
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (- (cadr p5) yc) 2 0))
(setq p111 (polar p11 (- (/ pi 2)) (* 1.5 h)))
(command "text" "j" "m" p111 h 0 (strcat "P" (rtos (+ 2 (* 2 k)) 2 0)))
(setq p222 (polar p111 0 (* 1.5 d)))
(command "text" "j" "m" p222 h 0 (rtos (- (car p6) xc) 2 0))
(setq p333 (polar p222 0 (* 1.5 d)))
(command "text" "j" "m" p333 h 0 (rtos (- (cadr p6) yc) 2 0))
(setq k (1+ k))
)
)
)
(setq ans (getstring "\n Ban muon lap bang Plate Contour? : "))
(if (= ans "y")
(progn
(setq enlst (entget (car (entsel "\n Chon Lwpolyline contour")))
     lstp (list))
(foreach e enlst
(if (= (car e) 10)
(setq lstp (append lstp (list(cdr e))))
)
)
(setq p (getpoint "\n Chon diem dat bang"))
(command "text" "j" "m" p (* 1.5 h) 0 "PLATE CONTOUR")
(setq p1 (list (- (car p) (* 2 d)) (- (cadr p) (* 2 h))))
(command "text" "j" "m" p1 h 0 "PT#")
(setq p2 (polar p1 0 (* 1.5 d)))
(command "text" "j" "m" p2 h 0 "X axis")
(setq p3 (polar p2 0 (* 1.5 d)))
(command "text" "j" "m" p3 h 0 "Y axis")
(setq p4 (polar p3 0 (* 1.5 d)))
(command "text" "j" "m" p4 h 0 "NOTES")
(setq k 0)
(foreach pt lstp
(command "text" "j" "m" (polar pt pi 15) h 0 (chr (+ 65 k)))
(setq p11 (polar p1 (- (/ pi 2)) (* 1.5 h (+ 1 k))))
(command "text" "j" "m" p11 h 0 (chr (+ 65 k)))
(setq p22 (polar p11 0 (* 1.5 d)))
(command "text" "j" "m" p22 h 0 (rtos (- (car pt) xc) 2 0))
(setq p33 (polar p22 0 (* 1.5 d)))
(command "text" "j" "m" p33 h 0 (rtos (- (cadr pt) yc) 2 0))
(setq k (1+ k))
)
)
)
(setvar "cecolor" col) 
(setvar "osmode" om )
(setvar "cmdecho" 1)
(command "ucs" "m" pc)
(command "ucsicon" "or")
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
)

 

Có điều khi xài món quà này bác nhớ rằng cái plate contour của bác chắc chắn phải là một LWPOLYLINE bác nhé. Nếu không là bác tự chịu trách nhiệm đó chớ mình hổng có chịu đâu. Tại vì cái bản vẽ bác gửi thì biên dạng tấm là một LWPOLYLINE. Hề hề hề.

Chúc bác luôn khỏe và vui.

Còn cái lisp bác gửi mình chưa gặm xong bác ạ, xem ra cũng nhiều xơ ra phết. Với cái vồn lisp hơi ngắn của mình, gặm nó hơi vất vả một tí bác ạ. Mong bác thông cảm cho mình nhé. Cái lisp này xài nhiều hàm quá mới mẻ đối với mình nên đành phải gặm từ từ thôi bác ạ, không có nó lại giắt răng vào đúng dịp Noel với lị tết Tây tết ta tùm lum thế này thì thiệt thòi lắm lắm. Hề hề hề......

  • 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
Phiphi-    175

Chào bác Thiệp.

Vì Text cũng như Block đã có tên rõ ràng rồi nên PP cần vài đoạn code để bỏ vào trong Lisp. Trong khi sử dụng thì nó sẽ tự động tìm, thay thế và xoá luôn cái Block đó. User không phải làm gì cả.

Vì lý do trên nên phải nhờ Bác giúp đở. Chúc các Bác thật zui zẻ trong đêm giáng sinh tối nay. Cheers!

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

Chào tất cả các anh chi! nhờ các anh chị chỉ dùm cho em cái: em cũng vừa mon men học tập autolisp thôi!

 

Làm so có thể lấy được chiều cao của chữ (đối tượng text) trong bản vẽ. bằng các hàm em cũng đã đưa ra được đó là danh sách có chứa chiều cao VD như (40 . 0.25) đó là danh sách của ename với chiều cao chữ là 0.2, nhưng như hình danh sách (40 . 0.25) lại xảy ra lỗi (bad list) Vậy bây giờ làm sao em có thể lẩy ra số 0.25 này nhỉ! thanks các bác 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
Phiphi-    175
Hề hề hề, bác Phiphi- ơi, có phải bác muốn món quà này không nhỉ???

Mình loay hoay mất một chút mới làm được cái món quà này, hy vọng bác sẽ hài lòng.

Có điều khi xài món quà này bác nhớ rằng cái plate contour của bác chắc chắn phải là một LWPOLYLINE bác nhé. Nếu không là bác tự chịu trách nhiệm đó chớ mình hổng có chịu đâu. Tại vì cái bản vẽ bác gửi thì biên dạng tấm là một LWPOLYLINE. Hề hề hề.

Chúc bác luôn khỏe và vui.

Còn cái lisp bác gửi mình chưa gặm xong bác ạ, xem ra cũng nhiều xơ ra phết. Với cái vồn lisp hơi ngắn của mình, gặm nó hơi vất vả một tí bác ạ. Mong bác thông cảm cho mình nhé. Cái lisp này xài nhiều hàm quá mới mẻ đối với mình nên đành phải gặm từ từ thôi bác ạ, không có nó lại giắt răng vào đúng dịp Noel với lị tết Tây tết ta tùm lum thế này thì thiệt thòi lắm lắm. Hề hề hề......

Quả đúng là 1 món quà Christmas bất ngờ của Santa Claus phamthanhbinh. Your help is very greatly appreciated.

Cám ơn Bác rất nhiều nhé. PP.

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
ohay102    1

Chào các bác! em có một vấn đề này nhờ các bác giúp đỡ. khi em làm hồ sơ hoàn công nền đường đắp việc chia lớp các mặt cắt rất nhiều và lắt nhắt khi nhập và tính toán thủ công vậy nhờ các bác giúp em với, cụ thể như hình:

01.gif

1. click vào 1 điểm rồi nhập toạ độ tương đối của điểm đó ( nhập tay )

2. click vào vùng kín cần chia lớp ( như chọn vẽ mặt cắt) rồi nhập tay chiều dày lớp (30cm)

-> lisp sẽ tự động chia lớp bằng các đưòng line

-> xuất bảng thuộc tính của các đường line ( thứ tự đuờng line | toạ độ( x, y) điểm đầu( so với toạ độ nhập tay) | toạ độ( x, y) điểm cuối | chiều dài line | diện tích miền ( nếu đuợc) |

- > xuất bảng đó ra file .txt

cảm ơn các bác truớc !

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
pbellh    2

Mong các bác giúp dùm em cái này,em cám ơn rất nhiều

em có 1 tập các điểm,mỗi điểm là giao nhau của 2 đoạn pline nhỏ,bây h em muốn scale hết tất cả các đoạn pline đó lên ,tâm scale là mỗi giao điểm đó,các bác có thể giúp em lisp dc ko?Em đã sử dụng 1 lisp ,nhưng nó phải xác định tâm cho mỗi pline,trong khi tập điểm của em rất lớn.Lisp em sử dụng của Tue_NV viết

;; free lisp from cadviet.com

(defun c:scn()

(prompt "\n Moi ban chon cac doi tuong :")

(setq ssg (ssget))

 

(setq tl (getreal "\n Ti le scale :"))

 

(setq n (sslength ssg) i 0)

 

(while (< i n)

(setq sn (ssname ssg i))

(HLI sn)

(setq ent (entget sn))

(setq mp (getpoint "\n Ban chon tam cho doi tuong nay :"))

 

(command "scale" sn "" mp tl)

(setq i (1+ i))

 

)

(princ)

)

;

(defun HLI(ent)

(sssetfirst (ssadd ent (ssadd)) (ssadd ent (ssadd)))

)

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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×