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

    • Nguyen Hoanh

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

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

[Nhờ chỉnh sửa]Lisp vẽ hình oval

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

Nhờ các bác chỉnh sửa giúp em lisp này với!Cảm ơn các bác nhiều!!

(defun main
FasStringtables 0
FasStringtables 1
(defun main
nil
(setq C:OVAL <Func> C:OVAL)
(vl-ACAD-defun C:OVAL)
(defun C:OVAL
(_al-bind-alist '(*OVL:ERR* C_E C1 C2 R ANG O1 O2 O3 O4 CE))
(defun *OVL:ERR*
(M)
(cond (MEMBER M '("Function cancelled" "quit / exit abort" "console break")) (
(cond (PROMPT (STRCAT "\n< " M " >\n")) (
it's OR skip next 6 bytes -> 81
it's OR skip next 6 bytes -> 81
T
(ENTDEL CE)
(SETVAR Then OR Else C_E)
(setq *ERROR* *E*)
(setq *OVL:ERR* <Func> *OVL:ERR*)
(cond *E* (
(cond *ERROR* (
normal cond
normal cond
(setq *E* nil)
(setq *ERROR* *OVL:ERR*)
(setq C_E (GETVAR "cmdecho"))
(setq C1 (GETPOINT "\nFirst end of oval <center point>: "))
(PROMPT "\nOval width <point>: ")
(SETVAR "cmdecho" 0)
(ads-cmd "circle")
(ads-cmd C1)
(ads-cmd PAUSE)
(setq CE (ENTLAST ))
(PROMPT "\nOther end of oval: ")
(ads-cmd "move")
(ads-cmd "l")
(ads-cmd "")
(ads-cmd C1)
(ads-cmd PAUSE)
(setq C2 (CDR (ASSOC 10 (ENTGET (ENTLAST )))))
(setq R (CDR (ASSOC 40 (ENTGET (ENTLAST )))))
(setq ANG (ANGLE C1 C2))
(setq O1 (POLAR C1 (+ ANG (/ PI 2)) R))
(setq O2 (POLAR C1 (- ANG (/ PI 2)) R))
(setq O3 (POLAR C2 (- ANG (/ PI 2)) R))
(setq O4 (POLAR C2 (+ ANG (/ PI 2)) R))
(ENTDEL CE)
(ads-cmd "pline")
(ads-cmd O1)
(ads-cmd "w")
(ads-cmd 0)
(ads-cmd 0)
(ads-cmd "a")
(ads-cmd "ce")
(ads-cmd C1)
(ads-cmd O2)
(ads-cmd "l")
(ads-cmd O3)
(ads-cmd "a")
(ads-cmd O4)
(ads-cmd "l")
(ads-cmd "c")
(SETVAR Then OR Else C_E)
(setq *ERROR* *E*)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.653

- THứ nhất, đây không phải là lisp, mà là file bạn dịch ngược từ VLX hoặc Fas. Bạn nên tôn trọng nếu tác giả muốn giấu ^^

- Thứ 2, chẳng ai biết cái lisp của bạn nó làm cái j, đầu vào đầu ra ra sao thì giúp vào đâu ??

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Em xin cảm ơn bác Ketxu đã góp ý cho em.Em se rút kinh nghiệm lần sau

Đoạn code em gửi lên là file được dịch từ file.Vlx.Do nhu cầu công việc(em là họa viên) nên cũng rất hay sử dụng lệnh này.Lúc trước toàn làm thủ công.Em muốn chuyển đổi lại thành file lisp cho dễ sử dụng nên nhờ các bác giúp em.File líp nay dùng vẽ hình oval

Tên lệnh:oval

pick vào 1 điểm bất kì/vẽ ra 1 hình tròn

kéo dài ra=> ta được hình oval(giống như hình mũi bậc thang trong khai triển kiến trúc vậy)

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.653

Vậy vấn đề là bạn cần sửa cái gì mới được chứ ?

Hoặc tốt nhất là bạn viết lại yêu cầu của bạn, viết cái mới còn hơn ??

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Vậy vấn đề là bạn cần sửa cái gì mới được chứ ?

Hoặc tốt nhất là bạn viết lại yêu cầu của bạn, viết cái mới còn hơn ??

Lisp của em thế này:

1-tên lệnh:oval

2-pick chọn 1 điểm bất kỳ

3-vẽ ra 1 đường tròn(bán kính là mình có thể nhập vào, vd:50)

4-kéo dài ra

kết quả: được 1 hình oval với 2 đầu bo tròn(bk là 50)

Thanks các pro!!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.653

Lisp của em thế này:

1-tên lệnh:oval

2-pick chọn 1 điểm bất kỳ

3-vẽ ra 1 đường tròn(bán kính là mình có thể nhập vào, vd:50)

4-kéo dài ra

kết quả: được 1 hình oval với 2 đầu bo tròn(bk là 50)

Thanks các pro!!

Bạn đã đọc qua nội quy post yêu cầu lisp trong box chưa ??

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Lisp của em thế này:

1-tên lệnh:oval

2-pick chọn 1 điểm bất kỳ

3-vẽ ra 1 đường tròn(bán kính là mình có thể nhập vào, vd:50)

4-kéo dài ra

kết quả: được 1 hình oval với 2 đầu bo tròn(bk là 50)

Thanks các pro!!

Bạn dùng thử cái này xem được không nhé!

;Doan Van Ha - CADViet.com
(defun C:OVAL()
(BAT_DAU)
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(initget 1) (setq p1 (getpoint "\nPick tam Oval thu 1: "))
(princ "\nSpecify radius of circle or [Diameter]:")
(command "circle" p1 pause)
(setq ent1 (entlast))
(setq bk (cdr (assoc 40 (entget ent1))))
(initget 1) (setq p2 (getpoint p1 "\nPick tam Oval thu 2: "))
(setq q1 (polar p1 (+ (/ pi 2) (angle p1 p2)) bk) q2 (polar q1 (angle p1 p2) (distance p1 p2))
        q3 (polar p2 (angle p1 p2) bk) q4 (polar p2 (- (angle p1 p2) (/ pi 2)) bk)
        q5 (polar p1 (- (angle p1 p2) (/ pi 2)) bk) q6 (polar p1 (+ pi (angle p1 p2)) bk))
(command "pline" q1 q2 "a" q3 q4 "l" q5 "a" q6 q1 "")
(command "erase" ent1 "")
(KET_THUC)
(princ))
;-----
(defun BAT_DAU()
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
(defun KHI_LOI(msg)
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(redraw)
(command "u")
(princ (strcat "\n" msg ", Reset System Variables\n"))
(setq *error* err))

P/S: đã sửa theo y/c của chủ topic, lúc 9h53 AM ngày 19/11/2011

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bạn dùng thử cái này xem được không nhé!

;Doan Van Ha - CADViet.com
(defun C:OVAL()
(BAT_DAU)
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(initget 7) (setq bk (getreal "\nBan kinh Oval: "))
(initget 1) (setq p1 (getpoint "\nPick tam Oval thu 1: "))
(command "arc" (polar p1 (/ pi 2) bk) (polar p1 (- pi) bk) (polar p1 (/ pi -2) bk))
(setq ent1 (entlast))
(command "circle" p1 bk)
(setq ent2 (entlast))
(initget 1) (setq p2 (getpoint p1 "\nPick tam Oval thu 2: "))
(command "rotate" ent1 "" p1 (/ (* 180 (angle p1 p2)) pi))
(command "line" (vlax-curve-getEndPoint ent1) (polar (vlax-curve-getEndPoint ent1) (angle p1 p2) (distance p1 p2)) "")
(command "line" (vlax-curve-getStartPoint ent1) (polar (vlax-curve-getStartPoint ent1) (angle p1 p2) (distance p1 p2)) "")
(command "mirror" ent1 "" (acet-geom-midpoint (vlax-curve-getEndPoint ent1) (polar (vlax-curve-getEndPoint ent1) (angle p1 p2) (distance p1 p2)))
                            					(acet-geom-midpoint (vlax-curve-getStartPoint ent1) (polar (vlax-curve-getStartPoint ent1) (angle p1 p2) (distance p1 p2))) "N")
(command "erase" ent2 "")
(acet-sysvar-restore)
(KET_THUC)
(princ))
(defun BAT_DAU()
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
(defun KHI_LOI(msg)
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(redraw)
(command "u")
(princ (strcat "\n" msg ", Reset System Variables\n"))
(setq *error* err))

Bạn dùng thử cái này xem được không nhé!

;Doan Van Ha - CADViet.com
(defun C:OVAL()
(BAT_DAU)
(acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
(initget 7) (setq bk (getreal "\nBan kinh Oval: "))
(initget 1) (setq p1 (getpoint "\nPick tam Oval thu 1: "))
(command "arc" (polar p1 (/ pi 2) bk) (polar p1 (- pi) bk) (polar p1 (/ pi -2) bk))
(setq ent1 (entlast))
(command "circle" p1 bk)
(setq ent2 (entlast))
(initget 1) (setq p2 (getpoint p1 "\nPick tam Oval thu 2: "))
(command "rotate" ent1 "" p1 (/ (* 180 (angle p1 p2)) pi))
(command "line" (vlax-curve-getEndPoint ent1) (polar (vlax-curve-getEndPoint ent1) (angle p1 p2) (distance p1 p2)) "")
(command "line" (vlax-curve-getStartPoint ent1) (polar (vlax-curve-getStartPoint ent1) (angle p1 p2) (distance p1 p2)) "")
(command "mirror" ent1 "" (acet-geom-midpoint (vlax-curve-getEndPoint ent1) (polar (vlax-curve-getEndPoint ent1) (angle p1 p2) (distance p1 p2)))
                            					(acet-geom-midpoint (vlax-curve-getStartPoint ent1) (polar (vlax-curve-getStartPoint ent1) (angle p1 p2) (distance p1 p2))) "N")
(command "erase" ent2 "")
(acet-sysvar-restore)
(KET_THUC)
(princ))
(defun BAT_DAU()
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
(defun KHI_LOI(msg)
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(redraw)
(command "u")
(princ (strcat "\n" msg ", Reset System Variables\n"))
(setq *error* err))

 

Cảm ơn Bác Doan van Ha nhé!Nhưng bác có thể chỉnh lại giúp e chút xíu được không!Trước khi mình nhập vào bán kính,mình sẽ pick vào 1 điểm bất kì để xác định tâm cho hình oval 1 luôn và khi vẽ xong thì tất cả sẽ nối lại thành 1 polyline!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Cảm ơn Bác Doan van Ha nhé!Nhưng bác có thể chỉnh lại giúp e chút xíu được không!Trước khi mình nhập vào bán kính,mình sẽ pick vào 1 điểm bất kì để xác định tâm cho hình oval 1 luôn và khi vẽ xong thì tất cả sẽ nối lại thành 1 polyline!

Chà, viết cho bạn mà mòn mõi đợi chờ bạn phản hồi xem đã ưng ý chưa. May ra tối nay mới thấy bạn phản hồi. Nhân tiện, bạn có thể nói tất tần tật yêu cầu của bạn, sáng mai tôi sẽ sửa.

Thân thương!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Chà, viết cho bạn mà mòn mõi đợi chờ bạn phản hồi xem đã ưng ý chưa. May ra tối nay mới thấy bạn phản hồi. Nhân tiện, bạn có thể nói tất tần tật yêu cầu của bạn, sáng mai tôi sẽ sửa.

Thân thương!

 

Bác thông cảm nhé!tại mấy bữa"cày" nhiều quá không có lên mạng được.Lisp của bác viết chạy đúng rồi nhưng nhờ bác chỉnh thêm xíu.

Tên lệnh:oval

-pick 1 điểm bất kì làm tâm của oval 1

-vẽ ra đường tròn (bán kính có thể pick tùy ý hay nhập số)

-kéo dài ra

kết quả ta được 1 hình oval và tất cả nối thành 1 polyline luôn

Thanks bác nhiu!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

 

Bác thông cảm nhé!tại mấy bữa"cày" nhiều quá không có lên mạng được.Lisp của bác viết chạy đúng rồi nhưng nhờ bác chỉnh thêm xíu.

Tên lệnh:oval

-pick 1 điểm bất kì làm tâm của oval 1

-vẽ ra đường tròn (bán kính có thể pick tùy ý hay nhập số)

-kéo dài ra

kết quả ta được 1 hình oval và tất cả nối thành 1 polyline luôn

Thanks bác nhiu!

 

Đã sửa cho bạn rồi. Bạn quay lại ở địa chỉ cũ để down cho đỡ tốn đất CADViet.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123

Em xin cảm ơn bác Ketxu đã góp ý cho em.Em se rút kinh nghiệm lần sau

Đoạn code em gửi lên là file được dịch từ file.Vlx.Do nhu cầu công việc(em là họa viên) nên cũng rất hay sử dụng lệnh này.Lúc trước toàn làm thủ công.Em muốn chuyển đổi lại thành file lisp cho dễ sử dụng nên nhờ các bác giúp em.File líp nay dùng vẽ hình oval

Tên lệnh:oval

pick vào 1 điểm bất kì/vẽ ra 1 hình tròn

kéo dài ra=> ta được hình oval(giống như hình mũi bậc thang trong khai triển kiến trúc vậy)

 

moz-screenshot-1.png

Hề hề hề,

Bác này tài thật, dịch được từ file .vlx ra file lisp. Vậy bác có thể chỉ giúp cách dịch hay có phần mềm nào chuyên dịch từ file vlx thì bác share cho mọi người với. Nếu có tính phí bản quyền thì bác tính nhẹ tay giùm.

Về yêu cầu của bác không quá khó đâu, nếu bác chưa ưng cái của bác DoanvanHa thì cứ nói, chắc sẽ có cách giải quyết tinh tươm mà thôi.

Hề hề hề,....

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Đã sửa cho bạn rồi. Bạn quay lại ở địa chỉ cũ để down cho đỡ tốn đất CADViet.

 

Thanks bác Doan van Ha nhiều!Đúng là lisp em đang cần đây!Chúc bác và các pro nhiều sức khỏe

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Hề hề hề,

Bác này tài thật, dịch được từ file .vlx ra file lisp. Vậy bác có thể chỉ giúp cách dịch hay có phần mềm nào chuyên dịch từ file vlx thì bác share cho mọi người với. Nếu có tính phí bản quyền thì bác tính nhẹ tay giùm.

Về yêu cầu của bác không quá khó đâu, nếu bác chưa ưng cái của bác DoanvanHa thì cứ nói, chắc sẽ có cách giải quyết tinh tươm mà thôi.

Hề hề hề,....

 

Có phần mềm dịch từ VLX (hoặc FAS) sang LSP bác 3 Hề ạ, nhưng dịch ra mà dùng được thì mới lạ. Dịch để nghiên cứu thì tạm được, những cũng "mỏi" lắm. Tôi cũng sưu tầm trên CV.

Thân thương!

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123

 

Có phần mềm dịch từ VLX (hoặc FAS) sang LSP bác 3 Hề ạ, nhưng dịch ra mà dùng được thì mới lạ. Dịch để nghiên cứu thì tạm được, những cũng "mỏi" lắm. Tôi cũng sưu tầm trên CV.

Thân thương!

Hê hề hề,

Bác chỉ dùm chỗ mót với chứ mình cũng lăn tăn chuyện này từ lâu mà chả tìm thấy chỗ nào bác ạ. Cho dù chỉ để tham khảo nhưng nó cũng giúp mình hiểu hơn ý đồ của người viết ra cái thằng vlx bác ạ.

Thú thực là mình muốn có nó cũng chỉ để ... mót thêm thôi chứ chả dám có ý định trộm cắp gì của ai đâu ạ.

Hề hề hề,....

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Hê hề hề,

Bác chỉ dùm chỗ mót với chứ mình cũng lăn tăn chuyện này từ lâu mà chả tìm thấy chỗ nào bác ạ. Cho dù chỉ để tham khảo nhưng nó cũng giúp mình hiểu hơn ý đồ của người viết ra cái thằng vlx bác ạ.

Thú thực là mình muốn có nó cũng chỉ để ... mót thêm thôi chứ chả dám có ý định trộm cắp gì của ai đâu ạ.

Hề hề hề,....

 

Vào lại CV thử tìm thì tìm không ra. Hiện tôi đang có file đó ở đây (đuôi exe) nhưng upload lên không được (CV báo đang tạm ngừng chức năng này để nâng cấp). Bác có quen đường nào khác để upload lên thì chỉ giùm, tôi sẽ up cho bác.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×