Đến nội dung


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

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


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#581 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 22 December 2009 - 02:08 PM

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 (< i n)
(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 (< j n)
(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 < y or n >: "))
(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ề.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#582 Phiphi-

Phiphi-

    biết lệnh minsert

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

Đã gửi 22 December 2009 - 03:13 PM

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ẻ.
  • 1

#583 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 22 December 2009 - 05:27 PM

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 (< i n)
(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 (< j n)
(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 < y or n >: "))
(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.
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#584 Phiphi-

Phiphi-

    biết lệnh minsert

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

Đã gửi 22 December 2009 - 08:35 PM

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...ps/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.c...pfiles/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.c...o...c=11939&hl=
Thanks you.
  • 1

#585 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 23 December 2009 - 03:45 PM

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...ps/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.c...pfiles/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.c...o...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 (< i n)
(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 (< j n)
(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 < y or n >:

"))
(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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#586 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 23 December 2009 - 05:26 PM

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...ps/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.c...pfiles/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.c...o...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 (< i n)
(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 (< j n)
(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 < y or n >: "))
(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 (< k m)
(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ề.....
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#587 Phiphi-

Phiphi-

    biết lệnh minsert

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

Đã gửi 23 December 2009 - 06:27 PM

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

  • 1

#588 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 24 December 2009 - 08:47 AM

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

  • 1

#589 muoild

muoild

    Chưa sử dụng CAD

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

Đã gửi 24 December 2009 - 09:32 AM

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

#590 trinhvqh

trinhvqh

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 408 Bài viết
Điểm đánh giá: 222 (khá)

Đã gửi 24 December 2009 - 09:36 AM

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ỉ!!!)
  • 0

#591 Phiphi-

Phiphi-

    biết lệnh minsert

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

Đã gửi 24 December 2009 - 12:29 PM

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

#592 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 24 December 2009 - 12:48 PM

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!
  • 1

#593 Phiphi-

Phiphi-

    biết lệnh minsert

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

Đã gửi 24 December 2009 - 01:31 PM

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

#594 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 24 December 2009 - 03:19 PM

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!
  • 1

#595 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 24 December 2009 - 04:04 PM

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 (< i n)
(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 (< j n)
(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 < y or n >:
"))
(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 (< k m)
(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? < y or n >: "))
(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ề......
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#596 Phiphi-

Phiphi-

    biết lệnh minsert

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

Đã gửi 24 December 2009 - 05:05 PM

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

#597 minhthuantp

minhthuantp

    biết pan

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

Đã gửi 24 December 2009 - 05:07 PM

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

#598 Phiphi-

Phiphi-

    biết lệnh minsert

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

Đã gửi 24 December 2009 - 05:23 PM

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

#599 ohay102

ohay102

    biết pan

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

Đã gửi 24 December 2009 - 11:22 PM

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:
Hình đã gửi
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 !
  • 0

#600 pbellh

pbellh

    biết zoom

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

Đã gửi 25 December 2009 - 04:28 AM

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


  • 0