Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#3681 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 22 June 2011 - 03:36 PM

cái lip này bác tặng em thì quá ok luôn nhưng khổ nỗi nó cứ có 2 số 0 ở sau đuôi cái số mà mình vừa ghi độ dốc ấy em tìm cách sửa mà bó tay bác à.bác giúp nốt em nhé
thank bác

Bác phamthanhbinh đi vắng, bạn sửa như dưới đây xem sao, sai bác ấy chịu. Hề, hề, hề!
Sửa dòng này:
(rtos doc 2 2)
Thành dòng này:
(rtos doc 2 0)
P/S (3h42): mới đó bác ấy đã về trên CADViet lại rồi!
  • 2

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


#3682 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 22 June 2011 - 03:38 PM

Bác phamthanhbinh đi vắng, bạn sửa như dưới đây xem sao, sai bác ấy chịu. Hề, hề, hề!
Sửa dòng này:
(rtos doc 2 2)
Thành dòng này:
(rtos doc 2 0)

để em thay phát .
thank bac đã nhé mau mau còn kịp
  • 0

#3683 ponaparte2003

ponaparte2003

    biết vẽ rectang

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

Đã gửi 22 June 2011 - 03:55 PM

thank bac đã quan tâm tới em nhưng 2 cái lip đó đều ko dùng dc bác à .
cai tra độ đốc nó ko ra %
cái pick cao độ thì em ko hiểu nó chạy như thế nào

Cái tra độ dốc như sau: lệnh "dg" dành cho trắc dọc với tỷ lệ 1:10, dùng lệnh này thì textstyle curent phải là có cao chữ >0, lệnh dgg dành cho bản vẽ thông thường, cái lệnh này thì text style "standard" để mặc định cao chữ là 0 (do đặc thù công việc của mình nên mình để thế). Bạn cứ pick vào 2 điểm cần tra độ dốc rồi chỉ vị trí đặt text là được
Cái pick cao độ thì như sau: gõ lệnh tg rồi chọn text (là số) làm mốc so sánh
gõ rd để ghi cao độ và khoảng cách của 1 điểm bất kỳ trên trắc ngang.
Bạn cứ thử toàn bộ các lệnh trong lisp đó để biết nó là gì nhé
  • 0
Y=acosh(x/a)

#3684 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 22 June 2011 - 08:29 PM

Hề hề hề,
Dây là cái lisp ghi độ dốc:


(defun c:gdd (/ en p1 p2 doc dd goc p txt et )
(command "undo" "be")
(setq en (car (entsel "\n Chon LINE can xac dinh do doc"))
p1 (cdr (assoc 10 (entget en)))
p2 (cdr (assoc 11 (entget en)))
doc (abs (* (/ (sin (angle p1 p2)) (cos (angle p1 p2))) 100))
dd (strcat (rtos doc 2 2) "%%%")
)
(if (and (> (angle p1 p2) (/ pi 2)) (< (angle p1 p2) (* pi 1.5)))
(setq goc (+ (angle p1 p2) pi))
(setq goc (angle p1 p2))
)
(setq txt (car (entsel "\n Chon text can ghi do doc")))
(if (= txt nil)
(progn
(setq p (getpoint "\n Pick diem can ghi do doc"))
(setq txt (car (entsel "\n Chon text mau")))
(if (/= txt nil)
(entmake (list (cons 0 "text") (assoc 40 (entget txt)) (cons 10 p) (assoc 8 (entget txt)) (assoc 7 (entget txt)) (cons 1 dd) (cons 50 goc)))
)
)
(progn
(setq et (entget txt)
et (subst (cons 1 dd) (assoc 1 et) et)
)
(entmod et)
)
)
(command "undo" "e")
(princ)
)


Hy vọng trúng ý bạn.
Lưu ý khi lisp yêu cầu Chon text can ghi do doc , nếu bạn khong muốn chọn text để thay thế mà muốn chọn điểm để ghi text mới thì cú việc nhấn Enter. Khi đó lisp sẽ yêu cầu bạn chọn điểm đặt text mới.
Còn nến bạn muốn thay thế text cũ thì phải chọn đúng vào text cần thay.
Khi lisp yêu cầu bạn Chon text mau thì bạn phải chọn đúng cái text mẫu có style, layer, chiều cao mà bạn muốn.
Chúc bạn vui.

bác bình ơi cái này không thể chọn đường dốc line bất kỳ hả bác . cứ phải chọn đúng đường line em đã gửi nhờ bác hả .
trong quá trình làm việc của em rất cần tính độ dốc của nhiều đường khác nhau chứ ko chỉ riền mỗi đường line em gửi lên.
cái líp bác viết cho em trên này chỉ cố định tính 1 đường line duy nhất mà thôi .
bác có thể sửa gipú em ko .thank bác nhiều
  • 0

#3685 gasmanc

gasmanc

    biết vẽ line

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

Đã gửi 22 June 2011 - 11:31 PM

Hề hề hề,
Bạn chờ cái chi nữa nhỉ??? Với hai cái lisp mình đã gửi, nếu bạn chú ý khi dùng thì hoàn toàn có thể thỏa mãn cả 3 yêu cầu bạn đã đặt ra rồi.
Này nhé:
Với yêu cầu 1: Bạn chạy cái lisp thứ 2 nhưng khi lisp hỏi nhập hằng số tính toán thì bạn nhập 0 và chọn phép tính cộng là OK.
Với yêu cầu 2: Bạn chạy cái lisp thứ 2 và nhập hằng số tính toán, phép tính theo ý bạn là Ok
Với yêu cầu 3: Bạn chạy cái lisp thứ 1 là OK.

Vậy thì bạn còn chờ chi nữa mà không dùng thử chúng coi sao hỉ???


mình test thử rồi. lisp rất ngon. yêu cầu thứ 1 và 2 thì giải quyết vậy là ổn. Nhưng yêu cấu thứ 3 là tách 1 số thập phân dạng A.B thành 3 đối tượng "A"; "." và "B" với vị trí so le nhau thì lisp chưa giải quyết được. Nếu có thể giải quyết được điểm này nữa thì mới thực sự tuyệt cú mèo. Vì bài toán của mình có lúc cần làm thao tác như vậy.
  • 0

#3686 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 23 June 2011 - 12:39 AM

bác bình ơi cái này không thể chọn đường dốc line bất kỳ hả bác . cứ phải chọn đúng đường line em đã gửi nhờ bác hả .
trong quá trình làm việc của em rất cần tính độ dốc của nhiều đường khác nhau chứ ko chỉ riền mỗi đường line em gửi lên.
cái líp bác viết cho em trên này chỉ cố định tính 1 đường line duy nhất mà thôi .
bác có thể sửa gipú em ko .thank bác nhiều

Hề hề hề,
Không phải đâu là khống phải đâu.
Cái nisp lày nó chạy với mọi LINE , chỉ có các polyline, Lwpolyline là nó chịu thua thôi.
Tại vì trên bản vẽ bạn post nó là LINE nên mình mới làm vậy. Nếu muốn nó chạy với Polyline hay LWpolyline thì mình phải làm khác rùi. Tuy nhiên với Polyline hay LWpolyline thì nó sẽ có thể có nhiều khúc, vậy bạn muốn lấy độ dốc của khúc nào nhể?????
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.

#3687 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 23 June 2011 - 12:44 AM

mình test thử rồi. lisp rất ngon. yêu cầu thứ 1 và 2 thì giải quyết vậy là ổn. Nhưng yêu cấu thứ 3 là tách 1 số thập phân dạng A.B thành 3 đối tượng "A"; "." và "B" với vị trí so le nhau thì lisp chưa giải quyết được. Nếu có thể giải quyết được điểm này nữa thì mới thực sự tuyệt cú mèo. Vì bài toán của mình có lúc cần làm thao tác như vậy.

Hề hề hề,
Ai bẩu bạn vậy??? Bạn đã chạy cái lisp thứ nhất mình viết chửa??? Cả cái lisp trong bài póst số 3863 trả lời bác Duy nữa.
Hãy chạy thử nó đi xem có phải nó so le "U NHƯ KỴ" không nhé. Chỉ sợ chạy xong bạn lại Ứ nhưng Ừ thì bỏ u ấy chứ.....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3688 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 23 June 2011 - 01:55 AM

mình test thử rồi. lisp rất ngon. yêu cầu thứ 1 và 2 thì giải quyết vậy là ổn. Nhưng yêu cấu thứ 3 là tách 1 số thập phân dạng A.B thành 3 đối tượng "A"; "." và "B" với vị trí so le nhau thì lisp chưa giải quyết được. Nếu có thể giải quyết được điểm này nữa thì mới thực sự tuyệt cú mèo. Vì bài toán của mình có lúc cần làm thao tác như vậy.

Hề hề hề,
Xin lỗi bạn vì hình như mình hiểu nhầm ý của bạn.
1/- Có phải bạn muốn có thêm text "." vào trong kết quả của lisp thứ nhất.
Nếu vậy bạn chỉ cần bổ sung thêm đoạn lisp tạo text:
(entmake (list (cons 0 "text") (assoc 8 el2) (cons 10 p0) (cons 11 p0) (assoc 40 el2) (assoc 7 el2) (cons 1 ".") (cons 72 1)))
vào sau đoạn code:
(entmod el1)
(entmod el2)

là được.
2/- Hay bạn muốn chuyển kết quả của lisp thứ 2, tức là đã có 3 text thẳng hàng "A" "." "B"(vì bạn nói là 3 đối tượng nên mình nghĩ là lisp thứ nhất đã thỏa mản do kết quả cũng gồm 3 đối tượng nhưng là 2 text với 1 point) và chuyển text "B" thành so le với text "A".
Nếu vậy bạn có` thể sửa lại cái lisp thứ hai để làm việv này như sau:
Thay đoạn code:
(setq el2 (subst (cons 73 0) (assoc 73 el2) el2)
el2 (subst (cons 10 (cdr (assoc 11 el2))) (assoc 10 el2) el2))

thành:
(setq el2 (subst (cons 73 3) (assoc 73 el2) el2)
el2 (subst (cons 11 (cdr (assoc 10 el2))) (assoc 11 el2) el2))

là OK. Bạn hãy tự làm thử xem nhé.
3/- Nếu bạn muốn từ một text "A.B" chuyển thành 3 text "A" "." "B" và text "B" so le với text "A" như mẫu bạn có thì hơi khó vì không xác định được vị trí tương đối của ký tự "." trong text do nó phụ thuộc vào các yêu tố đã nói trong các bài trước. Bạn sẽ phải chờ thêm để mọi người nghĩ mưu.
Hề hề hề, chúc bạn vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3689 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 23 June 2011 - 06:31 AM

Hề hề hề,
........
3/- Nếu bạn muốn từ một text "A.B" chuyển thành 3 text "A" "." "B" và text "B" so le với text "A" như mẫu bạn có thì hơi khó vì không xác định được vị trí tương đối của ký tự "." trong text do nó phụ thuộc vào các yêu tố đã nói trong các bài trước. Bạn sẽ phải chờ thêm để mọi người nghĩ mưu.
Hề hề hề, chúc bạn vui.

Chào bác PhamThanhBinh, gasmanc
Khi tách thành 3 Text riêng biệt ra thì theo file mà bạn gasmanc đã upload thì dấu chấm thập phân và anh Text nằm bên trái vẫn giữ nguyên vị trí của nó, còn các anh Text nằm bên phải dịch xuống 1 khoảng đúng bằng chiều cao của Text.
Tue_NV có bổ sung thêm code vào code của bác PhamThanhBinh. Bạn Gasmanc thử xem sao :

(defun c:chgev (/ psl tsl hs key_ctnc1 key_ctnc p0 p1 el1 el2 el3 el4 t_right t3 t4 ts htxt num vt )
(vl-load-com)
(command "undo" "be")
(setq UC (getvar "ucsname"))
(command "ucs" "World")
(alert "\n Chon tap hop diem can thay doi cao do")
(setq psl (acet-ss-to-list (ssget (list (cons 0 "POINT")))))
;;;; (setq tsl (acet-ss-to-list (ssget "W" pt1 pt2 (list (cons 0 "TEXT")))))
(setq hs (getreal "\n Nhap hang so tinh toan: "))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(setq t_right (ssadd) )
(foreach p psl
(setq p0 (cdr (assoc 10 (entget p))))
(setq pt1 (list (- (car p0) 1) (- (cadr p0) 2)))
(setq pt2 (list (+ (car p0) 1) (+ (cadr p0) 2)))
(setq tsl (acet-ss-to-list (ssget "C" pt1 pt2 (list (cons 0 "TEXT")))))
(foreach txt tsl
(setq p1 (cdr (assoc 11 (entget txt))))
(if (= (cadr p1) (cadr p0))
(progn
(if (equal (- (car p0) (car p1)) 0.4 0.001)
(progn
(setq el1 (entget txt))
(setq t1 (cdr (assoc 1 el1)))
(setq t_left (ssadd txt t_left))
)
)
(if (equal (- (car p1) (car p0)) 0.4 0.001)
(progn
(setq el2 (entget txt))
(setq t2 (cdr (assoc 1 el2 )))
(setq t_right (ssadd txt t_right))
)
)
)
)
)
(if (and t1 t2)
(progn
(entmake (list (cons 0 "text") (assoc 8 el2) (cons 10 p0) (cons 11 p0) (assoc 40 el2) (assoc 7 el2)
(cons 1 ".") (cons 72 1)))
(setq ts (entlast))
(setq el2 (subst (cons 73 0) (assoc 73 el2) el2)
el2 (subst (cons 10 (cdr (assoc 11 el2))) (assoc 10 el2) el2))
(entmod el2)
(setq num (congtrunhanchia key_ctnc (atof (strcat t1 "." t2)) hs)) ;
(setq htxt (rtos num 2 2)
vt (vl-string-position (ascii ".") htxt)
t3 (substr htxt 1 vt)
t4 (substr htxt (+ vt 2))
el1 (subst (cons 1 t3) (assoc 1 el1) el1)
el2 (subst (cons 1 t4) (assoc 1 el2) el2)
)
(entmod el1)
(entmod el2)
)
)
)
(setq hei (cdr(assoc 40 el2)))
(initget "Y N")
(setq ans (getkword "thuc hien tach lai theo Step 3 < Y/N > :"))
(if (= ans "Y")
(progn
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "move" t_right "" '(0.0 0.0 0.0) (list 0.0 (- hei) 0.0))
(setvar "osmode" oldos)
)
)
(command "ucs" uc)
(command "undo" "e")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)

Còn đây là yêu cầu về ghi độ dốc của bạn HakhoaiLang

(defun c:gdd (/ en p1 p2 doc dd goc p txt et a)
(setq p (getpoint "Chon 1 diem tren LINE can xac dinh do doc :"))

(setq en (car (nentselp p)))
(IF (wcmatch (cdr(assoc 0 (entget en))) "LINE,LWPOLYLINE,VERTEX")
(PROGN
(if (= (cdr(assoc 0 (entget en))) "VERTEX")
(Progn (command "undo" "M") (command "convert" "P" "S" en "") (setq en (entlast) a t) )
)

(setq
p1 (vlax-curve-getpointatparam en (fix (vlax-curve-getparamatpoint en p)) )
p2 (vlax-curve-getpointatparam en (+ 0.001 (fix (vlax-curve-getparamatpoint en p))))
doc (abs (* (/ (sin (angle p1 p2)) (cos (angle p1 p2))) 100))
dd (strcat (rtos doc 2 2) "%%%")
)
(if a (command "undo" "B"))
(if (and (> (angle p1 p2) (/ pi 2)) (< (angle p1 p2) (* pi 1.5)))
(setq goc (+ (angle p1 p2) pi))
(setq goc (angle p1 p2))
)
(setq txt (car (entsel "\n Chon text can ghi do doc")))
(if (= txt nil)
(progn
(setq p (getpoint "\n Pick diem can ghi do doc"))
(setq txt (car (entsel "\n Chon text mau")))
(if (/= txt nil)
(entmake (list (cons 0 "text") (assoc 40 (entget txt)) (cons 10 p) (assoc 8 (entget txt)) (assoc 7

(entget txt)) (cons 1 dd) (cons 50 goc)))
)
)
(progn
(setq et (entget txt)
et (subst (cons 1 dd) (assoc 1 et) et)
)
(entmod et)
)
)
))

(princ)
)

  • 3

#3690 hugo007

hugo007

    biết lệnh erase

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

Đã gửi 23 June 2011 - 07:25 AM

Mong bác Tue vào giúp e và t031285 lisp do bác viết:
http://www.cadviet.c...opic=8809&st=20
Bài 21 bác ah.Thanks.
  • 0

#3691 tranhoangxd

tranhoangxd

    biết vẽ circle

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

Đã gửi 23 June 2011 - 02:32 PM

các bác cho em hỏi
em muốn tìm cái lisp mà no gõ lệnh nhanh để chuyển về layer mình muôn chọn
hình như là gõ 1 , 2, 3... gì đó
em tìm mãi mà ko thấy
với là em muốn hỏi thêm một điều nữa là tại sao cad lập trình sẵn cho scale lưu lại tỉ lệ scale lần trước, còn move, hay stretch lại ko là sao??
  • 0

#3692 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 June 2011 - 03:28 PM

với là em muốn hỏi thêm một điều nữa là tại sao cad lập trình sẵn cho scale lưu lại tỉ lệ scale lần trước, còn move, hay stretch lại ko là sao??

Mình đã gửi câu hỏi của bạn đến Autodesk :excl:
Còn yêu cầu của bạn có quá trời trên diễn đàn, không biết bạn đã thực sự tìm chưa, hay là viết request thì thấy nhanh hơn ??

(defun c:1 () (setvar "clayer" "Tên layer"))


  • 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


#3693 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 23 June 2011 - 04:07 PM

em muốn hỏi thêm một điều nữa là tại sao cad lập trình sẵn cho scale lưu lại tỉ lệ scale lần trước, còn move, hay stretch lại ko là sao??

Theo thiển ý của tôi:
1- Các lệnh Scale/Rotate/Offset... xác định bởi 1 giá trị. Giá trị này có thể được dùng cho lần tiếp theo nên được mặc định.
2- Các lệnh Copy/Move/Stretch... xác định bởi 2 tùy chọn:
2a). Khi chọn là [Displacement] thì giá trị này cũng có thể được sử dụng cho lần sau nên vẫn được mặc định, dưới dạng deltaX, deltaY, deltaZ.
2b). Khi chọn là 2 points thì không mặc định là vì nếu mặc định thì trở về trường hợp 2a).
  • 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.


#3694 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 23 June 2011 - 10:04 PM

Mong bác Tue vào giúp e và t031285 lisp do bác viết:
http://www.cadviet.c...opic=8809&st=20
Bài 21 bác ah.Thanks.

Hề hề hề,
Bạn vào đó xem lại đi nhé. Đã có trả lời rồi đó.
Cách tìm của mình hơi củ chuối là:
1/- mở CAD rồi tạo một style mang tên "STNAME" có`cái font mà mình khoái.
2/- dùng (setq fon (cdr (assoc 3 (tblsearch "style" "stname")))) là có được cái mình cần....
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.

#3695 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 23 June 2011 - 10:15 PM

Chào bác PhamThanhBinh, gasmanc
Khi tách thành 3 Text riêng biệt ra thì theo file mà bạn gasmanc đã upload thì dấu chấm thập phân và anh Text nằm bên trái vẫn giữ nguyên vị trí của nó, còn các anh Text nằm bên phải dịch xuống 1 khoảng đúng bằng chiều cao của Text.
Tue_NV có bổ sung thêm code vào code của bác PhamThanhBinh. Bạn Gasmanc thử xem sao :


(defun c:chgev (/ psl tsl hs key_ctnc1 key_ctnc p0 p1 el1 el2 el3 el4 t_right t3 t4 ts htxt num vt )
(vl-load-com)
(command "undo" "be")
(setq UC (getvar "ucsname"))
(command "ucs" "World")
(alert "\n Chon tap hop diem can thay doi cao do")
(setq psl (acet-ss-to-list (ssget (list (cons 0 "POINT")))))
;;;; (setq tsl (acet-ss-to-list (ssget "W" pt1 pt2 (list (cons 0 "TEXT")))))
(setq hs (getreal "\n Nhap hang so tinh toan: "))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(setq t_right (ssadd) )
(foreach p psl
(setq p0 (cdr (assoc 10 (entget p))))
(setq pt1 (list (- (car p0) 1) (- (cadr p0) 2)))
(setq pt2 (list (+ (car p0) 1) (+ (cadr p0) 2)))
(setq tsl (acet-ss-to-list (ssget "C" pt1 pt2 (list (cons 0 "TEXT")))))
(foreach txt tsl
(setq p1 (cdr (assoc 11 (entget txt))))
(if (= (cadr p1) (cadr p0))
(progn
(if (equal (- (car p0) (car p1)) 0.4 0.001)
(progn
(setq el1 (entget txt))
(setq t1 (cdr (assoc 1 el1)))
(setq t_left (ssadd txt t_left))
)
)
(if (equal (- (car p1) (car p0)) 0.4 0.001)
(progn
(setq el2 (entget txt))
(setq t2 (cdr (assoc 1 el2 )))
(setq t_right (ssadd txt t_right))
)
)
)
)
)
(if (and t1 t2)
(progn
(entmake (list (cons 0 "text") (assoc 8 el2) (cons 10 p0) (cons 11 p0) (assoc 40 el2) (assoc 7 el2)
(cons 1 ".") (cons 72 1)))
(setq ts (entlast))
(setq el2 (subst (cons 73 0) (assoc 73 el2) el2)
el2 (subst (cons 10 (cdr (assoc 11 el2))) (assoc 10 el2) el2))
(entmod el2)
(setq num (congtrunhanchia key_ctnc (atof (strcat t1 "." t2)) hs)) ;
(setq htxt (rtos num 2 2)
vt (vl-string-position (ascii ".") htxt)
t3 (substr htxt 1 vt)
t4 (substr htxt (+ vt 2))
el1 (subst (cons 1 t3) (assoc 1 el1) el1)
el2 (subst (cons 1 t4) (assoc 1 el2) el2)
)
(entmod el1)
(entmod el2)
)
)
)
(setq hei (cdr(assoc 40 el2)))
(initget "Y N")
(setq ans (getkword "thuc hien tach lai theo Step 3 < Y/N > :"))
(if (= ans "Y")
(progn
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "move" t_right "" '(0.0 0.0 0.0) (list 0.0 (- hei) 0.0))
(setvar "osmode" oldos)
)
)
(command "ucs" uc)
(command "undo" "e")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)


Hề hề hề,
Vấn đề mình đặt ra ở đây là đầu tiên chỉ có 1 text dạng thập phân "A.B" chứ không phải đã có 3 text là "A" "." "B". Như vậy tách cái text này thành 3 text là "A" "." "B" thì không khó. Nhưng tách xong phải đặt lại 3 text này vào đúng vị trí cũ như khi còn là một text mới là oái oăm bác ạ.
Hề hề hề.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3696 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 23 June 2011 - 10:23 PM

Hề hề hề,
Không phải đâu là khống phải đâu.
Cái nisp lày nó chạy với mọi LINE , chỉ có các polyline, Lwpolyline là nó chịu thua thôi.
Tại vì trên bản vẽ bạn post nó là LINE nên mình mới làm vậy. Nếu muốn nó chạy với Polyline hay LWpolyline thì mình phải làm khác rùi. Tuy nhiên với Polyline hay LWpolyline thì nó sẽ có thể có nhiều khúc, vậy bạn muốn lấy độ dốc của khúc nào nhể?????
Hề hề hề,

bác bình và bác tuệ ơi theo ý tưởng của em như thế này có dc ko , ko cần biết là line hay pline chỉ cần kích 2 điểm bất kỳ trên đường thẳng đó là tính dc độ dốc
2 bác thấy ý tưởng của em thế nào .
khi ghi độ dốc vào text thì phần thập phân đằng sau dấu phẩy nếu lớn hơn 0 thì điền vào .còn bằng 0 thì chỉ lấy mỗi số nguyên không có hàng thập phân .
ví dụ như nếu dộ dốc là 5,7 thì text sẽ là 5,7%
còn dộ dốc là 5 thì text sẽ ghi là 5%
bác thấy ý tưởng của em thế nào .
như thế này cho nó đỡ rối rắm phải đường này đường nọ .
cad có chế độ bắt điểm thì kiểu gì mà nó chả bắt trúng 2 điểm trên đường thẳng . đúng ko 2 bác.
thank 2 bác đã thương em .
nhé
  • 0

#3697 gasmanc

gasmanc

    biết vẽ line

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

Đã gửi 23 June 2011 - 10:40 PM

Chào bác PhamThanhBinh, gasmanc
Khi tách thành 3 Text riêng biệt ra thì theo file mà bạn gasmanc đã upload thì dấu chấm thập phân và anh Text nằm bên trái vẫn giữ nguyên vị trí của nó, còn các anh Text nằm bên phải dịch xuống 1 khoảng đúng bằng chiều cao của Text.
Tue_NV có bổ sung thêm code vào code của bác PhamThanhBinh. Bạn Gasmanc thử xem sao :


(defun c:chgev (/ psl tsl hs key_ctnc1 key_ctnc p0 p1 el1 el2 el3 el4 t_right t3 t4 ts htxt num vt )
(vl-load-com)
(command "undo" "be")
(setq UC (getvar "ucsname"))
(command "ucs" "World")
(alert "\n Chon tap hop diem can thay doi cao do")
(setq psl (acet-ss-to-list (ssget (list (cons 0 "POINT")))))
;;;; (setq tsl (acet-ss-to-list (ssget "W" pt1 pt2 (list (cons 0 "TEXT")))))
(setq hs (getreal "\n Nhap hang so tinh toan: "))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(setq t_right (ssadd) )
(foreach p psl
(setq p0 (cdr (assoc 10 (entget p))))
(setq pt1 (list (- (car p0) 1) (- (cadr p0) 2)))
(setq pt2 (list (+ (car p0) 1) (+ (cadr p0) 2)))
(setq tsl (acet-ss-to-list (ssget "C" pt1 pt2 (list (cons 0 "TEXT")))))
(foreach txt tsl
(setq p1 (cdr (assoc 11 (entget txt))))
(if (= (cadr p1) (cadr p0))
(progn
(if (equal (- (car p0) (car p1)) 0.4 0.001)
(progn
(setq el1 (entget txt))
(setq t1 (cdr (assoc 1 el1)))
(setq t_left (ssadd txt t_left))
)
)
(if (equal (- (car p1) (car p0)) 0.4 0.001)
(progn
(setq el2 (entget txt))
(setq t2 (cdr (assoc 1 el2 )))
(setq t_right (ssadd txt t_right))
)
)
)
)
)
(if (and t1 t2)
(progn
(entmake (list (cons 0 "text") (assoc 8 el2) (cons 10 p0) (cons 11 p0) (assoc 40 el2) (assoc 7 el2)
(cons 1 ".") (cons 72 1)))
(setq ts (entlast))
(setq el2 (subst (cons 73 0) (assoc 73 el2) el2)
el2 (subst (cons 10 (cdr (assoc 11 el2))) (assoc 10 el2) el2))
(entmod el2)
(setq num (congtrunhanchia key_ctnc (atof (strcat t1 "." t2)) hs)) ;
(setq htxt (rtos num 2 2)
vt (vl-string-position (ascii ".") htxt)
t3 (substr htxt 1 vt)
t4 (substr htxt (+ vt 2))
el1 (subst (cons 1 t3) (assoc 1 el1) el1)
el2 (subst (cons 1 t4) (assoc 1 el2) el2)
)
(entmod el1)
(entmod el2)
)
)
)
(setq hei (cdr(assoc 40 el2)))
(initget "Y N")
(setq ans (getkword "thuc hien tach lai theo Step 3 < Y/N > :"))
(if (= ans "Y")
(progn
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "move" t_right "" '(0.0 0.0 0.0) (list 0.0 (- hei) 0.0))
(setvar "osmode" oldos)
)
)
(command "ucs" uc)
(command "undo" "e")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)


Nhờ Tue xem lại hộ mình, sao mình ko dùng được lisp của Tue vậy?
khi mình test thử thì nó xảy ra lỗi thế này: Cong/Tru/Nhan/cHia [C/T/N/H] <C>: t ; error: bad argument type: lselsetp nil
Mình test trên bản vẽ minh hoạ hôm trước mình up lên.

thứ 2 nữa là, nhờ bạn Tue và Phamthanhbinh tích hợp thêm cho lisp có thể trừ tất cả text số (chú ý là các text số rời rạc ở các vị trí ngẫu nhiên, hướng xoay ngẫu nhiên) cho 1 hằng số, kết quả trả trả về được ghi lại ở đúng vị trí của text bị trừ và góc xoay của text không đổi. mở rộng cho cả 4 phép tính cộng/trừ/ nhân/ chia thì càng tốt.
Điều cốt lõi nhất là góc xoay của text không đổi và nếu kết quả trả về được ghi ở dạng số thập phân làm tròn 2 số sau dấu phẩy thì thật tuyệt.
  • 0

#3698 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 23 June 2011 - 11:13 PM

vâng .đã nghe rõ .sorry.
mong muốn là muốn mong thôi các bác .
ước mơ để mơ ước đến nhanh thêm một tý thôi .
vì cũng đã và đang vất vả và vật vã nên nó mới vạ vật như thế bác à .bác thông cảm cho em nhé.
  • 0

#3699 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 23 June 2011 - 11:14 PM

Nhờ Tue xem lại hộ mình, sao mình ko dùng được lisp của Tue vậy?
khi mình test thử thì nó xảy ra lỗi thế này: Cong/Tru/Nhan/cHia [C/T/N/H] <C>: t ; error: bad argument type: lselsetp nil
Mình test trên bản vẽ minh hoạ hôm trước mình up lên.

Hề hề hề,
Có nhẽ đây là lỗi do cái biến key_ctnc mà ra. Vì khi bạn nhập t có thể lisp sẽ hiểu nhầm là một biến logic chứ không phải cái key.
Bạn có thể đổi cái key này đi bằng một chử cái khác xem sao nhé.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3700 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 23 June 2011 - 11:20 PM

bác bình ơi đã trót thì trét luôn cho em nhé sửa dùm em cái lip đó bác nhé
  • 0