Đế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

#1901 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 September 2010 - 06:34 AM

-Cám ơn Bạn Tue_nv đã quan tâm nhé, nhờ Tue chỉnh lại lisp theo như hình ảnh mình up lên đây nhé:
- Cụ thể : + Tue chỉnh lại cho mình số đo góc anpha
+ Chỉnh cho dòng text chứa số đo góc anpha có Width factor= 0.7 nhé (mục đích là muốn cho nó vừa gọn vào vòng tròn Tue à)
-Cám ơn Tue nhé
Hình đã gửi

Của bạn đây :


(defun vtt(/ oldos)
  (setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(princ "\n Chon 1 cung Arc :")
(if (null (setq ss (ssget ":S" '((0 . "ARC"))) ))
(alert "\n Khong co cung Arc nao duoc chon ")
(progn
(setq ent (ssname ss 0))
    (setq tam (cdr(assoc 10 (entget ent))))
(setq D (cdr(assoc 40 (entget ent))));bankinh
    (setq dd (vlax-curve-getstartpoint ent))
    (setq dc (vlax-curve-getendpoint ent))
    (setq p1 (polar dd (+ (/ pi 2) (angle dd tam)) 1))
    (setq p2 (polar dc (+ (/ pi 2) (angle dc tam)) 1))
    (if (setq a (inters dd p1 dc p2 nil))
      (progn
        (vl-cmdf "line" dd a "")
        (vl-cmdf "line" dc a "")
(setq c (- 180 (/ (* 180 (abs (- (angle dd a) (angle dc a)))) pi)))
      )
    )
))
  (setvar "osmode" oldos)
(princ)
)
;;;;;;;;
(defun C:TS (/ ro CC CAT MD CD C D N L do ph O M I H J AA RR KK TT PP ss)
(SETVAR "CMDECHO" 0)
(command "-Style" "TS DUONG CONG" "arial" "0" "1" "0" "n" "")
(command "-Layer" "n" "TS DUONG CONG" "c" "222" "TS DUONG CONG" "lw" "0.2" "TS DUONG CONG" "")
(command "-Layer" "s" "TS DUONG CONG" "" "")
(setq CC (getpoint "\nCHON TAM CUA DUONG TRON / Enter ket thuc "))
(setq CAT (getreal "\nDUONG KINH DUONG TRON: "))
(while CC
(command ".circle" CC "d" CAT) (vtt)
(if ss (progn
(setq L (strcat "{\\fSymbol|b0|i0|c2|p18;\\T0.7;a\\fArial|b0|i0|c0|p34;="
(itoa (setq do (fix c)) ) "%%d"
(itoa (setq ph (fix (* 60 (- c do))))) "'"
(itoa (fix (* 60 (- (* 60 (- c do)) ph)))) "''"
)
)
(setq N (rtos D 2 2))
(setq H (COS (/ (/ (* C PI) 180) 2))) ;CONG THUC TINH GIA TRI COS(A/2)
(setq O (/ (SIN (/ (/ (* C PI) 180) 2)) (COS (/ (/ (* C PI) 180) 2)))) ;CONG THUC TINH GIA TRI TAN(A/2)
(setq M (rtos (* O D) 2 2)) ;CONG THUC TINH GIA TRI T
(setq I (rtos (* D (- (/ 1 H) 1)) 2 2)) ;CONG THUC TINH GIA TRI P
(setq J (rtos (/ (* D C PI) 180) 2 2)) ;CONG THUC TINH GIA TRI K
(setq AA L) ;GIA TRI A
(setq RR (strcat "R=" N)) ;GIA TRI R
(setq KK (strcat "K=" J)) ;GIA TRI K
(setq TT (strcat "T=" M)) ;GIA TRI T
(setq PP (strcat "P=" I)) ;GIA TRI P
(setq MD (/ CAT 10))
(setq CD (list (car CC) (+ (cadr CC) (/ CAT 3.1))))
(command ".text" "m" CD MD 0.0 AA) (setq e (entlast)) ;TEXT GIA TRI A
(command ".text" "" RR) ;TEXT GIA TRI R
(command ".text" "" KK) ;TEXT GIA TRI K
(command ".text" "" TT) ;TEXT GIA TRI T
(command ".text" "" PP) ;TEXT GIA TRI P
;(entmod (subst (cons 41 0.7) (assoc 41 (entget e)) (entget e) ))
(command "txt2mtxt" e "")
(setq CC (getpoint "\nCHON TAM CUA DUONG TRON: "))
))
) ;dong WHILE
(SETVAR "CMDECHO" 1)
(PRINC)
) ;KET THUC DEFUN

------------

2 bác,vì lúc đưa ý kến e lấy trường hợp cụ thể mà bạn ấy yêu cầu là các cạnh tim trục vuông góc với nhau(đa số),nên khoảng cách fix luôn như vậy.Còn nếu trục tim chéó đi thì không thể dùng kcách cố định như vậy được.Có lẽ phải cho nó nằm trong khoảng từ 0 đến bề rộng tường.:(
.......

các cạnh tim trục vẫn vuông góc với nhau nhưng tim trục X, Y xoay đi 1 góc a khác 0 thì Lisp cũng không còn đúng nữa
  • 1

#1902 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 September 2010 - 07:29 AM

Của bạn đây :




------------

các cạnh tim trục vẫn vuông góc với nhau nhưng tim trục X, Y xoay đi 1 góc a khác 0 thì Lisp cũng không còn đúng nữa

Quả có vậy..Có lẽ không thể dựa vào thằng UCS WORLD được,mà phải xét góc tương đối giữa 2 line liền nhau ?
  • 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


#1903 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 23 September 2010 - 07:34 AM

À,e xin ý kiến là bề rộng tường nếu getint thì với trường hợp vẽ có tỉ lệ khác 1:1 thì user hơi khổ ^^.Nếu có hàm nhỏ để user thay đổi tỉ lệ vẽ,khi nhận giá trị int thì chia cho tỉ lệ cũng được.

Sử dụng hàm getreal là được rồi
  • 0

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#1904 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 September 2010 - 09:39 AM

Sử dụng hàm getreal là được rồi

Ấy,getreal thì người nhập lại ngồi chia tỉ lệ ạ :( Ý e là có phần set tỉ lệ mặc định bên trên,để ng nhập cứ nhập giá trị thực vào thôi,rồi lúc nào cần thì thay đổi tỉ lệ
  • 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


#1905 saobang240286

saobang240286

    biết zoom

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

Đã gửi 23 September 2010 - 09:41 AM

Chào mọi người!
  • 0

#1906 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 September 2010 - 09:43 AM

Ấy,getreal thì người nhập lại ngồi chia tỉ lệ ạ :( Ý e là có phần set tỉ lệ mặc định bên trên,để ng nhập cứ nhập giá trị thực vào thôi,rồi lúc nào cần thì thay đổi tỉ lệ

Hàm getreal vừa cho ta nhập số thực vừa cho ta nhập kiểu phép tính.
Ví dụ :
(getreal "\n Nhap so :")
Nhap so :5/2
-> Ketxu nhập 5/2 vào xem
  • 0

#1907 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 September 2010 - 09:56 AM

Vâng,nhưng ý em là set tỉ lệ ban đầu để người vẽ không phải nhập đi nhập ại đoạn "/tile" .E vẽ model nên căm thù thao tác này ^^
Với trưoờng hợp này thì chỉ thực hiện thao tác 1 lần thì đúng là chưa cần thiết :(
  • 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


#1908 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 September 2010 - 10:27 AM

Vâng,nhưng ý em là set tỉ lệ ban đầu để người vẽ không phải nhập đi nhập ại đoạn "/tile" .E vẽ model nên căm thù thao tác này ^^
Với trưoờng hợp này thì chỉ thực hiện thao tác 1 lần thì đúng là chưa cần thiết :(

Bạn thử cái này :
(defun c:tl(/ tle)
(or *tle* (setq *tle* 1))
(setq tle (getreal (strcat "\nNhap ti le < "
(rtos *tle* 2 2)
" > :"
)
)
)
(if tle (setq *tle* tle) (setq tle *tle*))
(alert (strcat "Ti le vua nhap la : " (rtos tle 2 2)))
)
-> Lisp lưu lại biến *tle* để sử dụng cho lần sau
  • 1

#1909 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 23 September 2010 - 10:37 AM

Bạn thử cái này :

(defun c:tl(/ tle)
(or *tle* (setq *tle* 1))
(setq tle (getreal (strcat "\nNhap ti le < "
(rtos *tle* 2 2)
" > :"
)
)
)
(if tle (setq *tle* tle) (setq tle *tle*))
(alert (strcat "Ti le vua nhap la : " (rtos tle 2 2)))
)
-> Lisp lưu lại biến *tle* để sử dụng cho lần sau

Mình chưa hiểu đoạn này của bạn (if tle (setq *tle* tle) (setq tle *tle*)). Mình hay dùng là (if (null tle) ..... ). Biến tle có cho giá trị T hay nill không?
dt
  • 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!

#1910 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 September 2010 - 10:42 AM

Mình chưa hiểu đoạn này của bạn (if tle (setq *tle* tle) (setq tle *tle*)). Mình hay dùng là (if (null tle) ..... ). Biến tle có cho giá trị T hay nill không?
dt

Dòng này :
(if tle (setq *tle* tle) (setq tle *tle*))
tương đương với
(if (null (null tle)) (setq *tle* tle) (setq tle *tle*))

phủ định của sự phủ định là sự khẳng định -> Tue_NV khẳng định luôn đó mà.
(if tle.... )-> biểu thức logic có nghĩa là kiểm tra sự tồn tại của biến tle. Nếu biến tle có tồn tại thì biểu thức logic là T, ngược lại là nil
Hy vọng bạn phamngoctukts hiểu :(
  • 0

#1911 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 23 September 2010 - 11:27 AM

Dòng này :
(if tle (setq *tle* tle) (setq tle *tle*))
tương đương với
(if (null (null tle)) (setq *tle* tle) (setq tle *tle*))

phủ định của sự phủ định là sự khẳng định -> Tue_NV khẳng định luôn đó mà.
(if tle.... )-> biểu thức logic có nghĩa là kiểm tra sự tồn tại của biến tle. Nếu biến tle có tồn tại thì biểu thức logic là T, ngược lại là nil
Hy vọng bạn phamngoctukts hiểu :(

Cám ơn bạn mình đã hiểu. Mình quên mất là hàm getreal khi không nhập số liệu thì trả về nil. Thank
  • 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!

#1912 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 September 2010 - 02:49 PM

- Cám ơn PhamThanhBinh mình đã thử lisp mà bạn gửi cho mình thấy có một số bất cập sau:
+ Khi thử đối với các điểm 1 và 2 (của hình A) thì cho ra gần đúng kết quả như hình B khác mỗi là 2 đường thằng màu xanh nằm ngang phía dưới cũng bị xóa luôn theo
+ Khi thử với các điểm bất kỳ khác thì thấy nó cho kết quả là xóa luôn cọc ở điểm đầu và cọc ở điểm cuối khi mình chọn , đồng thời cũng xáo luôn cả 2 đường thằng màu xanh nằm ngang phía dưới
- Mà bạn PhamThanhBinh này : trong hình ảnh mình đưa lên đó cái cọc 1 và 2 mình đánh số và khoanh tròn chỉ là để cho bạn dễ nhìn và dễ hình dung thôi chứ bản vẽ ban đầu ko có.
- Mình đã thử và nhận thấy nếu cứ để vòng tròn ở hai điểm đầu và cuối thì nó ko xóa đi cọc đầu và cọc cuối còn ko có vòng tròn đó thì nó xóa luôn cọc đầu và cuối. Mong PhamThanhBinh xem lại và chỉnh lại cho mình nhé. Cám ơn nha

Chào bạn Bachngoctung,
Thực ra mình cũng chưa hiểu vì sao có lỗi này. Bởi vì khi mình chạy thử trên file bạn gửi thì không thấy có vấn đề như vậy. Bây giờ chạy lại thì lại bì dính đòn.
Để giải quyết cái lỗi này mình thử thay thế các giá trị 0.01 trong lisp thành 0.02 thì nó lại chạy bon bon. Có nghĩa là theo mình hiểu thì lỗi là do các biến hệ thống trên máy của bạn. Cụ thể là biến gì thì mình chưa rõ nhưng cái biến đó nó làm cho việc chọn đối tượng theo các cửa sổ bị sai trật với cái mình muốn do sai số lựa chọn điểm bạn ạ. Khi tăng cái khoảng sai lệch này lên thì nó không chọn nhầm nữa. Chỉ đơn giản là vậy.
Và đây là cái mình chạy ra sau khi thay đổi như trên bạn ạ.
http://www.cadviet.c...cadviet_111.dwg
Lisp đã sửa như sau:

(defun c:HCM ( / p1 p2 p3 p4 p5 p6 p7 p8 p11 ss1 ss2 ss3 en els pt txt)
(command "undo" "be")
(setq p1 (getpoint "\n Chon diem dau")
p2 (getpoint "\n Chon diem cuoi")
p3 (list (car p1) (- (cadr p1) 8) (caddr p1))
p4 (list (- (car p2) 0.02) (- (cadr p2) 7.98) (caddr p2))
p5 (list (car p1) (- (cadr p1) 4) (caddr p1))
p6 (list (- (car p2) 0.02) (-(cadr p2) 3.98) (caddr p2))
p7 (list (+ (car p1) 0.02) (- (cadr p1) 6.02) (caddr p1))
p8 (list (car p2) (- (cadr p2) 6) (caddr p2))
p11 (list (+ (car p1) 0.02) (cadr p1) (caddr p1))
ss1 (ssget "c" p11 p6 (list (cons 8 "LINEDONGTN")))
ss2 (ssget "w" p5 p8 (list (cons 0 "TEXT")))
ss3 (ssget "c" p7 p4 (list (cons 0 "TEXT,LINE")))
en (car (entsel "\n Chon text can thay the"))
els (entget en)
pt (cdr (assoc 11 els))
pt (list (+ (car pt) 0.8) (- (cadr pt) 0.8) (caddr pt))
txt (rtos (- (car p2) (car p1)) 2 2)
ss3 (ssdel en ss3)
)
(command "erase" ss1 ss2 ss3 "")
(setq els (subst (cons 1 txt) (assoc 1 els) els)
els ( subst (cons 50 0) (assoc 50 els) els)
els (subst (cons 11 pt) (assoc 11 els) els)
)
(entmod els)
(entupd en)
(command "undo" "e")

(princ)
)


Nếu bạn kiểm tra vẫn thấy nó bị xóa đi các cọc chọn thì bạn hãy tăng giá tri 0.02 thành 0.05 bạn nhé. Chúc bạn hài lòng....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1913 tuananhlt02

tuananhlt02

    Chưa sử dụng CAD

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

Đã gửi 23 September 2010 - 02:58 PM

Cuối cùng thì mình cũng viết xong lisp này cho bạn rồi này. Chúc bạn vui và làm việc hiệu quả.


(defun c:vetuong ()
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setq tbl (tblsearch "layer" "template"))
(if (= tbl nil) (command "-layer" "n" "template" "c" "0" "template" ""))
(setvar "clayer" "template")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(setq day (getint "\nnhap chieu day tuong:"))
(setq cg (fix (/ (* (sqrt 2) day) 2)))
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "_tim" "")
(setq j 0)
(setvar "highlight" 0)
(while (< j (length lp))
(setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
)
(command "trim" ssml "" "f" pt1 pt2 "" "")
(setq j (1+ j))
)
(setq q 0)
(setq ssml (ssget "x" '((0 . "line") (8 . "template"))))
(while (< q (sslength ssml))
(setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while (< k (sslength ssml))
(setq l2 (ssname ssml k)
pf3 (cdr (assoc 10 (entget l2)))
pf4 (cdr (assoc 11 (entget l2)))
d1 (distance pf1 pf3)
d2 (distance pf1 pf4)
d3 (distance pf2 pf3)
d4 (distance pf2 pf4)
)
(if (or (= (fix d1) cg) (= (fix d2) cg) (= (fix d3) cg) (= (fix d4) cg))
(command "fillet" l1 l2)
)
(setq k (1+ k))
)
(setq q (1+ q))
)
(command "change" ssml "" "p" "la" "tuong" "")
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
(setvar "cmdecho" 1)
(command "undo" "e")
)

Cám ơn bạn ketxu đã gợi ý để mình hoàn thành lisp.
BS: nét của bạn phải là layer "_tim" nếu không lisp sẽ bị sai.

Em cám ơn anh Tú nhiều. Anh nhiệt tình quá, và cũng giỏi nữa. Hâm mộ anh quá. Diễn đàn mình ko có cảm ơn để em cảm ơn. :(
Không hiểu sao em chạy là nó bị ra thế này:
Hình đã gửi
Mà có lẽ cái này cũng khó, Em có cái lisp vẽ tường là tốt rùi. Thanks anh nha. ^^
  • 0

#1914 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 September 2010 - 04:18 PM

Với trường hợp này thì chỉ thực hiện thao tác 1 lần thì đúng là chưa cần thiết :(

E rút lại câu này vì trong lisp còn liên quan đến tính toán khoảng cách nhiều,mà rõ ràng đã tính kcách là phải kể đến tỉ lệ rùi ^^

Bạn thử cái này....

Tks bác ^^

Em cám ơn anh Tú nhiều. Anh nhiệt tình quá, và cũng giỏi nữa. Hâm mộ anh quá. Diễn đàn mình ko có cảm ơn để em cảm ơn. :(
Không hiểu sao em chạy là nó bị ra thế này:
Hình đã gửi
Mà có lẽ cái này cũng khó, Em có cái lisp vẽ tường là tốt rùi. Thanks anh nha. ^^

Diễn đàn có nút thank mà bạn.:)
Với sự nhiệt tình của mọi người trên 4rumình nghĩ lisp vẽ tường chắc chắn sẽ được hoàn thiện thôi :D
  • 2

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


#1915 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 23 September 2010 - 04:28 PM

Chào bạn Bachngoctung,
Thực ra mình cũng chưa hiểu vì sao có lỗi này. Bởi vì khi mình chạy thử trên file bạn gửi thì không thấy có vấn đề như vậy. Bây giờ chạy lại thì lại bì dính đòn.
Để giải quyết cái lỗi này mình thử thay thế các giá trị 0.01 trong lisp thành 0.02 thì nó lại chạy bon bon. Có nghĩa là theo mình hiểu thì lỗi là do các biến hệ thống trên máy của bạn. Cụ thể là biến gì thì mình chưa rõ nhưng cái biến đó nó làm cho việc chọn đối tượng theo các cửa sổ bị sai trật với cái mình muốn do sai số lựa chọn điểm bạn ạ. Khi tăng cái khoảng sai lệch này lên thì nó không chọn nhầm nữa. Chỉ đơn giản là vậy.
Nếu bạn kiểm tra vẫn thấy nó bị xóa đi các cọc chọn thì bạn hãy tăng giá tri 0.02 thành 0.05 bạn nhé. Chúc bạn hài lòng....

Bác chỉnh lại biến hệ thống PICKBOX xem
------------
Sets the object selection target height, in pixels.
Note: When PICKBOX is set to 0, selection previewing of objects is not available.
-----------
và nên zoom ở một mức nào đó thôi (đủ để chọn được đối tượng) không nên zoom - All
  • 1

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#1916 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 23 September 2010 - 05:42 PM

Em cám ơn anh Tú nhiều. Anh nhiệt tình quá, và cũng giỏi nữa. Hâm mộ anh quá. Diễn đàn mình ko có cảm ơn để em cảm ơn. :(
Không hiểu sao em chạy là nó bị ra thế này:
Hình đã gửi
Mà có lẽ cái này cũng khó, Em có cái lisp vẽ tường là tốt rùi. Thanks anh nha. ^^

Mình dùng vẫn bình thường mà.
Hình đã gửi
Bạn up file lưới trục của bạn lên đây mình xem thử thế nào.
bạn dùng lại thử code này xem mình có sửa đôi chút về layer. Nét trục không nhất thiết phải là nét _tim.

(defun c:vetuong ()
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setq hl (getvar "highlight"))
(setq tbl (tblsearch "layer" "tuong"))
(if (= tbl nil) (command "-layer" "n" "tuong" "c" "4" "tuong" ""))
(setq tbl (tblsearch "layer" "_tim"))
(if (= tbl nil) (command "-layer" "n" "_tim" "c" "8" "_tim" "l" "center" "_tim" ""))
(setq tbl (tblsearch "layer" "template"))
(if (= tbl nil) (command "-layer" "n" "template" "c" "0" "template" ""))
(setvar "clayer" "template")
(setvar "osmode" 0)
(setq ss (ssget '((0 . "line"))))
(command "change" ss "" "p" "la" "_tim" "")
(setq day (getint "\nnhap chieu day tuong:"))
(setq cg (fix (/ (* (sqrt 2) day) 2)))
(setq i 0)
(setq lp nil)
(setq ssml nil)
(setq ssml (ssadd))
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
lp (append (list (append (list p1) (list p2))) lp)
)
(command "mline" "j" "z" "s" day p1 p2 "")
(command "explode" "l")
(setq ssline (ssget "p"))
(setq line1 (ssname ssline 0))
(setq line2 (ssname ssline 1))
(setq ssml (ssadd line1 (ssadd line2 ssml)))
(setq i (1+ i))
)
(command "-layer" "off" "_tim" "")
(setq j 0)
(setvar "highlight" 0)
(while (< j (length lp))
(setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
)
(command "trim" ssml "" "f" pt1 pt2 "" "")
(setq j (1+ j))
)
(setq q 0)
(setq ssml (ssget "x" '((0 . "line") (8 . "template"))))
(while (< q (sslength ssml))
(setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while (< k (sslength ssml))
(setq l2 (ssname ssml k)
pf3 (cdr (assoc 10 (entget l2)))
pf4 (cdr (assoc 11 (entget l2)))
d1 (distance pf1 pf3)
d2 (distance pf1 pf4)
d3 (distance pf2 pf3)
d4 (distance pf2 pf4)
)
(if (or (= (fix d1) cg) (= (fix d2) cg) (= (fix d3) cg) (= (fix d4) cg))
(command "fillet" l1 l2)
)
(setq k (1+ k))
)
(setq q (1+ q))
)
(command "change" ssml "" "p" "la" "tuong" "")
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "osmode" snap)
(setvar "highlight" hl)
(setvar "cmdecho" 1)
(command "undo" "e")
)

(defun c:vt ()
(command "undo" "be")
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq dt (cond (dt) (220)))
(setq olddt dt)
(setq dt (getint (strcat "\nrong tuong <"(rtos olddt 2 1)"> : ")))
(if (null dt)
(setq dt olddt)
)
(setq pt1 (getpoint "\ndiem thu nhat:")
pt2 (getpoint "\ndiem thu hai:" pt1)
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" dt pt1 pt2 "")
(setq mll (entlast))
(command "trim" mll "" "f" pt1 pt2 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
)

(defun c:vc ()
(setvar "cmdecho" 0)
(setq old_layer (getvar "clayer"))
(setq snap (getvar "osmode"))
(setvar "clayer" "tuong")
(setq cua (cond (cua) (900)))
(setq oldcua cua)
(setq cua (getint (strcat "\nrong cua <"(rtos oldcua 2 1)"> : ")))
(if (null cua)
(setq cua oldcua)
)
(setq pc1 (getpoint "\ndiem thu nhat:")
pc2 (getpoint "\ndiem thu hai:" pc1)
ang (+ (angle pc1 pc2) (/ (* 90 pi) 180))
pc3 (polar pc1 ang (+ 110 (/ cua 2)))
pc4 (polar pc2 ang (+ 110 (/ cua 2)))
)
(setvar "osmode" 0)
(command "-layer" "off" "_tim" "")
(command "mline" "j" "z" "s" cua pc3 pc4 "")
(setq mll (entlast))
(command "trim" mll "" "f" pc3 pc4 "" "")
(command "explode" mll)
(setvar "osmode" snap)
(setvar "clayer" old_layer)
(command "-layer" "on" "_tim" "")
(setvar "cmdecho" 1)
)

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

#1917 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 September 2010 - 05:52 PM

Các anh ơi - hôm nay em lại xin phiền các anh chút : em xin lisp nho nhỏ này
( đây là lisp thứ 2 em xin trong diễn đàn rồi ) hì hì

lisp ten : cong text theo cap so cong
Thuật toán là như vầy :
1. Đầu tiên sẽ tạo 1 text và copy text này ra các nơi vị trí muốn bố trí text ( ví dụ giá trị ban đầu text là 00 )
2.bấm lệnh của lisp
3. Xử lý như thế này các anh ạ :
+ Lisp sẽ hỏi chọn những text muốn cộng theo cấp số cộng này - sau đó em sẽ khối chọn những text cần
+ Lisp hỏi : nhập giá trị số đầu tiên - VD em sẽ nhập là : 10
+ Lisp hỏi : nhập giá trị số gia - VD em sẽ nhập là : 5
+ Lisp hỏi : chọn chiều cộng ( có 2 chiều là X hoặc Y nghĩa là cộng theo vị trí text trái phải hay trên dưới ) - VD em chọn : Y
+ Lisp hỏi : Chọn vị trí text đầu tiên - VD em chọn text có vị trí ở dưới cùng ( theo trục Y )
===> lisp sẽ thực hiện và ra kết quả : các text sẽ tự động thay đổi giá trị
VD em có 4 text : thì text bên dưới cùng sẽ là từ 00 ---> 10
tiếp theo các số ở trên nó : 00 ---> 15 ; 00 ---> 20 ; 00 ---> 25
==> kết quả : 10 ; 15 ; 20 ; 25 sẽ hiện lên màn hình

Các anh xem file cad đính kèm của em nhé ( Cad 2007 ) , em có giải thích chi tiết luôn :
http://www.mediafire...amb9uoyi6y59sk9

Chào bạn 843824,
Bạn dùng thử cái này xem đúng ý chưa nhé. Nếu chưa thì hãy post lên để mình xem lại.
Trước khi dùng lisp, bạn phải tạo các text như bạn đã mô tả. Lisp sẽ tự động sắp xếp lại các text của bạn theo thứ tự tăng hay giảm dần của tọa độ x của điểm đặt text. Bạn sẽ phải lựa chon chiều đặt các text theo tọa độ x này khi lisp hỏi bằng các nhập vào bàn phím các ký tự P hay T bạn nhé.
Lisp đây:

(defun c:cgxt ( )
(setq sst (ssget (list (cons 0 "TEXT")))
n (sslength sst)
i 0
enlst (list)
plst (list)
)
(while (< i n)
(setq en (ssname sst i)
enlst (append enlst (list en))
)
(setq i (1+ i))
)
(setq enlst (vl-sort enlst '(lambda (e1 e2)
(< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))) )
)
)
)
(setq i 0
a (getreal "/n Nhap gia tri bat dau: ")
b (getreal "/n Nhap gia tri cong sai: ")
)
(setq ans (strcase (getstring t "/n Chon chieu tang cua Text ( P hay T ): ")))
(if (= ans "T")
(setq enlst (reverse enlst))
)
(foreach en enlst
(setq els (entget en)
els (subst (cons 1 (rtos (+ a (* i b )) 2 1)) (assoc 1 els) els)
i (1+ i)
)
(entmod els)
(entupd en)
)

)

Mong rằng bạn sẽ hài lòng.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1918 843824

843824

    biết vẽ circle

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

Đã gửi 23 September 2010 - 06:55 PM

ui chà - hoàn toàn như mong đợi của em - thanks anh nhiều :( :( :)
Hì - mới xin lisp lần 2 mà e có kinh nghiệm ghê ta.
Giải thích rõ ràng cái là có ngay -- hè hè - mừng quá
Đa tạ pro rất nhiều
Em đã thử kiểm tra ngay với nhiều dạng sắp xếp - và tất cả ( dù có chổ cố tình sắp xếp khó khăn ) vẫn ok
Mà ko cần nhập theo trục X hay Y ... Đúng là bớt 1 công đoạn rồi

Ước gì mình cũng biết viết được như mấy anh ấy
  • 0

#1919 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 September 2010 - 08:21 PM

ui chà - hoàn toàn như mong đợi của em - thanks anh nhiều :( :( :)
Hì - mới xin lisp lần 2 mà e có kinh nghiệm ghê ta.
Giải thích rõ ràng cái là có ngay -- hè hè - mừng quá
Đa tạ pro rất nhiều
Em đã thử kiểm tra ngay với nhiều dạng sắp xếp - và tất cả ( dù có chổ cố tình sắp xếp khó khăn ) vẫn ok
Mà ko cần nhập theo trục X hay Y ... Đúng là bớt 1 công đoạn rồi

Ước gì mình cũng biết viết được như mấy anh ấy

Hề hề hề,
Cầu được ước thấy.... Chỉ cần bạn chịu khó quan tâm đến nó một chút, yêu nó một chút là nó sẽ chiều bạn ngay ấy mà. Cái cô nàng lisp này cũng đỏng đảnh ra phết đấy bạn ạ. phải cố mà tìm thì mới hiểu cô nàng ấy được...
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.

#1920 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 September 2010 - 08:53 PM

Bác chỉnh lại biến hệ thống PICKBOX xem
------------
Sets the object selection target height, in pixels.
Note: When PICKBOX is set to 0, selection previewing of objects is not available.
-----------
và nên zoom ở một mức nào đó thôi (đủ để chọn được đối tượng) không nên zoom - All

Hề hề hề,
Cám ơn bác Master_Worse nhiều nhé,
Nhờ bác chỉ mà mình phát hiện ra cái lỗi của lisp. Không phải tại thằng Pickbox size mà là do mình zoom chưa đủ độ lớn thôi bác à. Khi để ở chế độ zoom nhỏ thì nó pick hơi trật chìa một chút còn cứ zoom lớn lên tới gần điểm pick thì nó pick trúng đối tượng liền bác ạ.
Ví như cái lisp nó bị cận thị ấy mà, phải nhòm sát vào (phóng thật to ra) thì nó mới nhòm thấy được. Hề hề hề.
@ Bachngoctung: Giờ thì tùy ý bạn có thể chỉnh hoặc không chỉnh lại lisp, nó vẫn chạy như bổ củi bạn ạ. Hề hề hề. Cái thằng cu lisp này lắm lúc cũng nghịch ra trò. Hề hề hề....
Đây là cái mình chạy với lisp cũ, có độ lệch điểm chọn là 0.01.
http://www.cadviet.c...cadviet_112.dwg
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.