[yêu cầu] viết lisp copy nhảy cao độ tự động như hình vẽ kèm theo

[hugo007 1]

Mình mù tịt về ngôn ngữ lập trình nên ko biết thêm câu lệnh tỷ lệ bản vẽ vào chỗ nào. Các bạn có thể giúp mình hoàn thiện lisp này đc chứ. Cảm ơn nhiều.

Các bác giúp thêm phần tỉ lệ trong lisp của bác ketxu với ah.Cảm ơn các bác đã quan tâm giúp đỡ.

[phamthanhbinh 3.146]

Các bác giúp thêm phần tỉ lệ trong lisp của bác ketxu với ah.Cảm ơn các bác đã quan tâm giúp đỡ.

Hề hề hề,

@ Bạn svxd: Mình mù tịt về ngôn ngữ lập trình nên ko biết thêm câu lệnh tỷ lệ bản vẽ vào chỗ nào. Các bạn có thể giúp mình hoàn thiện lisp này đc chứ. Cảm ơn nhiều.

Hề hề hề,

Các bạn hãy chịu khó đọc lại bài post mình đã trả lời bạn Lenhatanh nhé.

Có thề các bạn chưa hiểu hết về lisp, nhưng không có nghĩa là các bạn không biết gì. Bởi nếu vậy các bạn sẽ không thể sử dụng được lisp.

Việc tìm hiểu và cố gắng để hiểu mục đích của mỗi lisp là một việc mà bất cứ ai muốn dùng lisp đều phải có ý thức này. Bởi nó là con dao hai lưỡi, Nếu không hiểu về nó mà cứ xài bừa theo kiểu chùa thì sẽ có ngày các bạn ăn đòn to. Mỗi một lisp chỉ phù hợp với một mục tiêu nhất định đã đặt ra chứ không phải là dùng chung cho tất cả mọi ý đồ tương tự đâu. Mà ý định sử dụng của mỗi người lại luôn luôn là không đồng nhất. Vì thế để nó có thể phục vụ đúng ý của mình thì chả có cách chi ngoài cách chính các bạn phải hiểu và biết cách bổ sung hay chỉnh sửa nó cả.

Việc viết thêm mấy chữ chả phải việc khó khăn chi đâu nhưng mình và có nhẽ nhiều người khác trên diễn đàn cũng sẽ không muốn làm, vì như vậy chả có ích chi cho cả các bạn và người viết cả. Tại sao ư??? Tại vì người viết được chứng tỏ là đã dư xăng để hiểu và cũng chả cần học thêm cái chi ở công việc viết này, còn các bạn cũng sẽ chả học được cái chi từ cái việc lười và ỷ lại ấy. Giá như các bạn có cố gắng để hiểu và vận dụng nó cũng như có cố gắng để hiểu và chủ động trong công việc của mình thì sẽ không ai tiếc cái công sức để giúp đỡ các bạn đâu. Một việc tối thiểu là tìm hiểu về cái mình cần mà các bạn cũng không muốn thì quả thật là bó tay rồi, có giúp tới kiệt sức cũng sẽ là vô ích các bạn ạ.

Mà có phải là không có ai quan tâm giúp đỡ đâu, đã có bài trả lời và hướng dẫn mà theo mình thấy là không quá tệ để các bạn có thể tự tìm hiểu và áp dụng nhưng các bạn cũng chả thèm đọc thì biêt giúp cái chi nữa đây.

Vậy nên nếu như các bạn không đọc và không thử làm thoe hướng dẫn để xem nó ra cái chi chi thì cũng chả nên kêu ca hay nhờ vả ai nữa cả các bạn ạ.

Đầu năm mới, phải viết những dòng này còn cực hơn là viết thêm mấy chữ vào lisp, nhưng mình không thể làm thay các bạn được. Rất mong các bạn cố gắng tí ti để hoàn thiện công việc của chính các bạn.

Chúc các bạn thành công.

[svxd 0]

Rất cảm ơn lời góp ý của bạn phamthanhbinh. Trước khi đăng bài nhờ giúp đỡ tôi đã thử copy dòng (setq k (getreal "\n Nhap he so ty le cua ban ve: ")) vào rất nhiều vị trí trong lisp của bạn ketxu nhưng đều ko được và còn làm cho lisp ko còn tác dụng. Tôi cũng tìm trên GG về cách sử dụng hàm hàm (getint....) hay (getreal .....) như bạn nói nhưng cũng ko thành công. Chính vì tôi ko hiểu về ngôn ngữ lập trình này nên tôi mới phải nhờ đến các bạn. Cũng bởi vì giờ tôi đang cần lisp này và cũng ko phải là dân sử dụng cad chuyên nghiệp nên để học ngôn ngữ này để sửa lisp thì chắc tôi đành sử dụng theo cách thông thường đúng như trình độ của tôi vậy. Tôi nghĩ mỗi người đều có 1 vài sở trường riêng của mình, ko thể biết hết được do đó mới cần sự giúp đỡ. Tôi ko hay dùng cad và lisp nên cần nhờ sự giúp đỡ của bạn còn nếu là excel hoặc 1 vài phần mềm khác thì chắc tôi ko dám lười và ỷ lại vào bạn đâu. Tôi cũng muốn hoàn thiện bản thân mình lắm chứ.

[ketxu 2.984]

@svxd và hugo : mình update bản demo có phần tỉ lệ ở đây

[NguyenNgocSon 43]

Xin phép Ketxu. Mình sửa thêm cái chỗ cho thêm tỷ lệ vào cho bạn @svxd và hugo.

 

Thú thực là không am hiểu code lisp từ đầu nên cũng thi thoảng sửa 1 hai chỗ đơn giản thôi. Mong các bác hiểu cho, có thời gian cũng tìm hiểu được.

 

Cám ơn @Ketxu lisp rất hay.

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=56086&pid=171947&st=0entry171947
(defun c:dc (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)
;Gan gia tri goc
(if (not k0) (setq k0 1));;gan gia tri goc
(setq k (getreal (strcat "\n Nhap ty le cua ban ve:1/" (rtos k0 2 0) "")));Nhap ty le ban ve
(if (not k) (setq k k0) (setq k0 k))  
(defun dowith(lstSS / lstSS en str)
(cond  ((setq en  (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr (entget x))"*TEXT")) lstSS)))(setq str (acet-dxf 1 (entget en)) en (vlax-ename->vla-object en)))
 ((setq en (car (vl-remove-if-not '(lambda(x)(and (wcmatch (cdadr (entget x))"INSERT")(= (acet-dxf 66 (entget x)) 1))) lstSS)))
  (setq str (vla-get-textstring (setq en(car (vlax-invoke (vlax-ename->vla-object en) 'GetAttributes)))))
 )
)
(cons en str)
)
(grtext -1 "Free lisp from Cadviet @Ketxu")
(setq  lstSS (acet-ss-to-list (setq ss (ssget)))
 obj (car (setq en (dowith lstSS)))
 str (cdr en)
 p1 (getpoint "\nDiem goc :")
 eL (entlast)
oDz (getvar "Dimzin")
)
(setvar "DIMZIN" 0)
(while (setq p2 (getpoint p1 "\nDiem den :"))
(command "copy" ss "" p1 p2)
(while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(setq  Txt1 (car (dowith listName))
 eL (entlast)
)
(vla-put-textstring txt1
(strcat (cond ((> (setq num (+ (atof str) (/ (- (cadr p2)(cadr p1)) k))) 0) "+")
((= num 0) "%%p")
(T "")
  )
(rtos num  2 2));So chu so dau dau ;
)
)
(setvar "DIMZIN" oDZ)
)

[quoctuan903 4]

 

 

 

Vô cùng cảm ơn bạn ketxu. Cuối cùng tờ cũng thấy được thành Rome rồi. Lisp này thì bất kể ai dùng cũng được và tự tạo ký hiệu cos theo ý thích. một lần nữa cảm ơn ketxu. Chúc bạn vui vẻ

chán em quá, mỳ ăn liền ngon thế còn chưa biết ăn thế nào. anh có thể hướng dẫn em dùng cái lisp này không?

em đã bỏ cái dc=***center mặc định của cad để có thể gọi lisp, rồi em cũng tạo cái block có attribute ghi giá trị cao độ. xong thì nó diễn biến thế này:

Command: dc

 

Select objects: Specify opposite corner: 1 found

 

Select objects: ; error: no function definition: ACET-SS-TO-LIST

 

Command:

tức là chưa ra được kết quả. anh coi cái block em gửi rồi giúp em với ạ, cám ơn anh nhiều!

[ketxu 2.984]

Hàm acet-ss-to-list máy nào phải cài phụ trợ Express cho CAD mới có. Nếu máy bạn không có thì copy đoạn này vào sau dòng (vl-load-com) :

(defun acet-ss-to-list (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons e l))
 )
)

[kotarohp84 0]

Thật tuyệt vời, mình nhiều khi ko biết diễn tả câu hỏi nên tìm cái này từ rất lâu mà mãi mới tìm được, thanks ketxu và risusu vì câu hỏi và câu trả lời với lisp rất tiện ích :D

[quoctuan903 4]

anh ketxu à, chắc máy em không có express tool rồi nên không chạy được.

em làm như anh hướng dẫn thì lại báo lỗi sau:

"Command: DC

Select objects: 1 found

 

Select objects: ; error: no function definition: ACET-DXF

 

Command:"

em nhớ có lần em đã cài các thành phần còn thiếu của CAD mà không phải uninstall rồi reinstall, tức chọn lại các thành phần muốn cài đặt ròi nó sẽ cài cho mình như kiểu update vậy. Nhưng giờ không thể nào mò ra, ,có ai nhớ nhắc em với ạ, em muốn cài cái expresstool vào ạ!

[ketxu 2.984]

THêm dòng sau :

(defun acet-dxf (a e)(cdr (assoc a (entget e))))

vào sau đoạn thêm ở bài #32 bên trên

 

- THường thì bạn vào Control Panel, mục Program và kích vào phần mềm, có mục Change / Modify

[cuongcntn 0]

Các a cho em hỏi, sao em dùng lệnh dc này ở cos 0.000

sau khi nhấp toạ độ cao 3mét thì nó phải là 3.000 nhưng nó lại thành 3000.00

anh nào biết chỉnh ở đâu giúp em với ạ.

Thanks!

[2899nb 4]

Hề hề hề,

@ Bạn svxd: Mình mù tịt về ngôn ngữ lập trình nên ko biết thêm câu lệnh tỷ lệ bản vẽ vào chỗ nào. Các bạn có thể giúp mình hoàn thiện lisp này đc chứ. Cảm ơn nhiều.

Hề hề hề,

Các bạn hãy chịu khó đọc lại bài post mình đã trả lời bạn Lenhatanh nhé.

Có thề các bạn chưa hiểu hết về lisp, nhưng không có nghĩa là các bạn không biết gì. Bởi nếu vậy các bạn sẽ không thể sử dụng được lisp.

Việc tìm hiểu và cố gắng để hiểu mục đích của mỗi lisp là một việc mà bất cứ ai muốn dùng lisp đều phải có ý thức này. Bởi nó là con dao hai lưỡi, Nếu không hiểu về nó mà cứ xài bừa theo kiểu chùa thì sẽ có ngày các bạn ăn đòn to. Mỗi một lisp chỉ phù hợp với một mục tiêu nhất định đã đặt ra chứ không phải là dùng chung cho tất cả mọi ý đồ tương tự đâu. Mà ý định sử dụng của mỗi người lại luôn luôn là không đồng nhất. Vì thế để nó có thể phục vụ đúng ý của mình thì chả có cách chi ngoài cách chính các bạn phải hiểu và biết cách bổ sung hay chỉnh sửa nó cả.

Việc viết thêm mấy chữ chả phải việc khó khăn chi đâu nhưng mình và có nhẽ nhiều người khác trên diễn đàn cũng sẽ không muốn làm, vì như vậy chả có ích chi cho cả các bạn và người viết cả. Tại sao ư??? Tại vì người viết được chứng tỏ là đã dư xăng để hiểu và cũng chả cần học thêm cái chi ở công việc viết này, còn các bạn cũng sẽ chả học được cái chi từ cái việc lười và ỷ lại ấy. Giá như các bạn có cố gắng để hiểu và vận dụng nó cũng như có cố gắng để hiểu và chủ động trong công việc của mình thì sẽ không ai tiếc cái công sức để giúp đỡ các bạn đâu. Một việc tối thiểu là tìm hiểu về cái mình cần mà các bạn cũng không muốn thì quả thật là bó tay rồi, có giúp tới kiệt sức cũng sẽ là vô ích các bạn ạ.

Mà có phải là không có ai quan tâm giúp đỡ đâu, đã có bài trả lời và hướng dẫn mà theo mình thấy là không quá tệ để các bạn có thể tự tìm hiểu và áp dụng nhưng các bạn cũng chả thèm đọc thì biêt giúp cái chi nữa đây.

Vậy nên nếu như các bạn không đọc và không thử làm thoe hướng dẫn để xem nó ra cái chi chi thì cũng chả nên kêu ca hay nhờ vả ai nữa cả các bạn ạ.

Đầu năm mới, phải viết những dòng này còn cực hơn là viết thêm mấy chữ vào lisp, nhưng mình không thể làm thay các bạn được. Rất mong các bạn cố gắng tí ti để hoàn thiện công việc của chính các bạn.

Chúc các bạn thành công.

bạn có thể cho mình cái lisp như sau

tương tự như copy cao trình thôi

mình muốn copy theo chiều dài cụ thể như sau: copy 1 text có sẵn vị dụ là 150.00 ( là khoảng cách) đến 1 vị trí mới cách đó là L, sau khi thực hiện lệnh đến vị trí mới text đó tự động công thêm 1 khoảng cách là L cho mình

1. chọn đồi tượng text

2. pic vào điểm 1

3. pic vào điểm 2. Kết quả là text mới = text cũ + khoảng cách từ điểm 1 tới điểm 2

[2899nb 4]

bạn có thể giúp cho mình cái lisp như sau với:

tương tự như copy cao trình thôi

mình muốn copy theo chiều dài cụ thể như sau: copy 1 text có sẵn vị dụ là 150.00 ( là khoảng cách) đến 1 vị trí mới cách đó là L, sau khi thực hiện lệnh đến vị trí mới text đó tự động công thêm 1 khoảng cách là L cho mình

1. chọn đồi tượng text

2. pic vào điểm 1

3. pic vào điểm 2. Kết quả là text mới = text cũ + khoảng cách từ điểm 1 tới điểm 2

[Tot77 508]

Bạn thử cái này. muốn  bao nhiêu số lẻ thì trước khi chạy đánh luprec rồi cho số số lẻ.

 

(defun c:cpt (/ ss a b dis eg)
  (prompt "\nChon cac text:")
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT"))))))
a (getpoint "\nTu diem:")
b (getpoint a  "\nDen diem:")
dis (distance a b)
  )
  (setvar 'cmdecho 0)
  (princ (strcat "\nKhoang cach " (rtos dis)))
  (foreach v ss
    (command "copy" v "" "non" a "non" b)
    (setq  eg (entget (entlast)))
    (entmod (subst (cons 1 (rtos (+ dis (atof (cdr (assoc 1 eg)))))) (assoc 1 eg) eg))
  )
  (setvar 'cmdecho 1) (princ)
)

[2899nb 4]

thank ban , bạn có thể viết them vòng lặp được không tôi cần copy từ 1 vị trí đến nhiều vị trí khác

[ketxu 2.984]

Mình đã post rồi mà nhỉ

http://www.cadviet.com/forum/topic/113164-share-danh-cos-cao-do-tu-dong/

[Tot77 508]

Vòng lặp đây, muốn dứt thì enter.

 

(defun c:cpt (/ ss a b dis eg)
  (princ (strcat "\nHien tai la " (itoa (getvar 'luprec)) " so le."))
  (prompt "\nChon cac text:")
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT"))))))
a (getpoint "\nTu diem:")
  )
  (setvar 'cmdecho 0)
  
  (while (setq b (getpoint a  "\nDen diem "))
    (setq dis (distance a b))
    (princ (strcat "cach " (rtos dis)))
    (foreach v ss
      (command "copy" v "" "non" a "non" b)
      (setq  eg (entget (entlast)))
      (entmod (subst (cons 1 (rtos (+ dis (atof (cdr (assoc 1 eg)))))) (assoc 1 eg) eg))
    )
  )
  (setvar 'cmdecho 1) (princ)
)