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

#1921 tuannguyen314169

tuannguyen314169

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 297 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 23 September 2010 - 09:38 PM

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

#1922 bachngoctung

bachngoctung

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 23 September 2010 - 10:02 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.
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....

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

#1923 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 23 September 2010 - 11:21 PM

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

#1924 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:29 PM

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 ý đê!!
Hình đã 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" "")
)

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

#1925 tamkt

tamkt

    biết vẽ ellipse

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

Đã gửi 24 September 2010 - 01:23 AM

Em xin lỗi vì xen ngang nha,
Mấy anh giúp e với,....
http://www.cadviet.c...s/3/giup_em.jpg
http://www.cadviet.c...s/3/giup_em.dwg
Em cám ơn mấy anh nhiều nhiều.
  • 0

#1926 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 24 September 2010 - 01:44 AM

-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 Hình đã gửi
-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.c...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
  • 1

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#1927 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 24 September 2010 - 09:00 AM

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: ") "*")))))
  • 2

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)


#1928 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 24 September 2010 - 11:31 AM

-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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1929 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 24 September 2010 - 01:06 PM

Em xin lỗi vì xen ngang nha,
Mấy anh giúp e với,....
http://www.cadviet.c...s/3/giup_em.jpg
http://www.cadviet.c...s/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ề....
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1930 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 September 2010 - 01:23 PM

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 ạ ^^
  • 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


#1931 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 24 September 2010 - 01:45 PM

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

#1932 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 24 September 2010 - 02:17 PM

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

Bài viết đã được chỉnh sửa nội dung bởi master_worse: 24 September 2010 - 02:50 PM

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


#1933 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 24 September 2010 - 02:34 PM

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 ý đê!!
Hình đã 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" "")
)

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.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1934 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 24 September 2010 - 02:44 PM

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ề,.....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1935 Sony2007

Sony2007

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 85 (tàm tạm)

Đã gửi 24 September 2010 - 03:47 PM

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

#1936 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 24 September 2010 - 03:53 PM

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)
  • 1
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#1937 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

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

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ề.....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1938 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 September 2010 - 04:24 PM

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


#1939 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 24 September 2010 - 04:32 PM

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
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#1940 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 24 September 2010 - 05:17 PM

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

  • 0

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860