Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
15 replies to this topic

#1 draftsman38751

draftsman38751

    biết zoom

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

Đã gửi 13 November 2011 - 02:46 PM

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

  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 November 2011 - 06:46 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 draftsman38751

draftsman38751

    biết zoom

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

Đã gửi 13 November 2011 - 08:58 PM

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)

file:///C:/DOCUME%7E1/ADMINI%7E1/LOCALS%7E1/Temp/moz-screenshot-1.png
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 November 2011 - 10:10 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#5 draftsman38751

draftsman38751

    biết zoom

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

Đã gửi 15 November 2011 - 07:52 PM

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

#6 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 November 2011 - 09:01 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 15 November 2011 - 10:18 PM

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

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 draftsman38751

draftsman38751

    biết zoom

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

Đã gửi 18 November 2011 - 09:14 PM

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

#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 18 November 2011 - 09:21 PM

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

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#10 draftsman38751

draftsman38751

    biết zoom

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

Đã gửi 18 November 2011 - 09:54 PM

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

#11 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 19 November 2011 - 09:57 AM


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

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#12 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 19 November 2011 - 01:39 PM

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)

file:///C:/DOCUME%7E1/ADMINI%7E1/LOCALS%7E1/Temp/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ề,....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#13 draftsman38751

draftsman38751

    biết zoom

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

Đã gửi 19 November 2011 - 03:32 PM


Đã 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
  • 0

#14 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 19 November 2011 - 03:48 PM

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

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#15 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 19 November 2011 - 04:05 PM


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

#16 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 19 November 2011 - 04:22 PM

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

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.