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

[Tue_NV 3.912]

-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é

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

[ketxu 2.984]

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 ?

[master_worse 88]

À,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

[ketxu 2.984]

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ệ

[saobang240286 2]

Chào mọi người!

[Tue_NV 3.912]

Ấ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

[ketxu 2.984]

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 :(

[Tue_NV 3.912]

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

[phamngoctukts 714]

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

[Tue_NV 3.912]

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 :(

[phamngoctukts 714]

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

[phamthanhbinh 3.146]

- 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.com/upfiles/3/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....

[tuananhlt02 1]

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:

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

[ketxu 2.984]

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:

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

[master_worse 88]

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

[phamngoctukts 714]

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:

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

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

[phamthanhbinh 3.146]

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.com/?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 ((setq en (ssname sst i)
       enlst (append enlst (list en))
)
(setq i (1+ i))
)
(setq enlst (vl-sort enlst '(lambda (e1 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.

[843824 1]

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

[phamthanhbinh 3.146]

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

[phamthanhbinh 3.146]

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.com/upfiles/3/cadviet_112.dwg

[tuannguyen314169 57]

Chào các Bác và Bác Bình, mình mới mót được cái lisp trên diễn đàn để phục vụ cho công việc chuyên môn, trên 2D thì thực hiện được, nhưng không thực hiện được trên 3d với lý do sau:

-Thực hiện được trên solid chỉ đối với trục x còn các trục còn lại y,z không thực hiện được, mặc khác nó chuyển solid sang block

Mong các Bác chỉ giáo giúp. Thank you very much

(setq kq Nil)

(setq n (length LiBlk))

(setq i 0)

(while (< i n)

(if (= bname (nth i LiBlk))

(progn

(setq i n)

(setq kq T)

)

)

(setq i (1+ i))

)

kq

)

(DEFUN CREALIBLK (/ NL)

(setq LiBlk (List))

(setq NL (tblnext "BLOCK" T))

(while NL

(setq LiBlk (append LiBlk (list (cdr (assoc 2 NL)))))

(setq NL (tblnext "BLOCK"))

)

(setq LiBlk (Acad_strlsort LiBlk))

)

(DEFUN C:XSCALE()

(CREALIBLK)

(EXCUTE)

)

(DEFUN C:XSC()

(CREALIBLK)

(EXCUTE)

)

(princ "\nfree lisp from www.cadviet.com")

(princ)

[bachngoctung 11]

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.com/upfiles/3/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....

-Cám ơn PhamThanhBinh lisp chạy cho ra đúng kết quả như mình mong muốn, có thể nói là tuyệt vời.

- MÌnh muồn hỏi thêm bạn một chút về điều kiện để sử dụng lisp mà bạn đã viết cho mình : theo như bạn nói thì "3/- Lisp này chỉ chạy đúng với cấu trúc hình vẽ như cái file bạn đã upload. Cụ thể là các khoảng cách giữa các đường line ngang màu xanh của bạn phải là 2 và chiều cao các text cũng đúng y boong như vậy bạn nhé."

-Vấn đề là ko phải bản nào cần chỉnh sửa nó cũng có chiều cao text và khoảng cách giữa các đường line ngang màu xanh như file mẫu mình đã đưa lên. Cho nên mình muốn nhờ bạn chỉ giùm mình cách hiệu chỉnh lisp này sau cho phù hợp với những bản vẽ có kích thước text và khoảng cách giữa các đường line màu xanh ngang khác nhau.

[truongthanh 7]

các bạn cho mình hỏi có lisp nào chọn các text hoặc mtext có chung các ký tự ko?

Ví dụ trong bản vẽ mình có các text có nội dung sau:

nguyễn văn a

nguyễn văn b

trần văn C

mình gọi lisp

lisp yêu cầu mình nhập chuỗi ký tự cần select: ví dụ mình nhập chữ "nguyễn văn" và quét chọn hết 3 text trên, kết quả cuối cùng là được chọn 2 text "nguyễn văn a". "nguyễn văn b".

còn nếu mình nhập chuỗi "văn" thì lisp sẽ chọn hết cả 3 text!

thanks các bạn!

[phamngoctukts 714]

Lisp vẽ tường mình đã độ lại chơi được cả đường tim chéo đồng thời fix một số lỗi lisp không chay trên máy khác rồi. Nhưng nó vẫn bị lỗi một tí ở góc đang bí chưa biết fix thế nào. Có anh em nào cho xin một gợi ý đê!!

code đây:

(defun c:vetuong ()
(command "trim" "" "e" "e" "")
(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 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 (and (< d1 day) (> d1 0)) (and (< d2 day) (> d2 0)) (and (< d3 day) (> d3 0)) (and (< 

d4 day) (> d4 0)))
(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")
(command "trim" "" "e" "n" "")
)

[tamkt 2]

Em xin lỗi vì xen ngang nha,

Mấy anh giúp e với,....

http://www.cadviet.com/upfiles/3/giup_em.jpg

http://www.cadviet.com/upfiles/3/giup_em.dwg

Em cám ơn mấy anh nhiều nhiều.