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

#1941 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 - 05:28 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.

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.c...pfiles/3/gt.lsp
  • 1

#1942 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 24 September 2010 - 05:31 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

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

#1943 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 - 05:31 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)).... );_ end while
);_ end defun

Sửa thành (/ (* newang pi) 180)
  • 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)


#1944 ketxu

ketxu

    Copier - Paster - Editor

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

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

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


#1945 ketxu

ketxu

    Copier - Paster - Editor

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

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

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


#1946 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 - 06:15 PM

Ấ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ì
  • 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.......

#1947 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 24 September 2010 - 07:00 PM

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

#1948 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 - 09:49 PM

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

#1949 kamezoko

kamezoko

    biết vẽ line

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

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

tôi kiếm trên diễn đàn có lisp của anh ssg rất hay:
http://www.cadviet.c...pfiles/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 :(
  • 0

#1950 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 25 September 2010 - 12:11 AM

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

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

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

#1951 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 25 September 2010 - 12:48 AM

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)

Chào bác tuannguyen314169,
Hề hề hề,
Bác có khỏe không mà sao cái lisp bác post lại bị ngắt đi một khúc đầu vậy, chả thấy cái (defun excute () ......) nó nằm đâu cả thì dò sao ra lỗi được hử bác????
Cái lisp này hình như của bác Duy viết thì phải, nó để scale theo một trục và hai trục thì phải, mình đọc lâu rồi nên cũng không nhớ rõ lắm.
Trong CAD thì các solid đều được hiểu là block nên khi bác xài hàm (tblnext "block") thì nó sẽ lôi cả các thằng solid này vào trong danh sách các block để nó trảm bác ạ.
Có nhẽ cái lisp này được viết không phải cho các đối tượng 3D và cần phải tìm hiểu kỹ hơn mới có thể chỉnh sửa nó được bác ạ. Và nếu bác Duy góp sức thì có thể sẽ gỡ nó nhanh hơn.
Bác hãy gửi lại đầy đủ cái lisp này bác nhé. Bây giờ kiếm nó cũng hơi lâu vì tuy biết là có trên diện đàn nhưng cái khoản tìm kiếm này mình hơi kém 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.

#1952 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 25 September 2010 - 06:58 AM

Chào bác tuannguyen314169,
Hề hề hề,
Bác có khỏe không mà sao cái lisp bác post lại bị ngắt đi một khúc đầu vậy, chả thấy cái (defun excute () ......) nó nằm đâu cả thì dò sao ra lỗi được hử bác????
Cái lisp này hình như của bác Duy viết thì phải, nó để scale theo một trục và hai trục thì phải, mình đọc lâu rồi nên cũng không nhớ rõ lắm.
Trong CAD thì các solid đều được hiểu là block nên khi bác xài hàm (tblnext "block") thì nó sẽ lôi cả các thằng solid này vào trong danh sách các block để nó trảm bác ạ.
Có nhẽ cái lisp này được viết không phải cho các đối tượng 3D và cần phải tìm hiểu kỹ hơn mới có thể chỉnh sửa nó được bác ạ. Và nếu bác Duy góp sức thì có thể sẽ gỡ nó nhanh hơn.
Bác hãy gửi lại đầy đủ cái lisp này bác nhé. Bây giờ kiếm nó cũng hơi lâu vì tuy biết là có trên diện đàn nhưng cái khoản tìm kiếm này mình hơi kém bác ạ.
Hề hề hề,....

Không phải đâu là không phải đâu. Của em là scalexy còn cái này ra đời sớm hơn hình như của bác ssg hay kiên ường gì đấy.
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#1953 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 25 September 2010 - 07:03 AM

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


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


Cám ơn bác nhiều, đã đúng ý em rồi. Chúc bác ngày mới làm việc tốt.
  • 0

#1954 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 25 September 2010 - 07:09 AM

Ý 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ì


Ý của bác dkkx3a là đúng ý em rồi đấy, và việc này là nhằm mục đích e làm bình đồ như bạn của bác đó. Chứ còn đưa các text về cùng 1 góc quay thì e k nói làm gì. Cám ơn bác nhiều,
  • 0

#1955 huong259

huong259

    biết lệnh refedit

  • Members
  • PipPipPipPipPipPipPip
  • 596 Bài viết
Điểm đánh giá: 350 (khá)

Đã gửi 25 September 2010 - 07:13 AM

Không phải đâu là không phải đâu. Của em là scalexy còn cái này ra đời sớm hơn hình như của bác ssg hay kiên ường gì đấy.

Hình như tác giả lisp scale 1 chiều là:
http://www.cadviet.c...?showtopic=1340
  • 0

#1956 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 25 September 2010 - 10:43 AM

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

-Cám Thaistreetz đã quan tâm nhưng mình chưa biết viết lisp bạn à , bạn giúp mình được ko vì vấn đề này ko những giúp mình mà còn giúp được rất nhiều anh em làm giao thông khi gặp phải thiết kế các tuyến đường miến núi tiết kiệm được thời gian hiệu chỉnh bản vẽ . Bạn Thaistreetz giúp mình code nhé :( .
  • 0

#1957 790312

790312

    biết lệnh fillet

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

Đã gửi 25 September 2010 - 11:40 AM

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.

Lisp này khi mình chọn chiều tăng của text là phải thì nó đánh từ trên xuống dưới,bạn có thể sửa lại khi chọn chiều tăng là phải thì nó cũng đánh từ dưới lên trên giống như chiều tăng trái được không .Chân thành cảm ơn trước.
  • 0

#1958 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 25 September 2010 - 12:16 PM

-Cám Thaistreetz đã quan tâm nhưng mình chưa biết viết lisp bạn à , bạn giúp mình được ko vì vấn đề này ko những giúp mình mà còn giúp được rất nhiều anh em làm giao thông khi gặp phải thiết kế các tuyến đường miến núi tiết kiệm được thời gian hiệu chỉnh bản vẽ . Bạn Thaistreetz giúp mình code nhé :( .

EDTN : Edit trắc ngang. Code này mình viết khá lâu rồi nên rác, một vài truờng hợp có thể sảy ra lỗi khi chay nếu truớc khi chạy tuyến trong nova bạn không chạy lệnh NS - "Cài đặt các thông số ban đầu"
(Không hiểu sao Hài Hoà không thiết lập lệnh này tự chạy khi thiết lập bản vẽ, trong nhiều truờng hợp, việc chạy lệnh này truớc khi chạy tuyến là bắt buộc, nếu không thì toàn bộ quá trình thiết kế sau đó sẽ tạo ra rất nhiều lỗi và buộc fải xoá toàn bộ tuyến rồi chạy lại)
Khi chạy lệnh, tại dòng nhắc : "Quét chọn trắc ngang cần sửa", bạn kéo chuột từ trái qua fải như hình vẽ để chọn đủ đối tuợng.

(defun c:EDTN (/ SSTN SSD SST SSL T0 L0 L1 index PDi
PD0 PTi PT0 PLi PL0 RES Hi H0 DL0 CL0 YL0
DLi KCi XLi PTX
)
(thai-get-sysvar)
(setq cmdname "Edit khoang cach le trac ngang")
(prompt (strcat "\nQuet chon trac ngang can sua\n"))
(setq SSTN (ssget (list (cons 8 "LINEDONGTN,ENTTNTUNHIEN"))))
(setq index 0
SSD (ssadd)
SST (ssadd)
SSL (ssadd)
T0 (ssadd)
L0 (ssadd)
L1 (ssadd)
) ;setq
;----loc doi tuong
(repeat (sslength SSTN)
(if (= (DFX-SS 8 SSTN index) "LINEDONGTN")
(setq SSD (ssadd (ssname SSTN index) SSD))
(progn
(if (= (DFX-SS 0 SSTN index) "TEXT")
(if (distof (DFX-SS 1 SSTN index))
(setq SST (ssadd (ssname SSTN index) SST))
) ;if
(if (< (thai-length-curve (ssname SSTN index)) 3)
(setq SSL (ssadd (ssname SSTN index) SSL))
)
) ;if
) ;progn
) ;if
(setq index (1+ index))
) ;repeat
;-----------------
(setvar "Dimzin" 0)
(setq index 0)
(repeat (sslength SSD)
(setq PDi (DFX-SS 10 SSD index))
(if (= index 0)
(setq PD0 PDi)
(if (> (car PDi) (car PD0))
(setq PD0 PDi)
)
) ;if
(setq index (1+ index))
) ;repeat
(setq index 0)
(repeat (sslength SST)
(setq PTi (DFX-SS 11 SST index))
(if (= index 0)
(setq T0 (ssadd (ssname SST index) T0)
H0 (atof (DFX-SS 1 SST index))
PT0 PTi
)
(if (> (car PTi) (car PT0))
(setq T0 nil
T0 (ssadd)
T0 (ssadd (ssname SST index) T0)
H0 (atof (DFX-SS 1 SST index))
PT0 PTi
)
) ;if
) ;if
(setq index (1+ index))
) ;repeat


(setq index 0)
(repeat (sslength SSL)
(setq PLi (DFX-SS 10 SSL index))
(if (>= (car PLi) (car PD0))
(setq L0 (ssadd (ssname SSL index) L0)
)
) ;if
(setq index (1+ index))
) ;repeat
(setq index 0)
(setvar "osmode" 0)
(repeat (sslength SSD)
(setq PDi (DFX-SS 10 SSD index))
(setq Hi (+ H0 (- (cadr PDi) (cadr PD0))))
(command "copy" L0 "" (list (car PD0) 0) (list (car PDi) 0))
(setq L1 (ssadd (entlast) L1))
(command "copy" T0 "" (list (car PT0) 0) (list (car PDi) 0))
(thai-entmod-entlast 1 (rtos Hi 2 2))
(setq index (1+ index))
) ;repeat
(setq index 0)
(repeat (sslength L1)
(if (= index 0)
(setq DL0 (DFX-SS 10 L1 index)
CL0 (DFX-SS 11 L1 index)
YL0 (+ (cadr CL0) (* 0.5 (thai-length-curve (ssname L1 index))))
)
(progn
(setq DL0 (DFX-SS 10 L1 (- index 1))
DLi (DFX-SS 10 L1 index)
KCi (distance DLi DL0)
XLi (+ (car DLi) (* 0.5 KCi))
PTX (list XLi YL0)
)
(if (> KCi 0.05)
(progn
(command "copy" T0 "" PT0 PTX)
(thai-entmod-entlast 72 1)
(thai-entmod-entlast 1 (rtos KCi 2 2))
(setq RES (entget (entlast)))
(if (> (- KCi 0.4)
(distance (car (textbox RES)) (cadr (textbox RES)))
)
(entmod (subst (cons 50 0) (assoc 50 RES) RES))
)
)
)
) ;progn
) ;if
(setq index (1+ index))
) ;repeat
(command "erase" SST SSL "")
(thai-restore)
(princ)
) ;end
(defun thai-entmod-entlast (code value / RES)
(setq RES (entget (entlast)))
(entmod (subst (cons code value) (assoc code RES) RES))
)
(defun thai-get-sysvar ()
(setq CMDLAST (getvar "cmdecho"))
(setvar "cmdecho" 0)
(vl-load-com)
(command "Undo" "BEGIN")
(command "UCS" "W")
(setq OSMLAST (getvar "osmode")
DMZLAST (getvar "dimzin")
OTHLAST (getvar "orthomode")
TSTLAST (getvar "textstyle")
COLLAST (getvar "cecolor")
LAYLAST (getvar "clayer")
DPMLAST (getvar "DYNPROMPT")
DYNLAST (getvar "DYNMODE")
ERR *error*
*error* thai-error
)
)
(defun thai-restore ()
(setvar "osmode" OSMLAST)
(setvar "dimzin" DMZLAST)
(setvar "orthomode" OTHLAST)
(setvar "textstyle" TSTLAST)
(setvar "cecolor" COLLAST)
(setvar "clayer" LAYLAST)
(setvar "DYNPROMPT" DPMLAST)
(setvar "DYNMODE" DYNLAST)
(command "UCS" "P")
(if SSe
(command "erase" SSe "")
)
(command "undo" "end")
(if cmdname
(progn
(princ (strcat "\nEnd of [" cmdname "]"))
(setq cmdname nil)
)
)
(setq *error* ERR)
(setvar "cmdecho" CMDLAST)
) ;defun
(defun thai-error (msg)
(if OSMLAST
(setvar "osmode" OSMLAST)
)
(if DMZLAST
(setvar "dimzin" DMZLAST)
)
(if OTHLAST
(setvar "orthomode" OTHLAST)
)
(if TSTLAST
(setvar "textstyle" TSTLAST)
)
(if COLLAST
(setvar "cecolor" COLLAST)
)
(if COLLAST
(setvar "clayer" LAYLAST)
)
(if DPMLAST
(setvar "DYNPROMPT" DPMLAST)
)
(if DYNLAST
(setvar "DYNMODE" DYNLAST)
)
(if SShd
(command "erase" SShd "")
)
(if SSe
(command "erase" SSe "")
)
(command "UCS" "P")
(command "undo" "end")
(if cmdname
(progn
(princ (strcat "\n" msg
"\nEnd of [" cmdname "], Reset System Variables\n"
)
)
(setq cmdname nil)
)
(princ (strcat "\n" msg ", Reset System Variables\n"))
)
(setq *error* ERR)
(setvar "cmdecho" CMDLAST)
) ;defun
(defun DFX-SS (code obj index)
(cdr (assoc code (entget (ssname obj index))))
) ;defun
(defun thai-length-curve (EN)
(vlax-curve-getDistAtParam EN (vlax-curve-getEndParam EN))
)

  • 1

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


#1959 tamkt

tamkt

    biết vẽ ellipse

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

Đã gửi 25 September 2010 - 01:01 PM

Chào anh Phamthanhbinh!

Phải nói anh tuyệt thật, em cám ơn anh nha, anh ở Sài Gòn hay ở đâu vậy?

Lisp đúng ý em rùi, em cám ơn anh nhiều lắm.
  • 0

#1960 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 25 September 2010 - 01:34 PM

Nhờ các anh các bác giúp em cái LSP này, em sớt không thấy: em tạo nhiều layout, mỗi layout có một bản vẽ (để em dùng Publish in ấn), nhưng mỗi khi em mang sang máy khác thì phải đổi lại thiết lập máy in rất chi là mất công, do có quá nhiều bản vẽ, nên nay xin nhờ các anh (bác) trên diễn đàn viêt giúp em cái LSP dùng để thiết lập lại thông số các layout hàng loạt trong một bản vẽ sang kiểu khác (ham muốn thêm là cả trong Folder)......em xin cảm ơn. Nếu mất nhiều thời gian thì các anh hướng dẫn em làm với: các bước và hàm cần sử dụng để em tự biên (bí thì nhờ...) em cũng đang học LSP nên cũng muốn táy máy tí.
Mong sớm hồi âm. thanks...cuối tuần rùi dzô đê :(
  • 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.......