Đến nội dung


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

Viết Lisp theo yêu cầu


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

#2161 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 17 June 2009 - 09:09 PM

Hôm trước mình thấy trên diễn đàn có lệnh sắp xếp text rất hay nhưng chỉ sắp xếp theo lề trái. Bác nào giùp mình "nâng cấp" nó lên thành sắp xếp theo lề trái, lề phải, hay canh giữa tuỳ mình chọn.
Khi mình chạy lisp thì chương trình sẽ hỏi: bạn muốn canh trái, canh phải, hay canh giữa.
Sau đó chọn các text cần sắp xếp, rồi ấn enter. (dòng text tự động sắp xếp theo text trên cùng)
Rồi tiếp tục chọn các text tiếp theo rồi enter.
Ai biết giúp mình với!


Bạn xài cái này thử xem.

(defun tdchen(ent / k eget dchen)
(setq k (cdr (assoc 72 (setq eget (entget ent))))
dchen (if (zerop k)
(cdr (assoc 10 eget))
(cdr (assoc 11 eget)))
)
dchen
)

(defun c:st1 ( / oldos lst1 ss ki ki1 lst ddau dcuoi eget)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq lst1 '(("L" acAlignmentLeft)
("C" acAlignmentCenter)
("R" acAlignmentRight)
("M" acAlignmentMiddle )
("TL" acAlignmentTopLeft)
("TC" acAlignmentTopCenter)
("TR" acAlignmentTopRight)
("ML" acAlignmentMiddleLeft )
("MC" acAlignmentMiddleCenter)
("MR" acAlignmentMiddleRight)
("BL" acAlignmentBottomLeft)
("BC" acAlignmentBottomCenter )
("BR" acAlignmentBottomRight )))

(prompt "Chon Text:")
(setq ss (ssget '((0 . "TEXT"))))

(initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
(setq ki (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
ki1 (eval (cadr (assoc ki lst1)))
lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2))))))
ddau (car (tdchen (car lst)))
)

(command "undo" "begin")
(foreach e lst
(setq eget (entget e)
dcuoi (cons ddau (cdr (tdchen e)))
eget (subst (cons 72 ki1) (assoc 72 eget) eget)
eget (if (zerop ki1)
(subst (cons 10 dcuoi) (assoc 10 eget) eget)
(subst (cons 11 dcuoi) (assoc 11 eget) eget))
)
(entmod eget)
)
(command "undo" "end")
(setvar "osmode" oldos)
(Princ)
)


  • 1

#2162 LeMai

LeMai

    biết vẽ line

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

Đã gửi 17 June 2009 - 10:53 PM

Mình hok bít bạn căn lề để làm gì? Mình thấy khi đánh lệnh T đã hiện ra bảng text formating
có chức năng left, right, top, middle, bottom.
  • 0

#2163 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 17 June 2009 - 11:26 PM

Sorry, mình quên text align có 2 dxf code là 72 và 73. Mình sửa lại như sau.

(defun tdchen(ent / k1 k2 eget dchen)
(setq k1 (cdr (assoc 72 (setq eget (entget ent))))
k2 (cdr (assoc 73 eget ))
dchen (if (and (zerop k1) (zerop k2))
(cdr (assoc 10 eget))
(cdr (assoc 11 eget)))
)
dchen
)

(defun c:st1 ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq lst1 '(("L" 0 0) ("C" 1 0) ("R" 2 0) ("M" 4 0)
("TL" 0 3) ("TC" 1 3) ("TR" 2 3)
("ML" 0 2) ("MC" 1 2) ("MR" 2 2)
("BL" 0 1) ("BC" 1 1) ("BR" 2 1)))

(prompt "Chon Text:")
(setq ss (ssget '((0 . "TEXT"))))

(initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
(setq ki (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
ki1 (cadr (setq ki0 (assoc ki lst1)))
ki2 (last ki0)
lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2))))))
ddau (car (tdchen (car lst)))
)

(command "undo" "begin")
(foreach e lst
(setq eget (entget e)
dcuoi (cons ddau (cdr (tdchen e)))
eget (subst (cons 72 ki1) (assoc 72 eget) eget)
eget (subst (cons 73 ki2) (assoc 73 eget) eget)
eget (if (and (zerop ki1) (zerop ki2))
(subst (cons 10 dcuoi) (assoc 10 eget) eget)
(subst (cons 11 dcuoi) (assoc 11 eget) eget))
)
(entmod eget)
)
(command "undo" "end")
(setvar "osmode" oldos)
(Princ)
)




  • 1

#2164 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 17 June 2009 - 11:32 PM

Mình hok bít bạn căn lề để làm gì? Mình thấy khi đánh lệnh T đã hiện ra bảng text formating
có chức năng left, right, top, middle, bottom.


Nếu bạn cần gióng vài chục chữ cho thẳng hàng thì bạn dùng lệnh gì?
  • 0

#2165 hauhn

hauhn

    Chưa sử dụng CAD

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

Đã gửi 18 June 2009 - 10:37 AM

cảm ơn bạn đã sửa giúp mình. khá ổn rồi đó, mình nhờ bạn chỉnh thêm 1 chút nữa đc ko.
mình muốn nó thực hiện giống cái movet cũ có nghĩa là click chọn text và đọc lấy giá trị của text đó làm giá trị cao độ sẽ nhập cho đường đồng mức ( có nghĩa thay vì nhập tay cao độ vào mình sẽ click chọn cái text có sẵn hoặc nhập tay giá trị này)
mình đã dựa trên lisp bạn chỉnh sửa để sửa thêm 1 chút là cho phép nhập chênh cao thay đổi trong quá trình chọn đường. đã khá ổn rồi bạn à. bạn xem giúp mình nhé , cảm ơn nhiều.

http://www.cadviet.c...s/movet_gdm.rar

Bài viết đã được chỉnh sửa nội dung bởi hauhn: 18 June 2009 - 11:10 AM

  • 0

#2166 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 18 June 2009 - 01:10 PM

cảm ơn bạn đã sửa giúp mình. khá ổn rồi đó, mình nhờ bạn chỉnh thêm 1 chút nữa đc ko.
mình muốn nó thực hiện giống cái movet cũ có nghĩa là click chọn text và đọc lấy giá trị của text đó làm giá trị cao độ sẽ nhập cho đường đồng mức ( có nghĩa thay vì nhập tay cao độ vào mình sẽ click chọn cái text có sẵn hoặc nhập tay giá trị này)
mình đã dựa trên lisp bạn chỉnh sửa để sửa thêm 1 chút là cho phép nhập chênh cao thay đổi trong quá trình chọn đường. đã khá ổn rồi bạn à. bạn xem giúp mình nhé , cảm ơn nhiều.
.....

Chào hauhn
LISP đã cập nhật theo ỵêu cầu của bạn.
Trường hợp bạn chọn TEXT cao độ thì việc nhập độ chênh cao là không cần thiết.
(defun c:GDM (/ ss e ent caodo newVal)
(vl-load-com)
(command "UNDO" "begin")
(if (not (tblsearch "LAYER" "DM_so_hoa"))
(command "-layer" "n" "DM_so_hoa" "c" "1" "DM_so_hoa" "")
)
(while
(and
(princ (strcat "\nChon duong dong muc / Enter de ket thuc"))
(setq ss (ssget (list (cons 0 "*POLYLINE") (cons 8 "~DM_so_hoa"))))
)
(while
(not
(and
(setq ent (car (entsel "\nChon Text cao do : ")))
(if ent (= (cdr (assoc 0 (entget ent))) "TEXT") )
)
)
(princ "\nChon lai : ")
)
(setq caodo (cdr (assoc 1 (entget ent)))
newVal (getreal (strcat "\nNhap cao do <" caodo "> :")) )
(if newVal (setq caodo newVal) (setq caodo (atof caodo)))
(foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (vlax-property-available-p e 'Elevation)
(progn
(vla-put-Elevation e caodo)
(vla-put-Layer e "DM_so_hoa")
)
)
)
)
(command "UNDO" "end")
)

  • 0

#2167 xuantran15

xuantran15

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 295 Bài viết
Điểm đánh giá: 112 (tàm tạm)

Đã gửi 18 June 2009 - 04:06 PM

Chào các bác, :lol2:
Mình có 1 vấn đề cần nhờ các bác. Mình có một đường Polyline với nhiều đoạn cong, tại các đoạn cong có các góc đo khác nhau. Nhờ các bác viết cho mình một cái lisp mà khi thực hiện lệnh thì nó sẽ cho ra kết quả là góc tại điểm gấp khúc và khoảng cách từ điểm đó đến điểm đầu của PL. Mình mô tả cụ thể như sau:

1/ gõ lệnh và enter
2/ pick chọn đối tượng PL
Sau khi chọn đối tượng PL lisp sẽ thực hiện việc tính toán cho n điểm gấp khúc để cho ra kết quả là: n Góc trong (Góc nhỏ hơn) tại chổ gấp khúc trên PL S=AđộB'C", và cho biết khoảng cách từ điểm đó đến điểm đầu của PL là bao nhiêu đơn vị (L=bao nhiêu hoặc Kn+xyz).
3/ Các giá trị tính toán được tự động chèn vào đúng chổ tại điểm gấp khúc trên PL
4/ Kiểu Text, độ lớn text lấy theo Texstyle hiện hành.
Mong được sự giúp đỡ của các bác. :lol2:
http://www.cadviet.c...es/hinh_anh.bmp
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#2168 xinh75

xinh75

    biết pan

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

Đã gửi 18 June 2009 - 04:43 PM

Mình muốn thay các chuỗi text trong bản vẽ
Ví dụ : Nguyễn Văn A thay bằng Trương B
Khối lượng thay bằng Quantity
Chiều dài thay bằng Length
........................................................

Mình muốn lập 1 file lisp như lệnh find của cad

Mỗi lần load đánh lệnh này thì nó sẽ tự động thay các string cũ bằng các string mới được định nghĩa trong file lisp
Module thay string cũ bằng string mới có thể để cuối cùng để có thể định nghĩa thêm các chuỗi mới.

Vì có nhiều bản vẽ nên mình không muốn mỗi lần mở file lại find và copy, paste từng chuỗi 1

Cám ơn các bạn
  • 0

#2169 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 18 June 2009 - 05:23 PM

Bạn xài cái này thử xem.


(defun tdchen(ent / k eget dchen)
(setq k (cdr (assoc 72 (setq eget (entget ent))))
dchen (if (zerop k)
(cdr (assoc 10 eget))
(cdr (assoc 11 eget)))
)
dchen
)

(defun c:st1 ( / oldos lst1 ss ki ki1 lst ddau dcuoi eget)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq lst1 '(("L" acAlignmentLeft)
("C" acAlignmentCenter)
("R" acAlignmentRight)
("M" acAlignmentMiddle )
("TL" acAlignmentTopLeft)
("TC" acAlignmentTopCenter)
("TR" acAlignmentTopRight)
("ML" acAlignmentMiddleLeft )
("MC" acAlignmentMiddleCenter)
("MR" acAlignmentMiddleRight)
("BL" acAlignmentBottomLeft)
("BC" acAlignmentBottomCenter )
("BR" acAlignmentBottomRight )))

(prompt "Chon Text:")
(setq ss (ssget '((0 . "TEXT"))))

(initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
(setq ki (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
ki1 (eval (cadr (assoc ki lst1)))
lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2))))))
ddau (car (tdchen (car lst)))
)

(command "undo" "begin")
(foreach e lst
(setq eget (entget e)
dcuoi (cons ddau (cdr (tdchen e)))
eget (subst (cons 72 ki1) (assoc 72 eget) eget)
eget (if (zerop ki1)
(subst (cons 10 dcuoi) (assoc 10 eget) eget)
(subst (cons 11 dcuoi) (assoc 11 eget) eget))
)
(entmod eget)
)
(command "undo" "end")
(setvar "osmode" oldos)
(Princ)
)

Nhờ Bác q288 kết hợp Lisp dưới đây với Lisp trên. Tkx.
(defun c:stext (/ sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)
(if (not tyledong)
(setq tyledong 1.5)
)
(princ "\nSap xep text © CADViet.com")
(setq sst (ssget '((0 . "TEXT")))
lstent (ss2ent sst)
tmp (getreal (strcat "\nVao ty le dong khoang cach dong <"
(rtos tyledong 2 2)
">: "
)
)
tyledong (cond
(tmp tmp)
(t tyledong)
)
lstent (vl-sort lstent
'(lambda (e1 e2)
(> (cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 10 (entget e2))))
)
)
)
egoc (car lstent)
lstent (cdr lstent)
pgoc (cdr (assoc 10 (entget egoc)))
xgoc (car pgoc)
yht (cadr pgoc)
zgoc (caddr pgoc)
hgoc (cdr (assoc 40 (entget egoc)))
linespc (* hgoc (+ 1.0 tyledong))

)
(foreach ee lstent
(setq tt (entget ee)
tt (subst (list 10
xgoc
(setq yht (- yht linespc))
zgoc
)
(assoc 10 tt)
tt
)
)
(entmod tt)
(entupd ee)
)
(princ)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ
"\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)

  • 0

#2170 q288

q288

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 209 Bài viết
Điểm đánh giá: 164 (tàm tạm)

Đã gửi 18 June 2009 - 07:09 PM

Nhờ Bác q288 kết hợp Lisp dưới đây với Lisp trên. Tkx.


Kết hợp như dưới đây.

(defun c:st1 ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)

(prompt "Chon Text:")
(setq ss (ssget '((0 . "TEXT"))))

(if (not tyledong) (setq tyledong 1.5))
(setq tyledong1 (getreal (strcat "\nVao ty le dong khoang cach dong <"
(rtos tyledong 2 2) ">: ")))
(if tyledong1 (setq tyledong tyledong1))

(setq lst1 '(("L" 0 0) ("C" 1 0) ("R" 2 0) ("M" 4 0)
("TL" 0 3) ("TC" 1 3) ("TR" 2 3)
("ML" 0 2) ("MC" 1 2) ("MR" 2 2)
("BL" 0 1) ("BC" 1 1) ("BR" 2 1)))

(initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
(setq ki (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
ki1 (cadr (setq ki0 (assoc ki lst1)))
ki2 (last ki0)
lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2))))))
vt (cdr (assoc 10 (entget (car lst))))
yht (cadr vt)
linespc (* (cdr (assoc 40 (entget (car lst)))) tyledong)
)

(command "undo" "begin")
(foreach e lst
(setq eget (entget e)
dtiep (list (car vt) (setq yht (- yht linespc)) 0)
eget (subst (cons 72 ki1) (assoc 72 eget) eget)
eget (subst (cons 73 ki2) (assoc 73 eget) eget)
eget (if (and (zerop ki1) (zerop ki2))
(subst (cons 10 dtiep) (assoc 10 eget) eget)
(subst (cons 11 dtiep) (assoc 11 eget) eget))
)
(entmod eget)
)
(command "undo" "end")
(setvar "osmode" oldos)
(Princ)
)

  • 2

#2171 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 18 June 2009 - 08:07 PM

Chào các bác, :lol2:
Mình có 1 vấn đề cần nhờ các bác. Mình có một đường Polyline với nhiều đoạn cong, tại các đoạn cong có các góc đo khác nhau. Nhờ các bác viết cho mình một cái lisp mà khi thực hiện lệnh thì nó sẽ cho ra kết quả là góc tại điểm gấp khúc và khoảng cách từ điểm đó đến điểm đầu của PL. Mình mô tả cụ thể như sau:

1/ gõ lệnh và enter
2/ pick chọn đối tượng PL
Sau khi chọn đối tượng PL lisp sẽ thực hiện việc tính toán cho n điểm gấp khúc để cho ra kết quả là: n Góc trong (Góc nhỏ hơn) tại chổ gấp khúc trên PL S=AđộB'C", và cho biết khoảng cách từ điểm đó đến điểm đầu của PL là bao nhiêu đơn vị (L=bao nhiêu hoặc Kn+xyz).
3/ Các giá trị tính toán được tự động chèn vào đúng chổ tại điểm gấp khúc trên PL
4/ Kiểu Text, độ lớn text lấy theo Texstyle hiện hành.
Mong được sự giúp đỡ của các bác. :lol2:
http://www.cadviet.c...es/hinh_anh.bmp

Chào xuantran
Vấn đề tính góc thì có lẽ không có vấn đề gì
Nhưng vấn đề ghi chữ thì bạn đã đặt ra trường hợp tổng quát chưa?
Trong hình vẽ mà bạn upload thì Pline trải dọc theo Ox, chữ viết hình như là theo quy luật // Ox

Bạn đã đặt một trường hợp tổng quát là các phân đoạn của Pline nằm nghiêng 1 góc bất kì so với trục Ox chưa?
Như vậy chữ viết sẽ phải viết theo quy luật nào nhỉ?
Bạn đưa ra 1 cái ý thật tổng quát cho bài toán của bạn
Mọi người sẽ giúp bạn
  • 1

#2172 xuantran15

xuantran15

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 295 Bài viết
Điểm đánh giá: 112 (tàm tạm)

Đã gửi 18 June 2009 - 10:43 PM

Chào bác Tue_nv.
Thực ra đây là 1 công đoạn khi tính toán và vẽ sơ họa tuyến, mình nhờ mọi người viết lisp này để tiết kiệm thời gian cho công đoạn này (Vì đối với 1 tuyến Kênh trong TLợi hay thủy điện rất dài và việc làm thủ công khá mất tg). Đây coi như là bước trung gian để lấy số liệu đưa vào sơ họa tuyến, vì thế Bác cứ cho các Text //OX là tốt rồi. Có điều bác cứ cho số đo góc chính xác đến giây nhé, còn việc đo chiều dài từ điểm gấp khúc đến điểm đâu nếu viết theo dạng K?+??? hơi khó thì bác thay băng L=???,?? . Cám ơn bác nhiều :lol2:
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#2173 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 19 June 2009 - 07:07 AM

Kết hợp như dưới đây.


(defun c:st1 ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)

(prompt "Chon Text:")
(setq ss (ssget '((0 . "TEXT"))))

(if (not tyledong) (setq tyledong 1.5))
(setq tyledong1 (getreal (strcat "\nVao ty le dong khoang cach dong <"
(rtos tyledong 2 2) ">: ")))
(if tyledong1 (setq tyledong tyledong1))

(setq lst1 '(("L" 0 0) ("C" 1 0) ("R" 2 0) ("M" 4 0)
("TL" 0 3) ("TC" 1 3) ("TR" 2 3)
("ML" 0 2) ("MC" 1 2) ("MR" 2 2)
("BL" 0 1) ("BC" 1 1) ("BR" 2 1)))

(initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
(setq ki (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
ki1 (cadr (setq ki0 (assoc ki lst1)))
ki2 (last ki0)
lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2))))))
vt (cdr (assoc 10 (entget (car lst))))
yht (cadr vt)
linespc (* (cdr (assoc 40 (entget (car lst)))) tyledong)
)

(command "undo" "begin")
(foreach e lst
(setq eget (entget e)
dtiep (list (car vt) (setq yht (- yht linespc)) 0)
eget (subst (cons 72 ki1) (assoc 72 eget) eget)
eget (subst (cons 73 ki2) (assoc 73 eget) eget)
eget (if (and (zerop ki1) (zerop ki2))
(subst (cons 10 dtiep) (assoc 10 eget) eget)
(subst (cons 11 dtiep) (assoc 11 eget) eget))
)
(entmod eget)
)
(command "undo" "end")
(setvar "osmode" oldos)
(Princ)
)

Trên cả mức tuyệt vời.
Cám ơn bác q288 thật nhiều
  • 0

#2174 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 19 June 2009 - 07:56 AM

Chào bác Tue_nv.
Thực ra đây là 1 công đoạn khi tính toán và vẽ sơ họa tuyến, mình nhờ mọi người viết lisp này để tiết kiệm thời gian cho công đoạn này (Vì đối với 1 tuyến Kênh trong TLợi hay thủy điện rất dài và việc làm thủ công khá mất tg). Đây coi như là bước trung gian để lấy số liệu đưa vào sơ họa tuyến, vì thế Bác cứ cho các Text //OX là tốt rồi. Có điều bác cứ cho số đo góc chính xác đến giây nhé, còn việc đo chiều dài từ điểm gấp khúc đến điểm đâu nếu viết theo dạng K?+??? hơi khó thì bác thay băng L=???,?? . Cám ơn bác nhiều :lol2:

Chào bạn xuantran
việc đo chiều dài từ điểm gấp khúc đến điểm đâu nếu viết theo dạng K?+??? thì cũng không khó, chỉ cần bạn nói ra quy luật của nó.
Ở đây Tue_NV viết L= tính từ điiêrm đầu PLine đến điểm đang xét
Bạn chạy thử nhé :

(defun c:ggoc(/ oldos curve cao ddau ddau1 pre i diem1 diem2 gocA gocB gocC
do dotinh phut giay diemchen1 diemchen2 diemchen10 chuoido L)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq curve (car(entsel "\n Chon Polyline :")))
(setq cao (getdist "\n Nhap chieu cao chu :"))
(setq ddau (vlax-curve-getStartPoint curve) i 1)
(setq ddau1 ddau)
(setq pre (vlax-curve-getEndParam curve))

(while (< i pre)

(setq diem1 (vlax-curve-getPointAtParam curve i))
(setq diem2 (vlax-curve-getPointAtParam curve (1+ i)))
(setq gocA (/ (* (gg ddau diem1) 180) pi))
(setq gocB (/ (* (gg diem1 diem2) 180) pi))
(setq gocC (- 180 gocA gocB))

(setq do (fix gocC))

(setq dotinh (* (- gocC do) 3600))
(setq phut (fix (/ dotinh 60)))
(setq giay (fix (rem dotinh 60)))

(if (> (cadr diem1) (cadr diem2))
(progn
(setq diemchen1 (list (car diem1) (+ (cadr diem1) (* 3.0 cao)) 0))
(setq diemchen2 (list (car diem1) (+ (cadr diem1) (* 1.5 cao)) 0))
)
(progn
(setq diemchen1 (list (car diem1) (- (cadr diem1) (* 1.5 cao)) 0))
(setq diemchen2 (list (car diem1) (- (cadr diem1) (* 3.0 cao)) 0))
)
)
(setq chuoido (strcat (rtos do 2 0) "do" (rtos phut 2 0) "'" (rtos giay 2 0) "''"))
(setq L (vlax-curve-getDistAtPoint curve diem1))

(command "style" "" "" "0" "1" "0" "n" "n")
(command "text" "j" "MC" diemchen1 cao "0" chuoido)
(command "text" "j" "MC" diemchen2 cao "0" (strcat "L = " (rtos L 2 0)))

(setq i (1+ i))
(setq ddau diem1)
)
(setq diemchen10 (list (car ddau1) (- (cadr ddau1) (* 1.5 cao)) 0))
(command "text" "j" "MC" diemchen10 cao "0" (strcat "L = " (rtos (vlax-curve-getDistAtPoint curve ddau1) 2 0)))
(setvar "osmode" oldos)
(command "undo" "end")
(princ)
)
;
;
(defun gg(p1 p2)
(setq ang (angle p1 p2))
(while (> ang (/ pi 2))
(setq ang (- ang pi))
)
(abs ang)
)

Đã chỉnh sửa

Bài viết đã được chỉnh sửa nội dung bởi Tue_NV: 19 June 2009 - 08:13 AM

  • 1

#2175 ph168xd

ph168xd

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 779 Bài viết
Điểm đánh giá: 309 (khá)

Đã gửi 19 June 2009 - 08:57 AM

Số lượng câu hỏi cũng như câu trả lời nhiều quá
Nên mình không biết tìm ở đâu

Mình đang cần lish
đưa các pline thẳng hàng nhau thành 1 pline
và lish
Nhập tỷ lệ Standard Scale của khung viewport bên layout bằng bàn phím
Thanks mng nhiều

Xin hỏi luôn, có cách nào insert 1 hình chữ nhật không phải block vào bản vẽ hay không
  • 0

#2176 xuantran15

xuantran15

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 295 Bài viết
Điểm đánh giá: 112 (tàm tạm)

Đã gửi 19 June 2009 - 09:50 AM

Chào bạn xuantran
việc đo chiều dài từ điểm gấp khúc đến điểm đâu nếu viết theo dạng K?+??? thì cũng không khó, chỉ cần bạn nói ra quy luật của nó.
Ở đây Tue_NV viết L= tính từ điiêrm đầu PLine đến điểm đang xét

Trước tiên cám ơn bác đã nhiệt tình giúp đỡ. :lol2:

Khi mình test lisp của bác thì xảy ra một số lỗi. Các lỗi này mình sẽ nói rõ trong file test lisp dưới đây.
File kiem tra lisp

P/S: Ngoài ra nó còn có thêm lỗi này nữa bác:
Command: ggoc

Chon Polyline :
Nhap chieu cao chu :2

Yes or No, please.
; error: Function cancelled
Vertical?

"style1" is now the current text style.
Bác vào xem và sửa lại giúp mình chút nhé. :lol2:
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#2177 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 19 June 2009 - 11:19 AM

Hôm nay em mạn phép xin các Bác chỉnh sửa giúp em đoạn lisp có trên diễn đàn cadviet một chút để phù hợp với công việc của em hơn. Thank các Bác trước.

- Đoạn lisp 1 của Bác SSG dùng để vẽ bảng Toạ Độ Góc Ranh có lệnh : vc

---Yêu cầu 1: thêm hình tròn có tô hatch tại các đỉnh ( nếu được thì mong Bác có thể cho người dùng nhập đường kính vòng tròn)
---Yêu cầu 2: chuyển lại font chữ giũa kích thước và số TT ( số TT cho font chữ nghiêng và kích thước cho font chữ thẳng và tô đậm)
---Yêu cầu 3: mong Bác có thể cho người dùng được chọn save lại hay không save lại bảng TĐGR ngay tại thư mục đã mở bản vẽ ra bằng file excel từng cột để cần thì có thể phục vụ cho công tác sau này.
Dưới đây là đường link file mẫu:

http://www.cadviet.c...files/Mau_2.dwg

- Đoạn lisp 2 em không nhớ không lầm là của Bác PNQ Duy dùng để đưa các đối tượng từ bản vẽ 3D về 2D có lệnh: ve0

---Yêu cầu: các đối tượng có chiều cao z thì được dời sang trục x hay y 1 khoảng cách mà người thực hiện nhập số vào
Dưới đây là đường link file mẫu:

http://www.cadviet.c...les/Mau_2_2.dwg

Mong nhận được sự hồi âm sớm của các Bác. một lần nữa xin cá mơn các Bác, nếu có gì sai xót xin các Bác thông cảm bỏ qua
  • 0

#2178 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 19 June 2009 - 11:24 AM

- Đoạn lisp 2 em không nhớ không lầm là của Bác PNQ Duy dùng để đưa các đối tượng từ bản vẽ 3D về 2D có lệnh: ve0

Bạn nhớ lầm rồi cái lisp ve0 là của bác nguyenhoanh nếu mình có dính líu vào thì chắc là mình chỉ chổ cho bạn load về thôi!
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#2179 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 19 June 2009 - 12:00 PM

các bác nào có lisp tính diện tích HATCH được ko vậy?
  • 0

#2180 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 19 June 2009 - 12:17 PM

Hix, cho em xin được đính chính lại là lisp ve0 là của bác Nguyen Hoanh, em mới đọc lại, xin Bác tha lỗi .!
  • 0