Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] viết 1 lisp dạng copyarray theo phương định trước !


  • Please log in to reply
23 replies to this topic

#1 leejang

leejang

    biết lệnh move

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

Đã gửi 18 June 2011 - 07:50 AM

Em muốn có cái lis copy array dạng như sau : Command: kk
Select object:
Pick điểm A:
Pick điểm B:
nhập a=
Thì lisp sẽ tự động copy đối tượng từ A =>B cách đều nhau theo khoảng cách a ta nhập vào.
( Xin lỗi các bác trước vì e cũng có 1 cái lisp làm việc này rồi nhưng mà nó chạy có nhiều lỗi lắm. Nên nhờ các bác viết giúp em cái mới cho nó không có lỗi. Em đã tìm trên diễn đàn nhưng ko tìm được cái nào đáp ứng được yêu cầu công việc nên đành nhờ các bác viết giúp em. Có j không phải em xin được chỉ giáo thêm ạ )
  • 0

#2 gp14

gp14

    DO TUAN GIAP

  • Moderator
  • PipPipPipPipPipPipPip
  • 1860 Bài viết
Điểm đánh giá: 1120 (rất tốt)

Đã gửi 18 June 2011 - 08:19 AM

Em muốn có cái lis copy array dạng như sau : Command: kk
Select object:
Pick điểm A:
Pick điểm B:
nhập a=
Thì lisp sẽ tự động copy đối tượng từ A =>B cách đều nhau theo khoảng cách a ta nhập vào.
( Xin lỗi các bác trước vì e cũng có 1 cái lisp làm việc này rồi nhưng mà nó chạy có nhiều lỗi lắm. Nên nhờ các bác viết giúp em cái mới cho nó không có lỗi. Em đã tìm trên diễn đàn nhưng ko tìm được cái nào đáp ứng được yêu cầu công việc nên đành nhờ các bác viết giúp em. Có j không phải em xin được chỉ giáo thêm ạ )

Đoạn lisp này mình cũng hay dùng
Lệnh là CA
;;; =============================== COPY ARRAY ==============================
(defun cpa (/ ss1 a d di n std)
(setq cmdo (getvar "cmdecho"))

(setvar "cmdecho" 0)
(princ "\nCopy array:")
(setq ss1 (ssget))
(setq p1 (getpoint "First point: "))
(setq p2 (getpoint p1 "Second point: "))
(if ca:distance
(progn
(setq std (rtos ca:distance 2 4))
(setq d (getdist (strcat "Distance between elements<" std ">: ")))
(if d
(setq ca:distance d)
)
)
(setq ca:distance (getdist "Distance between elements: "))
)
(setq a (angle p1 p2))
(setq a (* (/ 180 pi) a))
(command "_.ucs" "z" a)
(setq di (distance p1 p2))
(setq d ca:distance)
(setq n (/ di d))
(setq n (+ 1 (atoi (rtos n 2 1))))
(command "_.array" ss1 "" "r" 1 n d)
(command "_.ucs" "")
(setvar "cmdecho" cmdo)
(princ)
)
(defun c:ca () (cpa))

Sau khi pick chọn 2 điểm khống chế A và B thì bạn có thể nhập khoảng cách array hoặc pick chuột để xác định khoảng cách đó.
  • 0

#3 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 18 June 2011 - 08:54 AM

Em muốn có cái lis copy array dạng như sau : Command: kk
Select object:
Pick điểm A:
Pick điểm B:
nhập a=
Thì lisp sẽ tự động copy đối tượng từ A =>B cách đều nhau theo khoảng cách a ta nhập vào.
( Xin lỗi các bác trước vì e cũng có 1 cái lisp làm việc này rồi nhưng mà nó chạy có nhiều lỗi lắm. Nên nhờ các bác viết giúp em cái mới cho nó không có lỗi. Em đã tìm trên diễn đàn nhưng ko tìm được cái nào đáp ứng được yêu cầu công việc nên đành nhờ các bác viết giúp em. Có j không phải em xin được chỉ giáo thêm ạ )

Có cái này ko nhớ khoe chưa thôi xin phép khoe lại nhé:
-Tên lệnh: pcm
-Thao tác:
+Nhập lệnh.
+Chọn đối tượng cần copy.
+Chọn điểm xuất phát.
+Chọn điểm đến.
*Lisp thực hiện copy nhóm đối tượng từ điểm xuất phát đến điểm đến và đưa ra 3 lựa chọn. *N/:N/<: trong đó N là số tuỳ ý (nhập trực tiếp luôn nhé ví dụ *5 lisp sẽ tự lọc lấy số để thực hiện).
+Lựa chọn *N thì đối tượng sẽ được copy thêm N lần với khoảng cách từ từ đối tượng này đến đối tượng kia bằng điểm xuất phát đến điểm đến.
+Lựa chọn :N Thì khoảng cách từ điểm xuất phát đến điểm đến sẽ được chia làm N lần và đối tượng sẽ được copy đến các điểm nút này.
+Lựa chọn < thì sau khi enter lisp hỏi khoảng cách giới hạn và tính toán rãi trong khoảng cách này phần dư thì bỏ. (kiểu như MEASURE của cad ấy)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun thuchiencopy ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(repeat solanthuchien
(setq index (1+ index))
(command ".copy" doituong "" p1 (polar p1 goc (* kc index)))
)
(setvar "osmode" luubatdiem)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun kieunhan ()
(setq index 1)
(setq solanthuchien (- (atoi kytuconlai) 1))
(thuchiencopy)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun kieuchia ()
(setq index 0)
(setq kc (/ kc (atoi kytuconlai)))
(setq solanthuchien (- (atoi kytuconlai) 1))
(thuchiencopy)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun kieutrong ()
(setq p3 (getpoint p1 "\nRai trong khoang: "))
(setq kc1 (distance p1 p3))
(setq index 1)
(setq solanthuchien (- (fix (/ kc1 kc)) 1))
(thuchiencopy)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tinhtoankieu ()
(setq ddkc (strlen kieuchep))
(setq skytuconlai (- ddkc 1))
(setq kytuconlai (substr kieuchep 2 skytuconlai))
(setq kytudautien (substr kieuchep 1 1))

(if (= kytudautien "*")
(progn
(kieunhan)
))
(if (= kytudautien ":")
(progn
(kieuchia)
))
(if (= kytudautien "<")
(progn
(kieutrong)
))
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:cpm ()
(command "undo" "be")
(setvar "MODEMACRO" "RAI DOI TUONG THEO QUY LUAT CHO TRUOC")
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(Prompt "\nChon doi tuong muon chep...")
(setq doituong (ssget)
p1 (getpoint "\nDiem bat dau: ")
p2 (getpoint p1 "\nDiem ket thuc: ")
goc (angle p1 p2)
kc (distance p1 p2)
index 0
)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" doituong "" p1 p2)
(setvar "osmode" luubatdiem)
(setq kieuchep (getstring "\n*N/:N/<: "))
(tinhtoankieu)
(command "undo" "end")
(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI")
(Princ))


  • 1

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


#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 June 2011 - 09:21 AM

Đúng là phong cách của bác Duy, viết rất rành mạch và tên biến thì ..dài loòng thoòng ^^ . Tuy nhiên em thấy là bác Duy hơi lười clear biến nhé ^^
  • 1

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 leejang

leejang

    biết lệnh move

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

Đã gửi 18 June 2011 - 11:55 AM

Có cái này ko nhớ khoe chưa thôi xin phép khoe lại nhé:
-Tên lệnh: pcm
-Thao tác:
+Nhập lệnh.
+Chọn đối tượng cần copy.
+Chọn điểm xuất phát.
+Chọn điểm đến.
*Lisp thực hiện copy nhóm đối tượng từ điểm xuất phát đến điểm đến và đưa ra 3 lựa chọn. *N/:N/<: trong đó N là số tuỳ ý (nhập trực tiếp luôn nhé ví dụ *5 lisp sẽ tự lọc lấy số để thực hiện).
+Lựa chọn *N thì đối tượng sẽ được copy thêm N lần với khoảng cách từ từ đối tượng này đến đối tượng kia bằng điểm xuất phát đến điểm đến.
+Lựa chọn :N Thì khoảng cách từ điểm xuất phát đến điểm đến sẽ được chia làm N lần và đối tượng sẽ được copy đến các điểm nút này.
+Lựa chọn < thì sau khi enter lisp hỏi khoảng cách giới hạn và tính toán rãi trong khoảng cách này phần dư thì bỏ. (kiểu như MEASURE của cad ấy)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun thuchiencopy ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(repeat solanthuchien
(setq index (1+ index))
(command ".copy" doituong "" p1 (polar p1 goc (* kc index)))
)
(setvar "osmode" luubatdiem)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun kieunhan ()
(setq index 1)
(setq solanthuchien (- (atoi kytuconlai) 1))
(thuchiencopy)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun kieuchia ()
(setq index 0)
(setq kc (/ kc (atoi kytuconlai)))
(setq solanthuchien (- (atoi kytuconlai) 1))
(thuchiencopy)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun kieutrong ()
(setq p3 (getpoint p1 "\nRai trong khoang: "))
(setq kc1 (distance p1 p3))
(setq index 1)
(setq solanthuchien (- (fix (/ kc1 kc)) 1))
(thuchiencopy)
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tinhtoankieu ()
(setq ddkc (strlen kieuchep))
(setq skytuconlai (- ddkc 1))
(setq kytuconlai (substr kieuchep 2 skytuconlai))
(setq kytudautien (substr kieuchep 1 1))

(if (= kytudautien "*")
(progn
(kieunhan)
))
(if (= kytudautien ":")
(progn
(kieuchia)
))
(if (= kytudautien "<")
(progn
(kieutrong)
))
(Princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:cpm ()
(command "undo" "be")
(setvar "MODEMACRO" "RAI DOI TUONG THEO QUY LUAT CHO TRUOC")
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(Prompt "\nChon doi tuong muon chep...")
(setq doituong (ssget)
p1 (getpoint "\nDiem bat dau: ")
p2 (getpoint p1 "\nDiem ket thuc: ")
goc (angle p1 p2)
kc (distance p1 p2)
index 0
)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" doituong "" p1 p2)
(setvar "osmode" luubatdiem)
(setq kieuchep (getstring "\n*N/:N/<: "))
(tinhtoankieu)
(command "undo" "end")
(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI")
(Princ))


Phiền bác Duy kiểm tra lại giúp em với. Em chạy thì nó báo lỗi như sau :

Command: cpm
undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: be
Command:
PHAM QUOC DUY Binh Son - Quang ngai
Chon doi tuong muon chep...
Select objects: Specify opposite corner: 1 found

Select objects:
Diem bat dau:
Diem ket thuc: .copy
Select objects: 1 found

Select objects:
Specify base point or [Displacement/Multiple] <Displacement>: Specify second
point or <use first point as displacement>:
Command:
*N/:N/<: <

Rai trong khoang: 10
undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: end

Chú ý rằng. Khoảng AB em đã chọn >10
  • 0

#6 leejang

leejang

    biết lệnh move

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

Đã gửi 18 June 2011 - 11:56 AM

Đoạn lisp này mình cũng hay dùng
Lệnh là CA

;;; =============================== COPY ARRAY ==============================
(defun cpa (/ ss1 a d di n std)
(setq cmdo (getvar "cmdecho"))

(setvar "cmdecho" 0)
(princ "\nCopy array:")
(setq ss1 (ssget))
(setq p1 (getpoint "First point: "))
(setq p2 (getpoint p1 "Second point: "))
(if ca:distance
(progn
(setq std (rtos ca:distance 2 4))
(setq d (getdist (strcat "Distance between elements<" std ">: ")))
(if d
(setq ca:distance d)
)
)
(setq ca:distance (getdist "Distance between elements: "))
)
(setq a (angle p1 p2))
(setq a (* (/ 180 pi) a))
(command "_.ucs" "z" a)
(setq di (distance p1 p2))
(setq d ca:distance)
(setq n (/ di d))
(setq n (+ 1 (atoi (rtos n 2 1))))
(command "_.array" ss1 "" "r" 1 n d)
(command "_.ucs" "")
(setvar "cmdecho" cmdo)
(princ)
)
(defun c:ca () (cpa))

Sau khi pick chọn 2 điểm khống chế A và B thì bạn có thể nhập khoảng cách array hoặc pick chuột để xác định khoảng cách đó.

Bác GP14 xem lại giúp em. Em chạy thì nó lỗi như sau: CAD 2007
Command: ca
Copy array:
Select objects: Specify opposite corner: 1 found

Select objects: First point: Second point: Distance between elements<20.0000>:
10
10.000000

sau khi đánh số 10 vào thì trục UCS bị xoay theo hướng mình nhập vào. Không copy được. Lỗi này giống hệt lisp của em !
  • 0

#7 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 June 2011 - 12:50 PM

Em muốn có cái lis copy array dạng như sau : Command: kk
Select object:
Pick điểm A:
Pick điểm B:
nhập a=
Thì lisp sẽ tự động copy đối tượng từ A =>B cách đều nhau theo khoảng cách a ta nhập vào.
( Xin lỗi các bác trước vì e cũng có 1 cái lisp làm việc này rồi nhưng mà nó chạy có nhiều lỗi lắm. Nên nhờ các bác viết giúp em cái mới cho nó không có lỗi. Em đã tìm trên diễn đàn nhưng ko tìm được cái nào đáp ứng được yêu cầu công việc nên đành nhờ các bác viết giúp em. Có j không phải em xin được chỉ giáo thêm ạ )

Bạn thử cái này xem đúng ý không nhé.

(defun c:kk ()
(princ "\nChon doi tuong can array: ")
(setq ss (ssget)
p1 (getpoint "\nChon diem thu nhat: ")
p2 (getpoint p1 "\nChon diem thu hai: ")
sl (getint "\nNhap so luong muon array: ")
d (distance p1 p2)
cd (/ d sl)
ang (angle p1 p2)
p3 p1
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(repeat sl
(setq p3 (polar p3 ang cd))
(command "copy" ss "" p1 p3 "")
)
(setvar "osmode" oldos)
)

  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#8 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 18 June 2011 - 02:05 PM

Bạn thử cái này xem đúng ý không nhé.

Hề hề hề,
Bác Phamngoctukts ơi,
Cái anh bạn leejang này khó tính lắm, hình như bác viết chưa trúng ý của anh ấy rùi.
Mình mạo muội sửa nó thành cái ni, nhưng mà cũng chửa biết có đúng ý của anh bạn ấy hay chưa???
Hề hề hề,...



(defun c:kk ()
(princ "\nChon doi tuong can array: ")
(setq ss (ssget)
p1 (getpoint "\nChon diem thu nhat: ")
p2 (getpoint p1 "\nChon diem thu hai: ")
sl (getint "\nNhap so luong muon array: ")
d (distance p1 p2)
cd (getreal "\n Nhap khoang cach giua hai doi tuong lien tiep")
ang (angle p1 p2)
p3 p2
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(if (= cd nil)
(setq cd d)
)
(repeat sl
(command "copy" ss "" p1 p3 "")
(setq p3 (polar p3 ang cd))
)
(setvar "osmode" oldos)
)

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

#9 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 18 June 2011 - 02:41 PM

Phiền bác Duy kiểm tra lại giúp em với. Em chạy thì nó báo lỗi như sau :

Command: cpm
undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: be
Command:
PHAM QUOC DUY Binh Son - Quang ngai
Chon doi tuong muon chep...
Select objects: Specify opposite corner: 1 found

Select objects:
Diem bat dau:
Diem ket thuc: .copy
Select objects: 1 found

Select objects:
Specify base point or [Displacement/Multiple] <Displacement>: Specify second
point or <use first point as displacement>:
Command:
*N/:N/<: <

Rai trong khoang: 10
undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: end

Chú ý rằng. Khoảng AB em đã chọn >10

Hề hề hề,
Bạn thực hiện sai nên lisp nó hổng chạy là phải thôi.
Hãy chú ý đoạn code sau:
(setq p3 (getpoint p1 "\nRai trong khoang: "))

Ở đây sử dụng hàm (getpoint .....) chứ đâu phải (getreal ....) do vậy khi lisp hiện ra thông báo "Rai trong khoang:" bạn nhập 10 ở đây là sai tóe loe. Bạn phải pick một điểm trên bản vẽ hoặc nhập tọa độ của một điểm mới đúng.

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.

#10 leejang

leejang

    biết lệnh move

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

Đã gửi 18 June 2011 - 05:35 PM

Hic. Cái lisp KK bác viết cho em nó ko chạy. Nó chỉ copy được 1 đối tượng ra thôi, Bác có thể kiếm tra lại giúp em. Em xin trình bày lại yêu cầu
Em muốn có cái lis copy array dạng như sau : Command: kk
Select object:
Pick điểm A:
Pick điểm B:
nhập a= ( ở đây có thể khoảng cách a lấy bằng cách pick điểm để xác định khoảng cách )
Thì lisp sẽ tự động copy đối tượng từ A =>B cách đều nhau theo khoảng cách a ta nhập vào, còn khoảng cuối cùng sát điểm B do lẻ nên bỏ qua. Giống kiểu lệnh me
Ngày xưa đọan lisp này của em nó chạy được nhưng tự dưng bị lỗi không hiểu do cái j ? Các bác có thể check giúp em lỗi để nó chạy ok là hiểu được ý tưởng của em ạ

;;====CODE

(DEFUN C:caa ()

(progn
(setq cmdo (getvar "cmdecho"))
;(command "_.ucs" "")
(setvar "cmdecho" 0)
(princ "\nCopy array:")
(setq ss1 (ssget))
(setq p1 (getpoint "First point: "))
(setq p2 (getpoint p1 "Second point: "))
(if ca:distance
(progn
(setq std (rtos ca:distance 2 4))
(setq d (getdist (strcat "@n=<" std ">: ")))
(if d
(setq ca:distance d)
)
) ;end progn
(setq ca:distance (getdist "a= "))
) ;end if
(setq a (angle p1 p2))
(setq a (* (/ 180 pi) a))
(command "_.ucs" "z" a)
(setq di (distance p1 p2))
(setq d ca:distance)
(setq n (/ di d))
(setq n (+ 1 (atoi (rtos n 2 1))))
(command "_.array" ss1 "" "r" 1 n d)
(command "_.ucs" "")
(setvar "cmdecho" cmdo)
(princ)
)
)

Khi chạy nó lỗi ko copy ra được và xoay mất trục ucs của mình ạ.
  • 0

#11 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 18 June 2011 - 06:16 PM

Hic. Cái lisp KK bác viết cho em nó ko chạy. Nó chỉ copy được 1 đối tượng ra thôi, Bác có thể kiếm tra lại giúp em.

Mạn phép bác PTB đang đi đâu đó.
KK vẫn chạy đấy chứ, mặc dầu nó có báo lỗi.
Bạn sửa
(command "copy" ss "" p1 p3 "")
thành
(command "copy" ss "" p1 p3)
là được
  • 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 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 June 2011 - 06:35 PM

Hic. Cái lisp KK bác viết cho em nó ko chạy. Nó chỉ copy được 1 đối tượng ra thôi, Bác có thể kiếm tra lại giúp em. Em xin trình bày lại yêu cầu
Em muốn có cái lis copy array dạng như sau : Command: kk
Select object:
Pick điểm A:
Pick điểm B:
nhập a= ( ở đây có thể khoảng cách a lấy bằng cách pick điểm để xác định khoảng cách )
Thì lisp sẽ tự động copy đối tượng từ A =>B cách đều nhau theo khoảng cách a ta nhập vào, còn khoảng cuối cùng sát điểm B do lẻ nên bỏ qua. Giống kiểu lệnh me
Ngày xưa đọan lisp này của em nó chạy được nhưng tự dưng bị lỗi không hiểu do cái j ? Các bác có thể check giúp em lỗi để nó chạy ok là hiểu được ý tưởng của em ạ

Nghe danh bạn đã lâu. Quả là "danh bất hư truyền". Bạn thử cái này xem có đúng không nhé.

(defun c:kk ()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(princ "\nChon doi tuong can array: ")
(setq ss (ssget)
p1 (getpoint "\nChon diem thu nhat: ")
p2 (getpoint p1 "\nChon diem thu hai: ")
cd (getdist "\nNhap khoang cach array: ")
d (distance p1 p2)
sl (rtos(/ d cd) 2 0)
ang (angle p1 p2)
p3 p1
)
(repeat (atoi sl)
(setq p3 (polar p3 ang cd))
(command "copy" ss "" p1 p3 "")
)
(setvar "osmode" oldos)
)

  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#13 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 18 June 2011 - 08:27 PM

Nghe danh bạn đã lâu. Quả là "danh bất hư truyền". Bạn thử cái này xem có đúng không nhé.

Có lỗi khi dùng hàm (command "copy"...) mà 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.


#14 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 18 June 2011 - 09:30 PM

Mạn phép bác PTB đang đi đâu đó.
KK vẫn chạy đấy chứ, mặc dầu nó có báo lỗi.
Bạn sửa
(command "copy" ss "" p1 p3 "")
thành
(command "copy" ss "" p1 p3)
là được

Hề hề hề,
Cám ơn bác Doan van Ha đã chỉ ra cái chỗ chưa đúng. Thực ra mình chỉ định bổ sung chút xíu vào cái lisp của bác phamngoctukts đã viết nên không soát kỹ lại lisp và để lại lỗi như vầy. Rất mong các bác thứ lỗi.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#15 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 18 June 2011 - 09:44 PM

Hề hề hề,
Cám ơn bác Doan van Ha đã chỉ ra cái chỗ chưa đúng. Thực ra mình chỉ định bổ sung chút xíu vào cái lisp của bác phamngoctukts đã viết nên không soát kỹ lại lisp và để lại lỗi như vầy. Rất mong các bác thứ lỗi.

Không có gì đâu bác! Chuyện sơ suất thì tôi nhiều hơn bác cỡ... 1000 lần! Bắt tay bác thêm một lần nữa nhé 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.


#16 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 18 June 2011 - 10:54 PM

Phiền bác Duy kiểm tra lại giúp em với. Em chạy thì nó báo lỗi như sau :

Command: cpm
undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: be
Command:
PHAM QUOC DUY Binh Son - Quang ngai
Chon doi tuong muon chep...
Select objects: Specify opposite corner: 1 found

Select objects:
Diem bat dau:
Diem ket thuc: .copy
Select objects: 1 found

Select objects:
Specify base point or [Displacement/Multiple] <Displacement>: Specify second
point or <use first point as displacement>:
Command:
*N/:N/<: <

Rai trong khoang: 10
undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: end

Chú ý rằng. Khoảng AB em đã chọn >10

Khi chọn đối tượng xong chọn điểm a và điểm b trước tiên lisp sẽ làm ngay việc copy đối tượng từ a đến b xong cho các lựa chọn.
-Ở đây lựa chọn < thì nhập số hay pick 1 điểm để lấy khoảng cách tới điểm a gì cũng được nhưng khoảng cách này phải lớn hơn ab thì mới được vì tác dụng là rải trong khoảng (vừa nhập với khoảng cách ab).
  • 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


#17 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 June 2011 - 11:59 PM

Vừa mới nhắc leejang ở mấy bài trước, giờ đã gặp ngay, nhớ quá cơ :) Chẳng là có thời gian ketxu biên soạn lisp trong diễn đàn, nên cũng có chút thời gian ngó qua các bài viết của leejang :) Quả là khiến các lão cao thủ bị xoay đến vất vả và sau bao lâu rồi, bạn vẫn thế...
  • 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


#18 vbtxd06

vbtxd06

    biết vẽ ellipse

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

Đã gửi 19 June 2011 - 09:33 AM

Xin chào các anh cadviet, em là lính mới.Thấy và đọc bài của bạn leejang nên gửi bài code này không biết đã đúng y cua ban chưa?
(defun c:kk ()
(princ "\nChon doi tuong can array: ")
(setq ss (ssget)
p1 (getpoint "\nChon diem thu nhat: ")
p2 (getpoint p1 "\nChon diem thu hai: ")
a (getdist "\nNhap khoang cach array: ")
kc (distance p1 p2)
sl (fix(/ kc a))
ang (angle p1 p2)
index 0
)
(repeat sl
(setq index (1+ index))
(setq vbt (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" ss "" p1 (polar p1 ang (* a index)))nil
(setvar "osmode" vbt)
)
(princ))

  • 0

#19 leejang

leejang

    biết lệnh move

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

Đã gửi 19 June 2011 - 10:55 AM

Xin chào các anh cadviet, em là lính mới.Thấy và đọc bài của bạn leejang nên gửi bài code này không biết đã đúng y cua ban chưa?

(defun c:kk ()
(princ "\nChon doi tuong can array: ")
(setq ss (ssget)
p1 (getpoint "\nChon diem thu nhat: ")
p2 (getpoint p1 "\nChon diem thu hai: ")
a (getdist "\nNhap khoang cach array: ")
kc (distance p1 p2)
sl (fix(/ kc a))
ang (angle p1 p2)
index 0
)
(repeat sl
(setq index (1+ index))
(setq vbt (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" ss "" p1 (polar p1 ang (* a index)))nil
(setvar "osmode" vbt)
)
(princ))

Hic ! tối hôm qua em mò mẫm mãi mới bit. Cái lisp của em không chạy và một số lisp khác của các bác viết cho em em tải về dùng bị lỗi là do em đã load quá nhiều lisp cùng autocad. ( khoảng >100 lisp), chính vì thế mà bị xung đột lẫn nhau, khi load 1 mình 1 lisp đó thì nó chạy ok. Bi h phải làm sao để nó ko xung đột mà mình ko mất công load thủ công mỗi khi dùng ạ ?
  • 0

#20 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 19 June 2011 - 11:32 AM

Hic ! tối hôm qua em mò mẫm mãi mới bit. Cái lisp của em không chạy và một số lisp khác của các bác viết cho em em tải về dùng bị lỗi là do em đã load quá nhiều lisp cùng autocad. ( khoảng >100 lisp), chính vì thế mà bị xung đột lẫn nhau, khi load 1 mình 1 lisp đó thì nó chạy ok. Bi h phải làm sao để nó ko xung đột mà mình ko mất công load thủ công mỗi khi dùng ạ ?

Ngay câu hỏi cũng là một phần của câu trả lời rồi đó bạn. Bạn chỉ có thể giảm bớt sự xung đột (chứ khó loại hẳn) bằng những cách như sau:
1. Đặt biến cục bộ cho các biến chỉ dùng trong nội bộ hàm.
2. Hạn chế đặt biến nếu thấy không cần thiết.
3. Đừng load một lúc nhiều file lsp.
4. Tuy nhiên, khi gặp biến toàn cục trùng nhau vẫn có thể xung khắ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.