Viết Lisp theo yêu cầu

[congdung04 0]

Bạn search chữ MPLOT trên diễn đàn CADViet

cảm ơn các đai ca nhiều nhiều

[nh0ckut3_t0cv4mgh03 0]

Cảm ơn Bác nhiều, nhưng bác có thể hướng dẫn cụ thể hơn cho em được không ? Em đã làm như bác nói nhưng vãn không được và báo như sau :

 

Unable to execute "geom3d.arx".

 

Error: ARXLOAD failed.*Cancel*

Em muốn sửa lênh này bởi vì em hay phải copy đối tượng từ bản vẽ này sang bản vẽ kia.

Đoạn mã này :(Defun c:3 (/ ss1)(setq ss1 (ssget))(command "ALIGN" ss1 "" pause "" pause pause "" pause "" "Y" ""))

em vẫn dùng được các đời cad ngoại trừ cadR14 (công ty em chỉ dùng cad14 thui).

Bác giúp em nhé.

Bác Hoành ơi bác không giúp em à ?

Bác Hoành ơi bác không giúp em à ?

Bác Hoành ơi bác không giúp em à ?

Bác Hoành ơi bác không giúp em à ?

[Nguyen Hoanh 4664]

Bác Hoành ơi bác không giúp em à ?

Bác Hoành ơi bác không giúp em à ?

Bác Hoành ơi bác không giúp em à ?

Bác Hoành ơi bác không giúp em à ?

Bó tay,

 

Ngoài cách thêm dòng (arxload "geom3d.arx") tôi không có cách nào khác!

[duy782006 1572]

Bó tay,

 

Ngoài cách thêm dòng (arxload "geom3d.arx") tôi không có cách nào khác!

Có 1 cách giải thích thế này: CAD14 của bạn đó không có phần BONUS

[ssg 1102]

Bác hoành giúp em cái dc không.

1. Chọn 1 Pline

2. Tính khoảng cách giữa các đỉnh của Pline vừa chọn

3. Ghi khoảng cách giữa các đỉnh đó vào giữa các đỉnh của Pline vừa chọn.

Em đang cần quá mà làm mãi không đc. Bác cố gắng giúp em cái.

Bạn dùng lisp này, tên lệnh DC (đo cạnh):

;;;-------------------------------------------------------------
(defun Etype (e) (cdr (assoc 0 (entget e)))) ;;;Entity type
;;;-------------------------------------------------------------
(defun GetMid(p1 p2) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2))) ;;;Midpoint
;;;-------------------------------------------------------------
(defun getVert (e / i L) ;;;Return vertexs list of pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
   (setq L (append L (list (vlax-curve-getPointAtParam e i))))
   (setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------
(defun wtxtpa (txt p a vj hj / sty d h LV vcode LH hcode)
;;;Write text. Arguments: txt, point, angle, ver justify, hor justify
(setq
   sty (getvar "textstyle")
   d (tblsearch "style" sty)
   h (cdr (assoc 40 d))
   LV (list "" "B" "M" "T") ;;;Bottom, Middle, Top
   vcode (vl-position vj LV)
   LH (list "L" "C" "R")  ;;;Left, Center, Right
   hcode (vl-position hj LH)
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
   (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
   (cons 40 h) (assoc 41 d) (cons 72 hcode) (cons 73 vcode) (cons 50 a))
)
)
;;;-------------------------------------------------------------
(defun C:DC( / e Lp i p1 p2 L p a) ;;;Do Canh pline
(setq e (car (entsel "\nSelect polyline:")))
(if (/= (etype e) "LWPOLYLINE") (progn (alert "Object is not a polyline!") (exit)))
(setq Lp (getVert e) i 0)
(repeat (- (length Lp) 1)
   (setq
       p1 (nth i Lp)
       p2 (nth (1+ i) Lp)
       L (distance p1 p2)
       p (getmid p1 p2)
       a (angle p1 p2)
       i (1+ i)  
   )
   (if (and (> a (* 0.5 pi)) (< a (* 1.5 pi))) (setq a (+ a pi)))
   (wtxtpa (rtos L) p a "B" "C")
)
(princ)
)
;;;-------------------------------------------------------------

[dotracchien 0]

Bạn muốn kết quả là đường LWPOLINE hay Spline?

Em đang cần vẽ đường EpyCycloid và hypoCycloid

http://en.wikipedia.org/wiki/Epicycloid

http://en.wikipedia.org/wiki/Hypocycloid

để vẽ biên dạng răng Cycloid ăn khớp trong

Bác Hoành hôm trước có hỏi là kết quả là đường Spline dc ko,Em xin bác giúp đỡ với Spline là tốt quá rồi

Xin bác SSG cũng lưu tâm giúp em 1 tý, bác có cái tài liệu nào về bánh răng Cycloid thì xin shảe cho em với, cái này khó kiếm quá

Cám ơn các bác.

Em có đoạn CODE vẽ với kết quả là đường gấp khúc nhưng bị lỗi. em không hiểu sao nữa, mong các bác chỉ cho, nếu chuyển qua được kếp quả dạng đường cong thì tôt quá.

(defun C:EP ()

(Alert "Duong EP")

(setq R(Getreal R "\n Nhap R"))

(setq a(Getreal a "\n Nhap a"))

(setq t 0)

(setq x 0)

(setq y 0)

(setq m1 (list R 0))

(command "circle" (list 0 0) R)

(Whie (<=t (* 2 pi))

(setq x (-(*(+ R a) (cos t)) (*( cos (*(/(+ a R) a) t) a)))

(setq y (-(*(+ R a) (sin t)) (*( sin (*(/(+ a R) a) t) a)))

(setq m2 (list x y))

(command "line" m1 m2 "")

(command "delay" 50)

(setq m1 m2)

(setq t (+ t 0.01))

)

)

tập hợp điểm này xác định hteo góc t theo công thức

x = (R-r)cost + rcos((r-R)t/r)

y = (R-r)sint + rsin((a-R)t/r)

nhưng em thấy cái này lỗi lắm

[namng 0]

Cám ơn Bác ssq và các bác rất nhiều.

[Nguyen Hoanh 4664]

Em đang cần vẽ đường EpyCycloid và hypoCycloid

http://en.wikipedia.org/wiki/Epicycloid

http://en.wikipedia.org/wiki/Hypocycloid

để vẽ biên dạng răng Cycloid ăn khớp trong

Bác Hoành hôm trước có hỏi là kết quả là đường Spline dc ko,Em xin bác giúp đỡ với Spline là tốt quá rồi

Xin bác SSG cũng lưu tâm giúp em 1 tý, bác có cái tài liệu nào về bánh răng Cycloid thì xin shảe cho em với, cái này khó kiếm quá

Cám ơn các bác.

Em có đoạn CODE vẽ với kết quả là đường gấp khúc nhưng bị lỗi. em không hiểu sao nữa, mong các bác chỉ cho, nếu chuyển qua được kếp quả dạng đường cong thì tôt quá.

(defun C:EP ()

(alert "Duong EP")

(setq R(Getreal R "\n Nhap R"))

(setq a(Getreal a "\n Nhap a"))

(setq t 0)

(setq x 0)

(setq y 0)

(setq m1 (list R 0))

(command "circle" (list 0 0) R)

(Whie (

(setq x (-(*(+ R a) (cos t)) (*( cos (*(/(+ a R) a) t) a)))

(setq y (-(*(+ R a) (sin t)) (*( sin (*(/(+ a R) a) t) a)))

(setq m2 (list x y))

(command "line" m1 m2 "")

(command "delay" 50)

(setq m1 m2)

(setq t (+ t 0.01))

)

)

tập hợp điểm này xác định hteo góc t theo công thức

x = (R-r)cost + rcos((r-R)t/r)

y = (R-r)sint + rsin((a-R)t/r)

nhưng em thấy cái này lỗi lắm

Đoạn lisp trên không chạy được (chứ không phải chạy lỗi).

 

Tôi đã sửa lại để lisp chạy được, chắc là đúng ý bạn (vì là đoạn lisp của bạn mà!):

(defun C:EP ()
 (alert "Duong EP")
 (setq R (Getreal "\n Nhap R"))
 (setq a (Getreal "\n Nhap a"))
 (setq ti 0)
 (setq x 0)
 (setq y 0)
 (setq m1 (list R 0))
 (luuos)
 (setvar "osmode" 0)
 (command "circle" (list 0 0) R)
 (While (    (setq x (- (* (+ R a) (cos ti)) (* (cos (* (/ (+ a R) a) ti)) a)))
   (setq
     y	(- (* (+ R a) (sin ti)) (* (sin (* (/ (+ a R) a) ti)) a))
   )
   (setq m2 (list x y))
   (command "line" m1 m2 "")
   (setq m1 m2)
   (setq ti (+ ti 0.01))
 )
 (traos)
)

(defun luuos ()
 (setq
   old_OSMODE   (getvar "OSMODE")
   old_AUTOSNAP (getvar "AUTOSNAP")
 )
)


(defun traos ()
 (if old_OSMODE
   (setvar "OSMODE" old_OSMODE)
 )
 (if old_AUTOSNAP
   (setvar "AUTOSNAP" old_AUTOSNAP)
 )
)

[dotracchien 0]

Đoạn lisp trên không chạy được (chứ không phải chạy lỗi).

 

Tôi đã sửa lại để lisp chạy được, chắc là đúng ý bạn (vì là đoạn lisp của bạn mà!):

(defun C:EP ()
 (Alert "Duong EP")
 (setq R (Getreal "\n Nhap R"))
 (setq a (Getreal "\n Nhap a"))
 (setq ti 0)
 (setq x 0)
 (setq y 0)
 (setq m1 (list R 0))
 (luuos)
 (setvar "osmode" 0)
 (command "circle" (list 0 0) R)
 (While (<= ti (* 2 pi))
   (setq x (- (* (+ R a) (cos ti)) (* (cos (* (/ (+ a R) a) ti)) a)))
   (setq
     y	(- (* (+ R a) (sin ti)) (* (sin (* (/ (+ a R) a) ti)) a))
   )
   (setq m2 (list x y))
   (command "line" m1 m2 "")
   (setq m1 m2)
   (setq ti (+ ti 0.01))
 )
 (traos)
)

(defun luuos ()
 (setq
   old_OSMODE   (getvar "OSMODE")
   old_AUTOSNAP (getvar "AUTOSNAP")
 )
)


(defun traos ()
 (if old_OSMODE
   (setvar "OSMODE" old_OSMODE)
 )
 (if old_AUTOSNAP
   (setvar "AUTOSNAP" old_AUTOSNAP)
 )
)

Xin cám ơn bác hoành nhiều lắm.em vừa down về và xài thử thấy chạy tốt quá. Em sẽ dựa vào đó để viêt tiếp cái hypocycloid. Viết xong em sẽ pót lên bác coi có sai xót gì sửa giúp em với nhé.tại mới làm quen với líp nên nhiều cái chưa biết quá.

[Sony2007 86]

Chèn đường dẫn file vào bản vẽ trước khi in"

Trước đây có lisp là chèn đường dẫn file vào bản vẽ. Nhưng cái đó cũng hơi bất tiện nếu quên chưa chèn đường dẫn vào. Hoặc đường dẫn cũ đã có nhưng không cập nhật lại mới (nó không tự động cập nhật như trong word hoặc excel). Bài toán đặt ra là cứ mỗi lần ấn lệnh in ấn hoặc ctrl+P thì nó tự chèn đường dẫn vào góc dưới bên phải bản vẽ và yêu cầu người dùng nhập vào chiều cao của dòng chữ này. Sau đó tự động thực hiện tiếp các công tác in ấn. Sau khi in xong nó tự động xoá luôn đường dẫn đã chèn vào trước khi in ấn. Liệu AutoLisp có thể thực hiện được việc này không ạ ? Bác nào biết chỉ giúp em với. Vì việc này rất hữu ích và nhiều người rất cần. Cám ơn các bác trước nhé

[ssg 1102]

Chèn đường dẫn file vào bản vẽ trước khi in"

Trước đây có lisp là chèn đường dẫn file vào bản vẽ. Nhưng cái đó cũng hơi bất tiện nếu quên chưa chèn đường dẫn vào. Hoặc đường dẫn cũ đã có nhưng không cập nhật lại mới (nó không tự động cập nhật như trong word hoặc excel). Bài toán đặt ra là cứ mỗi lần ấn lệnh in ấn hoặc ctrl+P thì nó tự chèn đường dẫn vào góc dưới bên phải bản vẽ và yêu cầu người dùng nhập vào chiều cao của dòng chữ này. Sau đó tự động thực hiện tiếp các công tác in ấn. Sau khi in xong nó tự động xoá luôn đường dẫn đã chèn vào trước khi in ấn. Liệu AutoLisp có thể thực hiện được việc này không ạ ? Bác nào biết chỉ giúp em với. Vì việc này rất hữu ích và nhiều người rất cần. Cám ơn các bác trước nhé

Bạn tìm hiểu lệnh plotstamp, có những cái vượt xa yêu cầu của bạn, chẳng cần lisp liếc gì!

[ccc123 0]

giúp e các bác nhé.

http://www.cadviet.com/upfiles/A.lsp

[ditimbantot 0]

bạn ơi có thể giúp mình sửa file lisp này được không vậy

<a href="http://www.cadviet.com/upfiles/laytoado.lsp.txt" target="_blank">http://www.cadviet.com/upfiles/laytoado.lsp.txt</a>

Mình lấy tọa độ từ thửa đất vì chạy ra số chẵn (tọa độ chẵn) xxx,xx nên diện tích thửa đất khi nhập tọa độ lại lệnh chút ít diện tích , ví dụ tọa độ khi vẽ là 300 M vuông có tọa độ pline là xxx.xxxx khi xuất ra bảng tọa độ thửa đất vừa nhập chỉ lấy xxx.xx mà thôi nên tọa độ lệch chút ít thí dụ còn 289m vuông bạn có cách nào khắc phục mà tọa độ vẫn là xxx.xx không giúp mình sửa cái nha thanks nhiều, lệnh là nth (chỉ phần này thôi)

[ccc123 0]

Bạn có thể post yêu cầu về autolisp ở topic này.

A viết hộ em lisp này với.

1. pick vào đường polyline.

2. Insert block "a" vào.

3. Tên ô thay đổi theo lần pick (A1, A2, ....)

4. Chèn diện tích vào ô tròn (DT).

5. MDXD = 40

6. TCTB = 107. SHSD = MDXD*DT*TCTB

Cảm ơn a rất nhiều!

 

http://www.cadviet.com/upfiles/TK.dwg

[duy782006 1572]

Nhờ các bác viết giúp tôi đoạn này với:

-Tôi có chuổi noidungtim và file c:\duy\filetim.txt

-Cần đọc filetim.txt từng dòng 1 khi có nội dung trùng với noidungtim thì dừng lại báo ra số thứ tự của dòng. Nếu đọc hết file mà không có thì báo ra là không tìm thấy. (hình thức báo ra thì tùy các bác).

[vinataba 3]

Trên diễn đàn đã có đoạn list nối các điểm chèn text bằng các đoạn thẳng. Trên cơ sở ý tưởng đó các Bác sửa cải tiến lại giúp em lệnh Copy 1 đối tượng có sãn vào các điểm chèn text.

Trên màn hình có các đối tượng là text có ghi các mã điểm (mã điểm có thể định dạng theo: 001, 002, 003 hoặc 1), 2), 3) .v. .v.)

Tiện ích sẽ thực hiện: khi chọn các text ghi các mã điểm này, lọc các text trong cùng một layer, hỏi mã điểm sau đó chọn 1 đối tượng và copy đối tượng này vào các điểm chèn của text thứ tự của người sử dụng nhập vào

ví dụ: người sử dụng type tại dòng command : nối điểm 001,002,003 . chọn đối tượng cần copy, chọn base point, sau đó nó sẽ copy đối tượng được chọn vào các điểm 001,002,003.

Cái này em dùng để làm hoàn công vị trí cọc đóng, cọc khoan...từ file số liệu đo của các bác trắc địa. Mỗi lần phải ngồi copy vài trăm cọc, mà các cọc lại có tiết diện khác nhau nên phải tìm vị trí của nó trên bản vẽ cũng rất mất công.

Thanks các bác nhiều.

[ssg 1102]

Nhờ các bác viết giúp tôi đoạn này với:

-Tôi có chuổi noidungtim và file c:\duy\filetim.txt

-Cần đọc filetim.txt từng dòng 1 khi có nội dung trùng với noidungtim thì dừng lại báo ra số thứ tự của dòng. Nếu đọc hết file mà không có thì báo ra là không tìm thấy. (hình thức báo ra thì tùy các bác).

Bạn thử xem:

(defun C:FINDTXT( / txt fn f i OK f KQ)
(setq
   txt (getstring "\nInput text:" T)
   fn (getfiled "Select File" "" "txt" 0)
   f (open fn "r")
   i 0
   OK nil
)
(while (and (not OK) (setq S (read-line f)))
   (setq i (1+ i))
   (if (vl-string-search txt S) (setq OK T))
)
(close f)
(if OK (setq KQ (strcat "Tim thay tai dong " (itoa i))) (setq KQ "Khong tim thay!"))
(alert KQ)
)

[duy782006 1572]

Bạn thử xem:

(defun C:FINDTXT( / txt fn f i OK f KQ)
(setq
   txt (getstring "\nInput text:" T)
   fn (getfiled "Select File" "" "txt" 0)
   f (open fn "r")
   i 0
   OK nil
)
(while (and (not OK) (setq S (read-line f)))
   (setq i (1+ i))
   (if (vl-string-search txt S) (setq OK T))
)
(close f)
(if OK (setq KQ (strcat "Tim thay tai dong " (itoa i))) (setq KQ "Khong tim thay!"))
(alert KQ)
)

 

Cảm ơn bác nhưng bác có cách nào không dùng hàm vl- không. cái cad14 của tôi nó không cahỵ được mấy cái này

[Nộ Thiên 133]

Cảm ơn bác nhưng bác có cách nào không dùng hàm vl- không. cái cad14 của tôi nó không cahỵ được mấy cái này

Thật ra chỉ cần thay "vl-string-search" # "=" là c hính xác với yêu cầu của duy782006 (vì Bác ấy muốn so sánh cả dòng text mà)

[ssg 1102]

Cảm ơn bác nhưng bác có cách nào không dùng hàm vl- không. cái cad14 của tôi nó không cahỵ được mấy cái này

Bạn có thể thay dòng:

(if (vl-string-search txt S) (setq OK T))

Bằng:

(if (wcmatch S (strcat "*" txt "*")) (setq OK T))

 

Còn nếu ý bạn là so sánh string đã cho với cả dòng trong file thì làm đơn giản như bạn Nộ Thiên đã nêu.

[thiennvpecc1 3]

Bác HOANH giúp em cái LISP vẽ mặt cắt ngang twf bình đồ được không?

Thông số đầu vào:

- Có một bình đồ đã gán cao độ Z (đuờng đồng mức là đường pline)

- Một mặt cắt (đường line or pline)

Kết quả:

Vẽ mặt cắt ngang ra màn hình

Bác giúp em nha

[Nguyen Hoanh 4664]

Bác HOANH giúp em cái LISP vẽ mặt cắt ngang twf bình đồ được không?

Thông số đầu vào:

- Có một bình đồ đã gán cao độ Z (đuờng đồng mức là đường pline)

- Một mặt cắt (đường line or pline)

Kết quả:

Vẽ mặt cắt ngang ra màn hình

Bác giúp em nha

Đã có rồi, bạn xem ở đây: http://www.cadviet.com/forum/xin-lisp-ve-m...nh-do-t812.html

[thaivanminhkts 1]

hay quá cảm ơn nhiều nhe ! :cheers:

[h2c 1]

Anh Hoành có thể giúp em cái lisp để vẽ giao tuyến của 2 hình trụ bất kỳ được không . Nhiều lúc em phải ngồi gióng gióng mệt quá . Hay anh nêu hướng giải quyết trước để em cố thử coding , cám ơn anh nhiều .

[Nộ Thiên 133]

Anh Hoành có thể giúp em cái lisp để vẽ giao tuyến của 2 hình trụ bất kỳ được không . Nhiều lúc em phải ngồi gióng gióng mệt quá . Hay anh nêu hướng giải quyết trước để em cố thử coding , cám ơn anh nhiều .

Cái hình như dùng trong cơ khí. Công dụng là in ra giấy (hình như nó có dang đường sin) rồi cuốn quanh ống để lấy dấu, rồi cắt ống (tại mấy vị trí giao ống.)