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

#3361 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 April 2011 - 04:34 PM

Nếu Scale xuống lại thi còn gì để nói chứ! Em định dùng lisp nhưng trình độ ABC nên muốn nhờ các cao thủ giúp thôi! vì số lượng hình đã scale lên nhiều rồi mà có hình lại scale 2 chiều khác nhau nữa chứ! Mong các anh chỉ giáo!!!

Việc này giúp bạn được, nhưng lại có cái dở là nếu đã dùng phương thức như thế (nhập) thì khi kích chuột, khoảng cách đó cũng nhân, bạn ok k ?
  • 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


#3362 duchieu0205

duchieu0205

    biết vẽ line

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

Đã gửi 21 April 2011 - 04:40 PM

Việc này giúp bạn được, nhưng lại có cái dở là nếu đã dùng phương thức như thế (nhập) thì khi kích chuột, khoảng cách đó cũng nhân, bạn ok k ?

Anh giúp hộ nếu có bất cập gì thì tìm cách khắc phục vậy. Cám ơn anh nhiều!
  • 0

#3363 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 April 2011 - 05:16 PM

Anh giúp hộ nếu có bất cập gì thì tìm cách khắc phục vậy. Cám ơn anh nhiều!

Bạn dùng tạm, mình để chọn dim đầu tiên trong tập chọn làm dim để lấy Scale, bạn có thể kích chọn dim chỉ định hoặc quét lẫn cả vào nếu vùng đó chỉ có 1 dimstyle. Đến giờ về, mình hơi vội, viết k được hay, có gì bạn cứ phản hồi nhé:
(defun c:sd(/ ss ssd basePnt) 
(setq ss (ssadd))
(while
(= (setq ssd (acet-list-to-ss (vl-remove-if '(lambda(x) (null (wcmatch (acet-dxf 0 (entget x)) "DIMENSION"))) (acet-ss-to-list ss)))) nil)
(Prompt "\nXin h\U+00E3y ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng :") (setq ss (ssget)))

(command ".stretch" ss ""
(setq basePnt (getpoint "\n\U+0110i\U+1EC3m c\U+01A1 s\U+1EDF"))
(polar basePnt (getangle basePnt "\nH\U+01B0\U+1EDBng Stretch :")
(/ (getdist "\nKho\U+1EA3ng stretch :") (vla-get-LinearScaleFactor (vlax-ename->vla-object (ssname ssd 0)))))
)
)

  • 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


#3364 duchieu0205

duchieu0205

    biết vẽ line

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

Đã gửi 21 April 2011 - 06:01 PM

Bạn dùng tạm, mình để chọn dim đầu tiên trong tập chọn làm dim để lấy Scale, bạn có thể kích chọn dim chỉ định hoặc quét lẫn cả vào nếu vùng đó chỉ có 1 dimstyle. Đến giờ về, mình hơi vội, viết k được hay, có gì bạn cứ phản hồi nhé:

(defun c:sd(/ ss ssd basePnt) 
(setq ss (ssadd))
(while
(= (setq ssd (acet-list-to-ss (vl-remove-if '(lambda(x) (null (wcmatch (acet-dxf 0 (entget x)) "DIMENSION"))) (acet-ss-to-list ss)))) nil)
(Prompt "\nXin h\U+00E3y ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng :") (setq ss (ssget)))

(command ".stretch" ss ""
(setq basePnt (getpoint "\n\U+0110i\U+1EC3m c\U+01A1 s\U+1EDF"))
(polar basePnt (getangle basePnt "\nH\U+01B0\U+1EDBng Stretch :")
(/ (getdist "\nKho\U+1EA3ng stretch :") (vla-get-LinearScaleFactor (vlax-ename->vla-object (ssname ssd 0)))))
)
)

Trước tiên mình chân thành cám ơn anh đã giúp đỡ. Mình vừa dùng thử và có một ý kiến sau. Khi chọn tập đối tượng mà có nhiều tỉ lệ scale factor thì nên có thao tác chọn dim để làm cơ sở scale. ngoài ra anh nên bỏ hướng Stretch mà hướng vẫn theo hướng mouse để như lệnh stretch nguyên thuỷ của cad. Xin cám ơn anh nhiều!
  • 0

#3365 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 April 2011 - 10:36 PM

Trước tiên mình chân thành cám ơn anh đã giúp đỡ. Mình vừa dùng thử và có một ý kiến sau. Khi chọn tập đối tượng mà có nhiều tỉ lệ scale factor thì nên có thao tác chọn dim để làm cơ sở scale. ngoài ra anh nên bỏ hướng Stretch mà hướng vẫn theo hướng mouse để như lệnh stretch nguyên thuỷ của cad. Xin cám ơn anh nhiều!

Bạn không đọc kỹ bài mình nói rồi.
Đỏ : Nếu tập chọn nhiều dim, bạn cứ pick chọn 1 dim đầu làm dim cơ sở, rồi quét chọn tiếp cả tập đối tượng, vì mình lấy đối tượng dim đầu tiên làm cơ sở, bạn hiểu chứ? Như vậy sẽ giúp bạn bớt đi 1 thao tác thừa nếu toàn bộ dim giống nhau
Xanh : hướng stretch vẫn theo điểm mouse, không khác gì cả, chỉ thêm phần bạn phải nhập khoảng cách thôi, chứ k chỉ định điểm chuẩn xác được , vì getdist đã thêm tỉ lệ scale, nên nếu pick chuột thì k trực quan như stretch nguyên thủy
  • 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


#3366 namhwru

namhwru

    biết pan

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

Đã gửi 22 April 2011 - 08:07 AM

Civil dùng trong thiết kế hạ tầng
Nó xài toàn ACAD_PROXY_ENTITY thôi
AutoLisp thì bó tay rồi
:rolleyes: :rolleyes:

Mình vẫn xài lisp cad cho civil binh thường mà!
  • 0

#3367 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 April 2011 - 08:20 AM

Mình vẫn xài lisp cad cho civil binh thường mà!

Bình thường hay không thì yêu cầu của bạn cũng cần có file :)
  • 1

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


#3368 duchieu0205

duchieu0205

    biết vẽ line

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

Đã gửi 22 April 2011 - 09:21 AM

Bạn không đọc kỹ bài mình nói rồi.
Đỏ : Nếu tập chọn nhiều dim, bạn cứ pick chọn 1 dim đầu làm dim cơ sở, rồi quét chọn tiếp cả tập đối tượng, vì mình lấy đối tượng dim đầu tiên làm cơ sở, bạn hiểu chứ? Như vậy sẽ giúp bạn bớt đi 1 thao tác thừa nếu toàn bộ dim giống nhau
Xanh : hướng stretch vẫn theo điểm mouse, không khác gì cả, chỉ thêm phần bạn phải nhập khoảng cách thôi, chứ k chỉ định điểm chuẩn xác được , vì getdist đã thêm tỉ lệ scale, nên nếu pick chuột thì k trực quan như stretch nguyên thủy

Em thấy thế này nhé: Nếu dim chọn ban đầu thì không bị stretch mà bị move đi
Còn hướng stretch thì mình phài thêm 1 động tác kích chuột so với lệnh stretch nguyên thuỷ. Anh xem có thể bỏ bớt động tác kích chuột này đi không! Vì thêm 1 dộng tác vừa mất thời gian vừa ko quen tay :lol:
Em đọc câu lệnh của anh mà không hiểu tí gì cả nên không thể sửa gì được :D
  • 0

#3369 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 April 2011 - 10:54 AM

Em thấy thế này nhé: Nếu dim chọn ban đầu thì không bị stretch mà bị move đi
Còn hướng stretch thì mình phài thêm 1 động tác kích chuột so với lệnh stretch nguyên thuỷ. Anh xem có thể bỏ bớt động tác kích chuột này đi không! Vì thêm 1 dộng tác vừa mất thời gian vừa ko quen tay :lol:
Em đọc câu lệnh của anh mà không hiểu tí gì cả nên không thể sửa gì được :D

Mình sửa tạm cho bạn phần chọn Dim trước, còn bỏ kich chuột hướng đi thì mình chưa làm được, vì lý do : Mình còn kém, chưa tìm hiểu kỹ được các hàm grread,redraw.. nên nếu để chọn hướng chuột của bạn thì sẽ không có đường gióng, rất khổ :(, còn làm Dynamic thì sẽ dài (i think so), mình chưa có thời gian đầu tư..Vậy nên, đành chờ các mem khác fix giúp bạn, hoặc hẹn bạn vào 1 ngày xa xa ^^.Mà theo mình nghĩ việc đặt chuột sao cho đúng hướng với việc đặt chuột sao cho đúng hướng + 1 phát click thì k thể nhanh hơn hay chậm hơn được, chỉ là bạn chưa quen thao tác thôi. Hehe

(defun c:sd(/ dsc)
(if (setq dsc (vla-get-LinearScaleFactor
(vlax-ename->vla-object (car(entsel "\nCh\U+1ECDn Dim c\U+01A1 s\U+1EDF :")))))
(progn
(Prompt "\nXin h\U+00E3y ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng :")
(command ".stretch" (ssget) ""
(setq basePnt (getpoint "\n\U+0110i\U+1EC3m c\U+01A1 s\U+1EDF"))
(polar basePnt (getangle basePnt "\nH\U+01B0\U+1EDBng Stretch :")
(/ (getdist "\nKho\U+1EA3ng stretch :") dsc ))
)
))
)

  • 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


#3370 duchieu0205

duchieu0205

    biết vẽ line

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

Đã gửi 22 April 2011 - 11:03 AM

Mình sửa tạm cho bạn phần chọn Dim trước, còn bỏ kich chuột hướng đi thì mình chưa làm được, vì lý do : Mình còn kém, chưa tìm hiểu kỹ được các hàm grread,redraw.. nên nếu để chọn hướng chuột của bạn thì sẽ không có đường gióng, rất khổ :(, còn làm Dynamic thì sẽ dài (i think so), mình chưa có thời gian đầu tư..Vậy nên, đành chờ các mem khác fix giúp bạn, hoặc hẹn bạn vào 1 ngày xa xa ^^.Mà theo mình nghĩ việc đặt chuột sao cho đúng hướng với việc đặt chuột sao cho đúng hướng + 1 phát click thì k thể nhanh hơn hay chậm hơn được, chỉ là bạn chưa quen thao tác thôi. Hehe

(defun c:sd(/ dsc)
(if (setq dsc (vla-get-LinearScaleFactor
(vlax-ename->vla-object (car(entsel "\nCh\U+1ECDn Dim c\U+01A1 s\U+1EDF :")))))
(progn
(Prompt "\nXin h\U+00E3y ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng :")
(command ".stretch" (ssget) ""
(setq basePnt (getpoint "\n\U+0110i\U+1EC3m c\U+01A1 s\U+1EDF"))
(polar basePnt (getangle basePnt "\nH\U+01B0\U+1EDBng Stretch :")
(/ (getdist "\nKho\U+1EA3ng stretch :") dsc ))
)
))
)

Em chân thành cám ơn! em sẽ dùng cả 2 đoạn code của anh khi các đối tượng có 1 loại dim hoặc khi có nhiều loại dim. Dù sao em cũng cám ơn anh nhiều đã dành thời gian để giúp em!

Mong các cao thủ cùng hoàn thiện lisp này. Em nghĩ các anh em cũng hay dùng lệnh này!
  • 0

#3371 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 22 April 2011 - 03:14 PM

Các Bác giúp em tạo Block có Attribute và tự nhập cao độ cho nó với.
(Lệnh dưới mới chỉ tạo được block (không có Attribute):

...
(setq TenBlock (getstring "\n - Nhap ten block: "))
(setq Caodo (getreal "\n - Nhap cao đo: "))
(setq Diem (getpoint "\n - Chon Diem Dat Block: "))
(entmake (list (cons 0 "insert") (cons 2 TenBlock) (cons 10 Diem)))
...

Xin cảm ơn nhiều !

Hề hề hề,
Bạn có thể tham khảo cách tạo block thuộc tính của bác 18011985 ở đây nhé.
http://www.cadviet.c...h=1
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3372 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 22 April 2011 - 03:29 PM

Mình đã paste như hướng dẫn của bạn nhưng không được .
Mong bạn chỉ giúp

Hề hề hề,
Đúng là không được do hàm con (xuly .....) chỉ dùng có hai đối số là biến toàn cục là hai list pts và txts . Do vậy khi thêm vào (caddr data) sẽ bị lỗi là too arguments.
Việc sửa lại cho nó có thêm biến z ở kết quả tuy không quá khó nhưng cần có thời gian một chút do cái lisp này quá dài. Chỉ đọc để hiểu nó nói gì cũng mất hàng giờ rồi bạn ạ. Mong bạn chịu khó chờ một chút nha.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3373 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 22 April 2011 - 03:51 PM

nhờ các anh chị viết giúp em lip như thế này:(em đã seach nhưng không thấy)
- đổi tất cả các text, mtext,dim có trong bãn vẽ về cùng chiều cao chữ và về cùng 1 layer.
-chuển font chữ có trong bản vẽ về font VNswitzerlandCondensed(text và mtext)
Chân thành cảm ơn các anh chị
  • 0

#3374 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 22 April 2011 - 04:22 PM

Mình có seach được trên diễn đàn lisp copy tăng dần này http://www.cadviet.c...tang_dancom.lsp nhưng chỉ copy tăng dần được từ 1 tới 99 thôi. Bác nào biết sửa lại giúp mình copy tăng dần từ 1 tới 10000 mình cám ơn nhiều

Hề hề hề,
Chào bạn Lacvanhoa, Bạn hãy thử thay (if (= luusokt 100) (setq luusokt 0))bằng (if (= luusokt 10000) (setq luusokt 0)) và chạy thử xem sao nhé.
Lưu ý rằng cái lisp này chỉ tăng dần với các text mà có hai ký tự cuối là chữ số thôi nhé. Nếu có hơn hai ký tự cuối là chữ số thì chỉ có tăng ở hai ký tự cuối chứ không tăng các ký tự còn lại bạn ạ.
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.

#3375 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 April 2011 - 04:26 PM

nhờ các anh chị viết giúp em lip như thế này:(em đã seach nhưng không thấy)
- đổi tất cả các text, mtext,dim có trong bãn vẽ về cùng chiều cao chữ và về cùng 1 layer.
-chuển font chữ có trong bản vẽ về font VNswitzerlandCondensed(text và mtext)
Chân thành cảm ơn các anh chị

Bạn đưa ra 1 bài toán quá thiếu dữ liệu đầu vào :) => Mình viết tạm như thế này , có gì bạn tự sửa nhé (lưu ý, mình lờ block ^^, ngại với anh này lắm rồi)

(defun c:cht1()
(vl-load-com)
(command "undo" "be")
(foreach ent
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER,*TEXT,ATT*")))))))
(if (vlax-property-available-p ent 'TextHeight) (vlax-put-property ent 'TextHeight "2") )
(if (vlax-property-available-p ent 'Height) (vlax-put-property ent 'Height "2") )
(if (vlax-property-available-p ent 'Layer) (vlax-put-property ent 'Layer "0"))
)
(vlax-for x (vla-get-textstyles
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-put-fontfile x "Romans.shx")
)
(command "undo" "en")
)
- Các thứ cần sửa bao gồm :
+ Chiều cao text, bạn chưa nói là do người dùng nhập vào hay chọn đối tượng mẫu => Mình để là "2", bạn sửa lại theo con số bạn ưa thích ^^
+ Tương tự với Layer Name, mình đang để là "0"
+ Tên font của bạn chưa có đuôi :) Mình đang để tạm là Romans.SHX
  • 1

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


#3376 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 24 April 2011 - 09:17 AM

Bạn đưa ra 1 bài toán quá thiếu dữ liệu đầu vào :) => Mình viết tạm như thế này , có gì bạn tự sửa nhé (lưu ý, mình lờ block ^^, ngại với anh này lắm rồi)

(defun c:cht1()
(vl-load-com)
(command "undo" "be")
(foreach ent
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER,*TEXT,ATT*")))))))
(if (vlax-property-available-p ent 'TextHeight) (vlax-put-property ent 'TextHeight "2") )
(if (vlax-property-available-p ent 'Height) (vlax-put-property ent 'Height "2") )
(if (vlax-property-available-p ent 'Layer) (vlax-put-property ent 'Layer "0"))
)
(vlax-for x (vla-get-textstyles
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-put-fontfile x "Romans.shx")
)
(command "undo" "en")
)
- Các thứ cần sửa bao gồm :
+ Chiều cao text, bạn chưa nói là do người dùng nhập vào hay chọn đối tượng mẫu => Mình để là "2", bạn sửa lại theo con số bạn ưa thích ^^
+ Tương tự với Layer Name, mình đang để là "0"
+ Tên font của bạn chưa có đuôi :) Mình đang để tạm là Romans.SHX


Cảm ơn anh đã giúp đỡ. Nhờ anh chỉnh giùm em chỗ này tý.
- chọn đối tượng(chọn tất cả những gì có trên bãn vẻ.
chương trình sẽ lọc ra chỉ chọn text, mtext và text của dim
-chương trình sẻ hỏi bạn muốn chuyển cao chữ là bao nhiêu( số do người dùng chọn)
chọn chiều cao chữ xong thì chương trình sẽ hỏi bạn có muốn chuyển về layer không. nếu có thì sẽ chọn layer do người dùng chọn .
- chương trình sẽ hỏi tiếp là bạn có muốn chuyển font chữ không
nếu có thì chuyển về font chữ mà do người dùng tự chọn VNswitzerlandcondlight.TTF.
-Anh can thiệp giùm em cái block thì càng tốt nếu không thì vẫn không sao
cảm ơn anh nhiều chúc mọi người sức khoe
  • 0

#3377 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 April 2011 - 10:58 AM

Cảm ơn anh đã giúp đỡ. Nhờ anh chỉnh giùm em chỗ này tý.
- chọn đối tượng(chọn tất cả những gì có trên bãn vẻ.
chương trình sẽ lọc ra chỉ chọn text, mtext và text của dim
-chương trình sẻ hỏi bạn muốn chuyển cao chữ là bao nhiêu( số do người dùng chọn)
chọn chiều cao chữ xong thì chương trình sẽ hỏi bạn có muốn chuyển về layer không. nếu có thì sẽ chọn layer do người dùng chọn .
- chương trình sẽ hỏi tiếp là bạn có muốn chuyển font chữ không
nếu có thì chuyển về font chữ mà do người dùng tự chọn VNswitzerlandcondlight.TTF.
-Anh can thiệp giùm em cái block thì càng tốt nếu không thì vẫn không sao
cảm ơn anh nhiều chúc mọi người sức khoe

- Về Block thì mình rất ngại, ví nó khù khoằm lắm. Nhất là thằng Dim, lắm lúc update dim thì lỗi do người vẽ dùng Override, k update thì code loòng thoòng ^^. Dù viết 1 số cái chỉnh đối tượng trong Block rồi nhưng mình chẳng ưa chúgn tẹo nào.Hề hề.
- Về layer, bạn nói chọn là chọn ở đâu nhỉ :) Từ 1 đối tượng mẫu hay tự đánh tên vào ^^, hay từ cái bảng nào nào đó.
- Về chọn đối tượng, hiện mình đã để chọn tất cả Dim,text, mtext, att text có trong bản vẽ
  • 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


#3378 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 24 April 2011 - 11:19 AM

- Về Block thì mình rất ngại, ví nó khù khoằm lắm. Nhất là thằng Dim, lắm lúc update dim thì lỗi do người vẽ dùng Override, k update thì code loòng thoòng ^^. Dù viết 1 số cái chỉnh đối tượng trong Block rồi nhưng mình chẳng ưa chúgn tẹo nào.Hề hề.
- Về layer, bạn nói chọn là chọn ở đâu nhỉ :) Từ 1 đối tượng mẫu hay tự đánh tên vào ^^, hay từ cái bảng nào nào đó.
- Về chọn đối tượng, hiện mình đã để chọn tất cả Dim,text, mtext, att text có trong bản vẽ

-chọn dối tượng không chọn all nữa mà là do người dụng từ khoanh vùng. layer thì do người nhập tự nhập vào(tự đánh tên vào)
  • 0

#3379 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 April 2011 - 12:21 PM

-chọn dối tượng không chọn all nữa mà là do người dụng từ khoanh vùng. layer thì do người nhập tự nhập vào(tự đánh tên vào)

(defun c:cht1(/ hText chLay Lay chFont)
(vl-load-com)
(command "undo" "be")
(princ "Ch\U+1ECDn Dim, *Text, ATT* c\U+1EA7n thay \U+0111\U+1ED5i :")
(setq ss (ssget '((0 . "DIMENSION,LEADER,*TEXT,ATT*"))))
(setq hText (getreal "\Chi\U+1EC1u cao ch\U+1EEF :") chLay "k" chFont "k")
(initget 1 "c k")
(setq chLay (getkword "B\U+1EA1n c\U+00F3 mu\U+1ED1n thay \U+0111\U+1ED5i layer Text ? <K>[C/K] :"))
(if (or (null chLay) (= (strcase chLay) "K"))
(setq Lay nil)
(setq Lay (getstring "T\U+00EAn layer :"))
)
(initget 1 "c k")
(setq chFont (getkword "B\U+1EA1n c\U+00F3 mu\U+1ED1n thay \U+0111\U+1ED5i Font ? <K> [C/K] :"))
(if (not(or (null chLay) (= (strcase chLay) "K")))
(progn
(vlax-for x (vla-get-textstyles
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-put-fontfile x "VNswitzerlandcondlight.TTF")
)
)
)
(foreach ent
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (vlax-property-available-p ent 'TextHeight) (vlax-put-property ent 'TextHeight (rtos hText 2 0) ))
(if (vlax-property-available-p ent 'Height) (vlax-put-property ent 'Height (rtos hText 2 0)) )
(if (and lay (vlax-property-available-p ent 'Layer)) (vlax-put-property ent 'Layer Lay))
)
(command "undo" "en")
)
Bạn dùng tạm :(
  • 1

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


#3380 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 24 April 2011 - 07:42 PM

(defun c:cht1(/ hText chLay Lay chFont)
(vl-load-com)
(command "undo" "be")
(princ "Ch\U+1ECDn Dim, *Text, ATT* c\U+1EA7n thay \U+0111\U+1ED5i :")
(setq ss (ssget '((0 . "DIMENSION,LEADER,*TEXT,ATT*"))))
(setq hText (getreal "\Chi\U+1EC1u cao ch\U+1EEF :") chLay "k" chFont "k")
(initget 1 "c k")
(setq chLay (getkword "B\U+1EA1n c\U+00F3 mu\U+1ED1n thay \U+0111\U+1ED5i layer Text ? <K>[C/K] :"))
(if (or (null chLay) (= (strcase chLay) "K"))
(setq Lay nil)
(setq Lay (getstring "T\U+00EAn layer :"))
)
(initget 1 "c k")
(setq chFont (getkword "B\U+1EA1n c\U+00F3 mu\U+1ED1n thay \U+0111\U+1ED5i Font ? <K> [C/K] :"))
(if (not(or (null chLay) (= (strcase chLay) "K")))
(progn
(vlax-for x (vla-get-textstyles
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-put-fontfile x "VNswitzerlandcondlight.TTF")
)
)
)
(foreach ent
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (vlax-property-available-p ent 'TextHeight) (vlax-put-property ent 'TextHeight (rtos hText 2 0) ))
(if (vlax-property-available-p ent 'Height) (vlax-put-property ent 'Height (rtos hText 2 0)) )
(if (and lay (vlax-property-available-p ent 'Layer)) (vlax-put-property ent 'Layer Lay))
)
(command "undo" "en")
)
Bạn dùng tạm :(

thankyou ketxu nhé. dùng rất là ok
  • 0