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

[Thaistreetz 539]

-Nhờ mọi người ngâm cứu lisp này giúp mình với , do khi chạy nova ( phần mềm thiết đường ) cao độ mia ở mặt cắt ngang chạy ra nó nhiều quá dẫn đến không nhìn được , mời mọi người xem hình ảnh ( mình cũng up luôn cả bản cad lên để mọi người tiện ngâm cứu).

-Hình ảnh đây

-Vấn đề của mình đặt ra là làm sao biến hình A thành hình B một cách nhanh nhất(xóa bớt cọc mia thừa và ghi lại khoảng cách mia).

-Mình xin đưa đa cấu trúc lisp như sau:

+ Tên lệnh HCM (hiệu chỉnh mia)

+ Chọn điểm đầu (ta chọnđiểm 1 trong hình A)

+ Chọn điểm cuối (ta chọnđiểm 2 trong hình A)

+ Chọn text ghi khoảng cách ( ta chọn vào text 1.10 (màu đỏ ở hình A)> nó cho kết quả là 1.99 (màu đỏ ở hình :(

+ Sau khi điền kết quả xong nó tự xóa luôn các cọc và các text(cọc màu ghi , text ở giữa 2 đi màu vàng ) ở giữa 2 điểm 1 và 2 mà ta chọn ban đầu

-Mong anh em xem giúp , có gì mình viết trên đây mà mọi người chưa rõ ý của mình thì mình sẽ nói rõ thêm . Chân thành cám ơn

-Đây là bản cad http://www.cadviet.com/upfiles/3/cadviet_1.dwg

Chao Ngoctung. hnay vào toppic này thấy bài của bác Bình mới biết yêu cầu của bạn. Cách làm của bạn truớc đây mình đã giúp 1 bạn ngay trong toppic này. bạn chịu khó tìm kiếm nó trong khoảng 20 trang đầu sẽ thấy.

Tuy nhiên cách làm này mình thấy quá thủ công. Với những trắc ngang nội suy từ đuờng đồng mức như thế này sẽ tạo ra số điểm mia rất dày, nhất là với đuờng miền núi. lam theo cách trên với 1 km đường thôi chắc cũng mất gần 1 ngày. mình gợi ý bạn cách giải quyết triệt để hơn.

Trên trắc ngang bạn có các đường dóng. Như vậy từ các đường dóng này ta có thể lấy được khoảng cách giữa các điểm mia, cao độ tự nhiên của của chúng (thông qua việc chọn 1 đường dóng nào đó làm gốc).

như vậy ta có thẻ giải quyết công việc cụ thể như sau:

- làm thưa trắc ngang bằng cách xóa tất cả các đường dóng không cần thiết (cái này làm thủ công, không mất nhiều thời gian)

- sau khi trắc ngang đã được làm thưa, điền lai toàn bộ khoảng cách giữa các cọc còn lại và cao độ tự nhiên của chúng (cái này làm bằng lisp)

như vậy ta cần viết 1 lisp có chức năng điền cao độ và khoảng cách lẻ thay thế cho bảng cũ dựa trên số liệu cao độ và khoảng cách thu được từ các đường dóng còn lại trên trắc ngang.

Mình thấy bạn có khả năng viết code nên mình gợi ý bạn làm như vậy. Bạn thử làm xem, Nếu không thành công mình sẽ post code của mình cho bạn

đây là file trình tự cách làm và kết quả của mình

[master_worse 88]

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?

bạn thử cái này xem:

(setq ss (ssget "_X" (list '(0 . "*TEXT") (cons 1 (strcat "*" (getstring t "\Nhap chuoi can tim: ") "*")))))

[phamthanhbinh 3146]

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

Chào bạn Bachngotung,

Sở dĩ mình phải nói với bạn như vậy vì bạn hãy xem kỹ việc mình lấy các điểm p1,p2,p3,p4,p5,p6,p7,p8,p11.Trong đó:

- Điểm p1 và p2 là hai điểm cọc đầu và cọc cuối được đánh dâu trên đường line màu xanh cao nhất. (Theo như bạn đã đánh dấu)

- Điểm p3 (Thực ra không có giá trị sử dụng) được lấy cùng cọc với P1 nhưng ở trên đường line thấp nhất.

- Điểm p4 lấy theo p2 trên cọc thứ hai nhưng lệch trái một chút (0.01 hoặc 0.02) để tránh xóa cọc này và cao hơn đường line xanh thấp nhất (0.01 hoặc 0.02) để tránh xóa đường line xanh dưới cùng.

- Tương tự như vậy các điểm p5 và p6 được lấy theo cọc 1, cọc 2 và line xanh thứ 3 nhưng hơi chệch một chút nhằm tránh xóa các line xanh và các cọc mốc.

- Tương tự nhu vậy các điểm p7 và p8 được lấy theo cọc 1, cọc 2 và line xanh thứ tư.

- Điểm p11 dược lấy chệch khỏi điểm p1 một chút về bên phải.

Tọa độ của các điểm này sẽ phụ thuộc vào khoảng cách giữa các đường line ngang màu xanh. Với các bản vẽ có các khoảng cách này khác 2 thì bạn phải thay các giá trị này vào cho phù hợp trong các hàm xác định chúng.

Về chiều cao text, do nó liên quan tới việc bố trí text trong các ô cuối cùng (sau khi đã xóa sạch sẽ) nên mình đã thay đổi cái vị tri đặt text cũ thành vị trí mới bằng hàm (subst (cons 11 ......) (assoc 11 ...) ....) > Khi bạn thay đổi chiều cao text thì cũng cần thay đổi lại cái hàm (cons 11 ....) này cho nó phù hợp bạn ạ. Cụ thể là bao nhiêu thì bạn phải thử chứ không khẳng định trước được.

 

Hy vọng rằng bạn hiểu được cấu trúc của lisp để có thể tự chỉnh theo ý bạn. Trước hết bạn hãy thay đổi một vài già trị trong cái lisp của mình và chạy thử, xem kết quả và rút ra kinh nghiệm bạn ạ. Để tránh mất thời gian bạn hãy lưu cái file gốc lại và copy nó thành file khác rồi sửa. Như vậy sẽ rất dễ so sánh để tìm ra bản chất của các giá trị chỉnh sửa bạn ạ và bạn cũng luôn yên tâm rằng cái gốc không bị hư hỏng.

 

Chúc bạn vui.

[phamthanhbinh 3146]

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.

Chào bạn tamkt,

Bạn dùng thử cái này nhé. Tặng luôn bạn cái lisp tạo dimstyle theo cái hình bạn post. Trong lisp này khoảng cách giữa line và dim là 500 (Mình ước theo cái hình bạn post chứ khong phải là 2000 đâu nha. Nếu muốn thì bạn phải sửa các con số 500 trong lisp thành 2000.

Chúc bạn vui.

Lisp đây:

(defun c:td (/ n_name n_scl)
 (setvar "cmdecho" 0 )
 (setq n_name (getstring "\n Name of DIMSTYLE : "))
 (setq n_scl (getint "\n Overall Scale : " ))
 (COMMAND
      "-style" "DIM" "vnsimple.shx" "" "0.7" "" "" "" ""
      "DIMCLRD" "3";Dimension line and leader color
      "DIMCLRE" "3";Extension line color
      "DIMCLRT" "3";Dimension text color
      "DIMTXSTY" "DIM";Text style
      "DIMTXT" "50.0";Text height
      "DIMDLI" "0.25";Dimension line spacing
      "DIMEXE" "0.25";Extension above dimension line
      "DIMEXO" "0.25";Extension line origin offset
      "DIMGAP" "15";Gap from dimension line to text
      "DIMBLK" ""    ;Arrowhead
      "DIMASZ" "35";Arrow size  
      "DIMCEN" "1.5";Center mark size
      "DIMTAD" "1"    ;Place text above the dimension line
      "DIMDEC" "2"    ;Decimal places for dimensions
      "DIMTOH" "Off";Aliged text with ...
      "DIMTIH" "Off";...dimension line
      "DIMTIX" "On" ;Place text inside extensions
      "DIMTOFL" "On";Force line inside extension lines
      "DIMSCALE" "1";Overall scale of DIM      
      "DIMALTD" "2"    ;Angular Demensions

      [color="#FF00FF"]"******"[/color] n_scl;Measurement scale of DIM
      "DIMSTYLE" "S" n_name;Creat DIMSTYLE
      )
(setvar "cmdecho" 1)
(prompt (strcat  "\DIMSTYLE has created... " n_name))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dmln ( )
(command "undo" "be")
(setq ln (car (entsel "\n Chon doan thang can dim"))
       p1 (cdr (assoc 10 (entget ln)))
       p2 (cdr (assoc 11 (entget ln)))
       p3 (list (+ (car p1) (/ (- (car p2) (car p1)) 4)) (+ (cadr p1) (/ (- (cadr p2) (cadr p1)) 4)))
       p4 (list (- (car p2) (/ (- (car p2) (car p1)) 4)) (- (cadr p2) (/ (- (cadr p2) (cadr p1)) 4)))
       goc (angle p1 p2)
)
(command "dimaligned" p1 p3 (polar p1 (- goc (/ pi 2)) 500))
(command "dimaligned" p3 p4 (polar p3 (- goc (/ pi 2)) 500))
(command "dimaligned" p4 p2 (polar p4 (- goc (/ pi 2)) 500))
(command "undo" "e")
(princ)
)

PS: đây là lispa theo bài post của bạn, còn lispb thì bạn hãy tự làm nhé vì giữa cái hình và cái lời bạn ghi chả giống nhau chi cả nên chả biết đâu mà viết. Bạn hãy dựa vào cái lisp của mình mà tự biến đổi cho nó phù hợp với cái bạn cần. Hề hề hề, chịu khó nhé vì có khó cũng vẫn phải chịu. Hề hề hề....

[ketxu 2984]

Hề hề..Bác Binh ơi,code có kiểm tra vnsimple.shx tồn tại hay không thì sao ạ ^^.Gán thế rồi mà nó k có thì sao ạ ^^

[truongthanh 7]

bạn thử cái này xem:

(setq ss (ssget "_X" (list '(0 . "*TEXT") (cons 1 (strcat "*" (getstring t "\Nhap chuoi can tim: ") "*")))))

Hix!bạn giúp thì giúp cho trót, giúp cho mình lisp hoàn chỉnh luôn với!Mình dốt cái món này lắm!

Thanks nhiều!

[master_worse 88]

Sao bạn không dùng fi (FILTER) ?

Command: fi -> Select filter chọn Text Value nhập vào ô trống bên dưới *nguyễn văn* -> Add to list -> Apply -> chọn tất tần tật

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

Không biết đúng ý không

(defun c:muondatgithidat (/ ss)
 (setq ss (ssget "_X" (list '(0 . "*TEXT") (cons 1 (strcat "*" (getstring t "\Nhap chuoi can tim: ") "*")))))
 (sssetfirst ss ss)
 (princ)
)

Chỉnh sửa Tháng 9 24, 2010 theo master_worse

[phamthanhbinh 3146]

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 ((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 ((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 ((setq l1 (ssname ssml q)
pf1 (cdr (assoc 10 (entget l1)))
pf2 (cdr (assoc 11 (entget l1)))
)
(setq k 0)
(while ((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 0)) (and ( d2 0)) (and ( 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" "")
)

Cháo bác Phamngoctukts,

Bỏ qua các động tác phụ, về nội dung chính của lisp, có một vài ý kiến về cái lisp vẽ tường của bác như sau:

1/- Ở khúc lisp vẽ các nét chiều day tường, việc bác sử dụng hàm mline là khá hay, nó tránh được sự loằng ngoằng của việc offset.

2- Ở bước trim các nét vẽ , bác dùng hàm trim với tham số fence "f" cũng là một ý tốt. Tuy nhiên còn một số vấn đề cần lưu ý là trong trường hợp các nét tường này không giao cắt với các dường fence, hoặc là tại các góc mà các nét tường giao cắt với nhau hơn 1 lần thì việc trim này sẽ để lại các nét thừa hoặc chưa cắt hết bác ạ

3/- Ở bước fillet bác sử dụng điều kiện kiểm tra là khoảng cách giữa hai đầu đoạn thẳng > 0 và

 

Thực tế mình thấy vấn đề này cũng khá hóc nên chưa dám cày sâu, Tuy nhiên mình nghĩ có lẽ bác nên tách cái tập hợp ssml thành hai nhóm để xét sẽ tốt hơn chăng. vì dụ một nhóm là toàn các thằng nằm về bên phải đường tim, còn một nhóm là các thằng nằn ở bên trái đường tim chẳng hạn. Việc tách này sẽ liên quan tới việc xác định điểm đầu và điểm cuối của các đường tim khi tạo các mline bác ạ.

Do mình còn hạn chế về kỹ năng suy luận nên chưa có giải pháp triệt để về vấn đề này. Chỉ là mấy lời góp ý nều chưa đúng mong bác đừng giận.

Chúc bác vui.

[phamthanhbinh 3146]

Hix!bạn giúp thì giúp cho trót, giúp cho mình lisp hoàn chỉnh luôn với!Mình dốt cái món này lắm!

Thanks nhiều!

Chào bạn Truongthanh,

Ý bạn hoàn chỉnh là sao nhỉ??? Cái lisp này của bác ấy là hoàn chỉnh rồi, còn việc bạn muốn dùng nó vào đâu là do bạn thôi. Phải biết mục đích sử dụng của bạn mới hoàn chỉnh được chứ. Còn bạn chỉ hỏi là có cách nào để chọn các đối tượng ...... thì đó là cách tốt rồi đó.

Chọn xong bạn muốn tùng xẻo hay ăn gỏi nó là do bạn chớ sao bác ấy biết được mà làm lisp

Ví dụ để xóa chúng đi thì bạn xài (command "erase" SS "") là Ok

Còn muốn copy chúng thì (command "copy" ss "" p1 p2) với p1 là diểm gốc còn p2 là điểm tới,....

Hề hề hề.....

Muốn người ta thương thì phải thương người ta mà nói cho rõ cái yêu cầu của mình chớ. Đánh đố nhau chi vậy????

Hề hề hề,.....

[Sony2007 86]

Các bác giúp đỡ e với. Trong bản vẽ của e, có nhiều Text, mỗi text có 1 rotation khác nhau. Có lisp nào quay các text, mà tâm quay là tại bản thân của mỗi text, góc quay là do người dùng nhập vào. Cám ơn các bác nhiều.

[dkkx3a 59]

Các bác giúp đỡ e với. Trong bản vẽ của e, có nhiều Text, mỗi text có 1 rotation khác nhau. Có lisp nào quay các text, mà tâm quay là tại bản thân của mỗi text, góc quay là do người dùng nhập vào. Cám ơn các bác nhiều.

Em mới viết con này, không biết đúng ý bác ko:

;===========================
(defun c:Rotext(/ thop_list index ctname_i diemdat giatrigoc giatrigoc_new gocquay thop)
(setvar "cmdecho" 0)
(command ".undo" "begin") 
(if (findfile "acetutil.arx")
(progn
(princ "\DNPP_say: Express tools ready............................")
;-------------------Xu ly Text
(princ "\nDNPP_say: Chon Text Mtext can quay: ")
;(setq thop_list (SL2LIST (setq thop (ssget '((0 . "text"))))))
(setq thop_list (SL2LIST (setq thop (ssget '((0 . "*text,mtext")))
)))
(if thop_list
(progn
(acet-tjust thop "Middle")

(setq gocquay (getreal "\nDNPP_say: Nhap goc quay text [do]: "))

(setq index 0)
(while (< index (length thop_list))
	(setq 	ctname_i (nth index thop_list)
		diemdat	(Dxf_PO ctname_i)
		giatrigoc 	(Dxf_gvalue_ANG ctname_i)
		giatrigoc_new (+ giatrigoc (* (/ gocquay 180) 3.14159265))
		)
	(Dxf_change_rote ctname_i 50 giatrigoc_new)
	(setq index (+ index 1))
); end while
)
(princ "\nDNPP_say: Khong co Doi tuong nao duoc chon !!! ")
)
); end progn
(princ "\nDNPP_say: Tool Express chua duoc cai !!!!!!!! ")
) ; end if
(command ".undo" "end")
(princ "\n........Copyright © by DoanNhut....... ")
(princ)
)
;===========================
(defun Dxf_PO(entity_name)
(caddr(assoc 11 (entget entity_name)))
);end defun
(defun Dxf_gvalue_ANG(entity_name)
(cdr (assoc 50 (entget entity_name)))
);end defun
(defun Dxf_change_rote(entity_name dfx_code value_new / index code code_n code_o tam)
(setvar "cmdecho" 0)
(setq code (entget entity_name))
(setq 	code_o (assoc dfx_code code)
code_n (cons dfx_code value_new)
)
(entmod (subst code_n code_o code))
(entupd entity_name)
);end defun
(defun SL2LIST (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
;===========================
(princ "\n...................Lenh la quaytext.............. ")
(princ)

 

Có gì pót lại nhé!!!! (@PS: cad của bác phải cài Express Tool)

[phamthanhbinh 3146]

Hề hề..Bác Binh ơi,code có kiểm tra vnsimple.shx tồn tại hay không thì sao ạ ^^.Gán thế rồi mà nó k có thì sao ạ ^^

Hề hề hề,

cái font này có nhẽ khó mà thiếu được, nếu không có thì phải thay nó bằng font khác thui. Còn gán vậy nó mà không có thì lisp chả chạy nữa, nằm nghỉ mệt. Mình phải lôi ra mà sửa vậy.

Tại vì lisp này mình cũng mót trên diễn đàn về xài nên cũng chửa biết kiểm tra nó ra sao, cứ chép nguyên vậy dùng đã. Khi cần thì lôi ra chỉnh sửa cho hợp ý mình thui chứ không dám bày vẽ gì thêm.

Hề hề hề......

Tỷ như bạn muốn thay font gì thì thay vào cái chỗ vnsimple.shx đó. Chả nhẽ trên máy lại chả có cái font nào hay sao??? còn cái việc tạo font thì ối cha mẹ ơi mình chửa biết làm. Có ai biết chỉ giùm. Hề hề hề.

Túm lại là có gì xơi nấy chả kén cá chọn canh được bác ạ.....

Hề hề hề.....

[ketxu 2984]

Bác dkkx3a ơi,nếu máy cài Express rồi thì sao không dùng torient ạ ? Nó tự quay quanh tâm rồi.Lấy tập hợp t,mt,thực hiện lệnh torient với góc quay người dùng nhập vào -> 1 lần thực hiện lệnh sẵn có của express tool, k tạo vòng lặp nữa

[dkkx3a 59]

Bác dkkx3a ơi,nếu máy cài Express rồi thì sao không dùng torient ạ ? Nó tự quay quanh tâm rồi.Lấy tập hợp t,mt,thực hiện lệnh torient với góc quay người dùng nhập vào -> 1 lần thực hiện lệnh sẵn có của express tool, k tạo vòng lặp nữa

Hình như làm thế ra hai kết quả khác nhau bác ạ, cái lisp trên quay các *Text theo cùng một giá trị nhưng dùng lệnh của bác thì các *Text cuối cùng có một góc quay, em nghĩ bác SONY muốn ý của em, còn nếu như ý bác quay về chung một hướng thì khác bác ạ, lệnh của bác cũng được và cũng có cách khác nữa bác ạ. Chỏ Reply của bác SONY là đúng nhất........... Hi vọng đúng ý bác í, không thì mình SRy, mình xóa cái LSP của mình.......hichic

[nguyentuyen6 130]

Mình thử sửa lại cái code của 1 bác trên 4rôm để đc cái líp quay text mà no không chạy đc!! ai xem giup mình với

 

(defun c:rot (/ txt newang newrad i)
(setq ss (ssget '((0 . "*text")))
      newang (getreal "\nNhap goc quay: ")
      newrad ((/ (* newang pi) 180))
      i 0
 )  
(while (< i (sslength ss))
  (setq txt (ssname ss i))
  (entmod (subst (cons 50 newrad) (assoc 50 (entget txt)) (entget txt)))
 (setq i (1+ i))
);_ end while
);_ end defun

[truongthanh 7]

Các bác giúp đỡ e với. Trong bản vẽ của e, có nhiều Text, mỗi text có 1 rotation khác nhau. Có lisp nào quay các text, mà tâm quay là tại bản thân của mỗi text, góc quay là do người dùng nhập vào. Cám ơn các bác nhiều.

bạn thử lisp này xem!lúc trước mình có nhờ bác TUE_NV viết dùm mình đó!

http://www.cadviet.com/upfiles/3/gt.lsp

[Tue_NV 3912]

Mình thử sửa lại cái code của 1 bác trên 4rôm để đc cái líp quay text mà no không chạy đc!! ai xem giup mình với

 

(defun c:rot (/ txt newang newrad i)
(setq ss (ssget '((0 . "*text")))
      newang (getreal "\nNhap goc quay: ")
      newrad ((/ (* newang pi) 180))
      i 0
 )  
(while (  (setq txt (ssname ss i))
  (entmod (subst (cons 50 newrad) (assoc 50 (entget txt)) (entget txt)))
 (setq i (1+ i))
);_ end while
);_ end defun

Bạn sai ở dòng này :

newrad ((/ (* newang pi) 180))

Có thể dùng hàm getangle

Thay dòng :

newang (getreal "\nNhap goc quay: ")

newrad ((/ (* newang pi) 180)) -> dòng này của bạn bị lỗi

bằng dòng

newrad (getangle "\nNhap goc quay: ")

[master_worse 88]

Mình thử sửa lại cái code của 1 bác trên 4rôm để đc cái líp quay text mà no không chạy đc!! ai xem giup mình với

 

(defun c:rot (/ txt newang newrad i)

(setq ss (ssget '((0 . "*text")))

newang (getreal "\nNhap goc quay: ")

newrad ((/ (* newang pi) 180))

i 0 )

(while (< i (sslength ss)).... );_ end while

);_ end defun

Sửa thành (/ (* newang pi) 180)

[ketxu 2984]

Hề hề hề,

cái font này có nhẽ khó mà thiếu được, nếu không có thì phải thay nó bằng font khác thui. Còn gán vậy nó mà không có thì lisp chả chạy nữa, nằm nghỉ mệt. Mình phải lôi ra mà sửa vậy.

Tại vì lisp này mình cũng mót trên diễn đàn về xài nên cũng chửa biết kiểm tra nó ra sao, cứ chép nguyên vậy dùng đã. Khi cần thì lôi ra chỉnh sửa cho hợp ý mình thui chứ không dám bày vẽ gì thêm.

Hề hề hề......

Tỷ như bạn muốn thay font gì thì thay vào cái chỗ vnsimple.shx đó. Chả nhẽ trên máy lại chả có cái font nào hay sao??? còn cái việc tạo font thì ối cha mẹ ơi mình chửa biết làm. Có ai biết chỉ giùm. Hề hề hề.

Túm lại là có gì xơi nấy chả kén cá chọn canh được bác ạ.....

Hề hề hề.....

Thì ý e muốn hỏi trong tay bác có code ktra font có tồn tại chưa hay k ý mà,để e xin tí ^^ Hì hì.Chứ a e mình open source thế này,mỗi người mót về đều phải tùy biến th :">

[ketxu 2984]

Hình như làm thế ra hai kết quả khác nhau bác ạ, cái lisp trên quay các *Text theo cùng một giá trị nhưng dùng lệnh của bác thì các *Text cuối cùng có một góc quay, em nghĩ bác SONY muốn ý của em, còn nếu như ý bác quay về chung một hướng thì khác bác ạ, lệnh của bác cũng được và cũng có cách khác nữa bác ạ. Chỏ Reply của bác SONY là đúng nhất........... Hi vọng đúng ý bác í, không thì mình SRy, mình xóa cái LSP của mình.......hichic

Ấy chớ,mỗi lisp viết ra là đứa con tinh thần,sao lại xóa :(

Thú thực thì e vẫn chưa hiểu cả ý của bác lẫn ý bạn Sony..Nếu k phải quay cùng hướng thì cứ mỗi text lại nhập 1 hướng khác nhau ạ :(

Còn ý bác thì e k hiểu đoạn này "*Text theo cùng một giá trị nhưng dùng lệnh của bác thì các *Text cuối cùng có một góc quay"

[dkkx3a 59]

Ấy chớ,mỗi lisp viết ra là đứa con tinh thần,sao lại xóa :)

Thú thực thì e vẫn chưa hiểu cả ý của bác lẫn ý bạn Sony..Nếu k phải quay cùng hướng thì cứ mỗi text lại nhập 1 hướng khác nhau ạ :(

Còn ý bác thì e k hiểu đoạn này "*Text theo cùng một giá trị nhưng dùng lệnh của bác thì các *Text cuối cùng có một góc quay"

Ý em là khi Torient thì "các chú *Text" cùng nhìn về một "em" đấy mà.......theo kiểu nhắm thẳng quân thù mà bắn !!!

 

Còn cái dụ vì sao phải quay Text kiểu kia thì cái này em viết do có cái dụ ông bạn cùng chổ làm quay hay mirr cái bình đồ sang một góc khác (ví như khi thiết kế từ điểm A-B mà sau này chủ đầu tư yêu cầu đổi điểm đầu điểm cuối nên ổng quay cái bình đồ lại, thế là các Text lộn tùng phéo cả lên mà bình đồ chổ làm thì yêu cầu các Text cao độ phải vuông với đường tim trắc ngang nên nếu dùng Torient thì không được mà phải quay nó một góc nào đấy quanh tâm nên mới đẻ ra cái LSP này...., mình nói quanh co khó hiểu nhưng đại loại thế...khì khì :( cụng với bác "kẹt xù" một li nà, khì khì khì

[phamngoctukts 714]

Cháo bác Phamngoctukts,

Bỏ qua các động tác phụ, về nội dung chính của lisp, có một vài ý kiến về cái lisp vẽ tường của bác như sau:

1/- Ở khúc lisp vẽ các nét chiều day tường, việc bác sử dụng hàm mline là khá hay, nó tránh được sự loằng ngoằng của việc offset.

2- Ở bước trim các nét vẽ , bác dùng hàm trim với tham số fence "f" cũng là một ý tốt. Tuy nhiên còn một số vấn đề cần lưu ý là trong trường hợp các nét tường này không giao cắt với các dường fence, hoặc là tại các góc mà các nét tường giao cắt với nhau hơn 1 lần thì việc trim này sẽ để lại các nét thừa hoặc chưa cắt hết bác ạ

3/- Ở bước fillet bác sử dụng điều kiện kiểm tra là khoảng cách giữa hai đầu đoạn thẳng > 0 và < chiều dày tường thực ra chưa đủ bác ạ. Quá trình này chưa xét đến trình tự hình thành các line trong tập hợp ssml nên cứ thấy thằng nào thỏa là nó fillet thôi, và mỗi thằng chỉ được kiểm tra một lần. Trong khi có thể có những trường hợp mà một đường thẳng gần với hai đường thẳng khác mà nó chọn lộn thì là hỏng việc bác ạ.

 

Thực tế mình thấy vấn đề này cũng khá hóc nên chưa dám cày sâu, Tuy nhiên mình nghĩ có lẽ bác nên tách cái tập hợp ssml thành hai nhóm để xét sẽ tốt hơn chăng. vì dụ một nhóm là toàn các thằng nằm về bên phải đường tim, còn một nhóm là các thằng nằn ở bên trái đường tim chẳng hạn. Việc tách này sẽ liên quan tới việc xác định điểm đầu và điểm cuối của các đường tim khi tạo các mline bác ạ.

Do mình còn hạn chế về kỹ năng suy luận nên chưa có giải pháp triệt để về vấn đề này. Chỉ là mấy lời góp ý nều chưa đúng mong bác đừng giận.

Chúc bác vui.

2/ Vấn đề đường fence không cắt qua đường thẳng (TH goc hợp bởi hia đường thẳng lớn hơn 90 độ) làm mình đau đầu.(chủ yếu là mắc ở đây). Khi trim thì mới hình thành đối tượng mới nên sau khi trim mình đã chọn lại toàn bộ line nét tường (Điều này giải thích tại sao mình tạo ra layer template để tiện cho việc chọn lại đối tượng) Khi fillet toàn bộ nét tường trong tập chọn ssml đã chứa toàn bộ nét line tường. Nếu lisp chay lỗi thì chuyển sang chế độ extend trong trim-edge.

3/ Quá trình fillet không hình thành đối tượng mới nên mình nghĩ là tách tập hợp ssml ra là không cần thiết. Có lẽ trong vòng lặp trim mình nên thay tập chọn ssml là (setq ssml (ssget "x" '((0 . "line") (8 . "template")))) thì ok thôi. Vấn đề giải quyết lisp trên là làm sao trim được đường line mà đường fence không cắt qua thôi. Cho em hỏi có biến hê thống nào làm làm cho tầm ảnh hưởng của đường fence rộng ra không ví dụ như gần bằng chiều dày tường chwản hạn?

[phamthanhbinh 3146]

2/ Vấn đề đường fence không cắt qua đường thẳng (TH goc hợp bởi hia đường thẳng lớn hơn 90 độ) làm mình đau đầu.(chủ yếu là mắc ở đây). Khi trim thì mới hình thành đối tượng mới nên sau khi trim mình đã chọn lại toàn bộ line nét tường (Điều này giải thích tại sao mình tạo ra layer template để tiện cho việc chọn lại đối tượng) Khi fillet toàn bộ nét tường trong tập chọn ssml đã chứa toàn bộ nét line tường. Nếu lisp chay lỗi thì chuyển sang chế độ extend trong trim-edge.

3/ Quá trình fillet không hình thành đối tượng mới nên mình nghĩ là tách tập hợp ssml ra là không cần thiết. Có lẽ trong vòng lặp trim mình nên thay tập chọn ssml là (setq ssml (ssget "x" '((0 . "line") (8 . "template")))) thì ok thôi. Vấn đề giải quyết lisp trên là làm sao trim được đường line mà đường fence không cắt qua thôi. Cho em hỏi có biến hê thống nào làm làm cho tầm ảnh hưởng của đường fence rộng ra không ví dụ như gần bằng chiều dày tường chwản hạn?

Chào bác phamngoctukts,

Về việc tạo fence theo mình nghĩ bác có thể tạo các fence mới thay cho các đường tim. Các fence này chỉ cách các đường line trong tập hợp ssml một khoảng cách bằng 1/5 chiều dày tường có lẽ sẽ khắc phục được vụ các đường tim không cắt các line trong tập chọn ssml bác ạ.

[kamezoko 3]

tôi kiếm trên diễn đàn có lisp của anh ssg rất hay:

http://www.cadviet.com/upfiles/3/vc.lsp

tôi muốn lisp tính thêm diện tích(phần diện tích thì chỉ cấn 1 số lẻ),và tất cả được phân cách bằng dấu "," kể cả kích thước cạnh

mong các anh giúp dùm...cám ơn nhiều :(

[phamngoctukts 714]

Chào bác phamngoctukts,

Về việc tạo fence theo mình nghĩ bác có thể tạo các fence mới thay cho các đường tim. Các fence này chỉ cách các đường line trong tập hợp ssml một khoảng cách bằng 1/5 chiều dày tường có lẽ sẽ khắc phục được vụ các đường tim không cắt các line trong tập chọn ssml bác ạ.

Thank bác ThanhBinh nhiều code đã chạy ngon rồi.

Mọi người có thể download code này về dùng xem nếu lỗi thì báo lại cho mình.

;; free lisp from cadviet.com

(defun c:vetuong ()
(command "trim" "" "e" "e" "p" "n" "")
(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 day1 (/ (* day 7) 15))
(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 ssml (ssget "x" '((0 . "line") (8 . "template"))))
(setq nhom (nth j lp)
pt1 (car nhom)
pt2 (last nhom)
angf (+ (angle pt1 pt2) (/ pi 2))
t1 (polar pt1 angf day1)
t2 (polar pt1 (+ angf pi) day1)
t3 (polar pt2 (+ angf pi) day1)
t4 (polar pt2 angf day1)
)
(command "trim" ssml "" "f" t1 t2 t3 t4 t1 "" "")
(setq j (1+ j))
)
(setq q 0)
(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 (< (fix d1) (* day1 2)) (> d1 0)) (and (< (fix d2) (* day1 2)) (> d2 0)) 
        (and (< (fix d3) (* day1 2)) (> d3 0)) (and (< (fix d4) (* day1 2)) (> 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" "")
)