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

#3581 lenhatanh

lenhatanh

    biết vẽ polygon

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

Đã gửi 08 June 2011 - 02:28 PM

Chào cả Nhà !
xin cho mình hỏi trong CAD có thể viết Lisp tìm được giao của đường (LWPolyline có cao độ Z=/0)
với mặt (3D Face) không ?
  • 0

#3582 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 08 June 2011 - 02:47 PM

Chào cả nhà, em lại có chút việc để nhờ các bác giúp đỡ ạ. Việc của em là như sau:
Ví dụ mình đang có một text ABC1234. Thì có một lisp nào để có thể tự động list ra một loạt các text khác tăng một ký tự bất kỳ trong chuỗi text này không ạ. Chẳng hạn ở đây em muốn tăng dần (hoặc giảm) ký tự thứ 4 trong chuỗi trên, thì sau khi thực hiện lisp sẽ cho kết quả là ABC2234, ABC3234, ABC4234...
Hiện em đã sử dụng lisp đánh số cột nhưng mà chỉ thay đổi được ký tự cuối cùng thôi ạ!
Nhờ các bác giúp ạ, em cảm ơn các bác nhiều!

Của bạn đây, mình code gấp, hi vọng ít lỗi :
(defun C:lText (/ h ent str num truoc sau so inc pt i msp)
(setq ent (car(entsel "Ch\U+1ECDn text :")))
(if (=(cdadr (entget ent)) "TEXT" )
(progn
(redraw ent 3)
(setq str (cdr(assoc 1 (entget ent)))
num (getint "\nThay \U+0111\U+1ED5i ch\U+1EEF th\U+1EE9 m\U+1EA5y ? :"))
(if (distof (substr str num 1))
(progn
(setq truoc (substr str 1 (1- num))
sau (substr str (1+ num))
so (atof (substr str num 1))
inc (getint "\nT\U+0103ng m\U+1EA5y l\U+1EA7n ? :")
pt (getpoint "\nList ra :")
i -1
h (* (getvar "dimtxt")(getvar "dimscale"))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)
(repeat inc
(vla-addtext msp (strcat truoc (rtos (setq so (1+ so)) 2 0) sau) (vlax-3d-point (polar pt (/ pi -2) (* 1.5 (setq i (1+ i)) h))) h )
)
)
(princ "\nCh\U+1EEF ch\U+1EC9 \U+0111\U+1ECBnh kh\U+00F4ng ph\U+1EA3i s\U+1ED1!")
)
)
)
(redraw ent 4)
(princ)
)

  • 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


#3583 nhocbabi

nhocbabi

    biết vẽ rectang

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

Đã gửi 08 June 2011 - 03:45 PM

Của bạn đây, mình code gấp, hi vọng ít lỗi :

(defun C:lText (/ h ent str num truoc sau so inc pt i msp)
(setq ent (car(entsel "Ch\U+1ECDn text :")))
(if (=(cdadr (entget ent)) "TEXT" )
(progn
(redraw ent 3)
(setq str (cdr(assoc 1 (entget ent)))
num (getint "\nThay \U+0111\U+1ED5i ch\U+1EEF th\U+1EE9 m\U+1EA5y ? :"))
(if (distof (substr str num 1))
(progn
(setq truoc (substr str 1 (1- num))
sau (substr str (1+ num))
so (atof (substr str num 1))
inc (getint "\nT\U+0103ng m\U+1EA5y l\U+1EA7n ? :")
pt (getpoint "\nList ra :")
i -1
h (* (getvar "dimtxt")(getvar "dimscale"))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)
(repeat inc
(vla-addtext msp (strcat truoc (rtos (setq so (1+ so)) 2 0) sau) (vlax-3d-point (polar pt (/ pi -2) (* 1.5 (setq i (1+ i)) h))) h )
)
)
(princ "\nCh\U+1EEF ch\U+1EC9 \U+0111\U+1ECBnh kh\U+00F4ng ph\U+1EA3i s\U+1ED1!")
)
)
)
(redraw ent 4)
(princ)
)

Mình đã dùng thử lisp của bạn cho, nhưng không hiểu sao lúc lisp hỏi "list ra" thì mình không thể chọn được điểm để đặt các text tiếp theo. Không biết mình có làm sai chỗ nào không. Nhờ bạn kiểm tra lại giúp ạ!
  • 0

#3584 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 08 June 2011 - 04:03 PM

Mình đã dùng thử lisp của bạn cho, nhưng không hiểu sao lúc lisp hỏi "list ra" thì mình không thể chọn được điểm để đặt các text tiếp theo. Không biết mình có làm sai chỗ nào không. Nhờ bạn kiểm tra lại giúp ạ!

Mình viết để list ra hàng loạt 1 phát luôn, chứ không phải giống Copy tăng. Liệu có phải ý bạn là cứ copy tăng hoài ??? (vì trong bản vẽ cũng không nói phương thức "list" ra)
Thông báo lỗi của bạn là gì ???

P/S : cũng là vì bạn không thể hiện ý kiến 1 cách đầy đủ, nên để bài viết qua lại cứ nhiều lên từng giờ, mà topic thì ngày một loãng đi..
  • 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


#3585 nhocbabi

nhocbabi

    biết vẽ rectang

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

Đã gửi 08 June 2011 - 05:01 PM

Mình viết để list ra hàng loạt 1 phát luôn, chứ không phải giống Copy tăng. Liệu có phải ý bạn là cứ copy tăng hoài ??? (vì trong bản vẽ cũng không nói phương thức "list" ra)
Thông báo lỗi của bạn là gì ???

P/S : cũng là vì bạn không thể hiện ý kiến 1 cách đầy đủ, nên để bài viết qua lại cứ nhiều lên từng giờ, mà topic thì ngày một loãng đi..

Ý mình là làm theo kểu copy đấy ạ, mỗi một lần copy thì số trong text sẽ tăng dần. Điểm đặt của các text sẽ do mình chọn.
Còn lisp bạn cho mình, khi chọn text, chọn số muốn tăng, chọn số lần tăng xong, thì dòng lệnh lại về command.
Mình cũng ko muốn viết bài qua lại nhiều lần đâu, vừa mất thời gian của mọi người vừa làm ảnh hưởng đến diễn đàn. Nhưng thực sự, mình chỉ biết diễn đạt đến vậy. Nên nếu có gì, mong bạn và mọi người thông cảm dùm mình, mình cũng không cố ý mà!
  • 0

#3586 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 08 June 2011 - 10:40 PM

Ý mình là làm theo kểu copy đấy ạ, mỗi một lần copy thì số trong text sẽ tăng dần. Điểm đặt của các text sẽ do mình chọn.
Còn lisp bạn cho mình, khi chọn text, chọn số muốn tăng, chọn số lần tăng xong, thì dòng lệnh lại về command.
Mình cũng ko muốn viết bài qua lại nhiều lần đâu, vừa mất thời gian của mọi người vừa làm ảnh hưởng đến diễn đàn. Nhưng thực sự, mình chỉ biết diễn đạt đến vậy. Nên nếu có gì, mong bạn và mọi người thông cảm dùm mình, mình cũng không cố ý mà!

Mình bôi đỏ dòng "Thông báo lỗi của bạn là gì", không biết bạn để ý không. Vì như bạn nói thì đến tạo text lisp mình cũng không làm đc, trong khi bên máy mình lại được, nên cũng chẳng biết sao nữa.
Còn cái vụ copy với "list", mình đã mất 2 lần hỏi bạn từ "list" của bạn có nghĩa là gì, đến bây giờ nó mới lòi ra là COPY...haiza...
Mình sửa thành copy, thực chất là tạo text mới theo text style hiện hành.
Nếu bạn không ưng, có thể sửa thành copy đối tượng gốc.
Lần này nếu dùng mà không được như ý, mong bạn nhấn F2 ngay lúc thực hiện lisp bị lỗi và copy nó lên đây nhé
(defun C:lText (/ h ent str num truoc sau so pt msp)
(setq ent (car(entsel "Ch\U+1ECDn text :")))
(if (wcmatch(cdadr (entget ent)) "*TEXT" )
(progn
(redraw ent 3)
(setq str (cdr(assoc 1 (entget ent)))
num (getint "\nThay \U+0111\U+1ED5i ch\U+1EEF th\U+1EE9 m\U+1EA5y ? :"))
(redraw ent 4)
(if (distof (substr str num 1))
(progn
(setq truoc (substr str 1 (1- num))
sau (substr str (1+ num))
so (atof (substr str num 1))
h (* (getvar "dimtxt")(getvar "dimscale"))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)
(while (setq pt (getpoint "\nList ra :"))
(vla-addtext msp (strcat truoc (rtos (setq so (1+ so)) 2 0) sau) (vlax-3d-point pt) h )
)
)
(princ "\nCh\U+1EEF ch\U+1EC9 \U+0111\U+1ECBnh kh\U+00F4ng ph\U+1EA3i s\U+1ED1!")
)
)
)
(princ)
)


P/S : copy đối tượng gốc bác Tuệ đã làm bên dưới, có thêm phần bước nhảy ("tăng mấy lần ^^"), nếu có Express thì bạn có thể dùng
  • 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


#3587 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 08 June 2011 - 10:48 PM

Ý mình là làm theo kểu copy đấy ạ, mỗi một lần copy thì số trong text sẽ tăng dần. Điểm đặt của các text sẽ do mình chọn.
Còn lisp bạn cho mình, khi chọn text, chọn số muốn tăng, chọn số lần tăng xong, thì dòng lệnh lại về command.
Mình cũng ko muốn viết bài qua lại nhiều lần đâu, vừa mất thời gian của mọi người vừa làm ảnh hưởng đến diễn đàn. Nhưng thực sự, mình chỉ biết diễn đạt đến vậy. Nên nếu có gì, mong bạn và mọi người thông cảm dùm mình, mình cũng không cố ý mà!

Bạn thử code này :

(defun C:lText (/ dich ent str num truoc sau so inc)
(setq ent (car(entsel "Ch\U+1ECDn text :")))
(if (= (cdr (assoc 0 (entget ent))) "TEXT" )
(progn
(setq ins (cdr (assoc 10 (entget ent)))
str (cdr(assoc 1 (entget ent)))
num (getint "\nThay \U+0111\U+1ED5i ch\U+1EEF th\U+1EE9 m\U+1EA5y ? :")
inc (getint "\nT\U+0103ng m\U+1EA5y l\U+1EA7n ? :")
truoc (substr str 1 (1- num))
sau (substr str (1+ num))
so1 (atof (substr str num 1))

)
(setq dich (acet-ss-drag-move (ssadd ent (ssadd)) ins "\n Diem dich Move" t))
(while dich
(setq so (strcat truoc (rtos (setq so1 (+ so1 inc)) 2 0) sau) )
(if (distof (substr str num 1))
(progn

(command "copy" ent "" ins dich)
(setq ent (entlast))
(entmod (subst (cons 1 so) (assoc 1 (entget ent)) (entget ent)))
(setq ins (cdr (assoc 10 (entget ent))) )
(setq dich (acet-ss-drag-move (ssadd ent (ssadd)) ins "\n Diem dich Move" t))
(setq str (cdr(assoc 1 (entget ent))) )

)
)
)
))
(princ)
)

  • 1

#3588 nhocbabi

nhocbabi

    biết vẽ rectang

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

Đã gửi 09 June 2011 - 08:54 AM

Mình bôi đỏ dòng "Thông báo lỗi của bạn là gì", không biết bạn để ý không. Vì như bạn nói thì đến tạo text lisp mình cũng không làm đc, trong khi bên máy mình lại được, nên cũng chẳng biết sao nữa.
Còn cái vụ copy với "list", mình đã mất 2 lần hỏi bạn từ "list" của bạn có nghĩa là gì, đến bây giờ nó mới lòi ra là COPY...haiza...
Mình sửa thành copy, thực chất là tạo text mới theo text style hiện hành.
Nếu bạn không ưng, có thể sửa thành copy đối tượng gốc.
Lần này nếu dùng mà không được như ý, mong bạn nhấn F2 ngay lúc thực hiện lisp bị lỗi và copy nó lên đây nhé

(defun C:lText (/ h ent str num truoc sau so pt msp)
(setq ent (car(entsel "Ch\U+1ECDn text :")))
(if (wcmatch(cdadr (entget ent)) "*TEXT" )
(progn
(redraw ent 3)
(setq str (cdr(assoc 1 (entget ent)))
num (getint "\nThay \U+0111\U+1ED5i ch\U+1EEF th\U+1EE9 m\U+1EA5y ? :"))
(redraw ent 4)
(if (distof (substr str num 1))
(progn
(setq truoc (substr str 1 (1- num))
sau (substr str (1+ num))
so (atof (substr str num 1))
h (* (getvar "dimtxt")(getvar "dimscale"))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)
(while (setq pt (getpoint "\nList ra :"))
(vla-addtext msp (strcat truoc (rtos (setq so (1+ so)) 2 0) sau) (vlax-3d-point pt) h )
)
)
(princ "\nCh\U+1EEF ch\U+1EC9 \U+0111\U+1ECBnh kh\U+00F4ng ph\U+1EA3i s\U+1ED1!")
)
)
)
(princ)
)


P/S : copy đối tượng gốc bác Tuệ đã làm bên dưới, có thêm phần bước nhảy ("tăng mấy lần ^^"), nếu có Express thì bạn có thể dùng

Mình đã dùng lisp bác cho, nhưng không hiểu sao nó vẫn báo lỗi. Lỗi như sau ạ:
Command: ltext
Chọn text :
Thay đổi chữ thứ mấy ? :5
; error: no function definition: VLAX-GET-ACAD-OBJECT

Command:
Command: ltext
Chọn text :6
; error: bad argument type: lentityp nil

Command:
Command: ltext
Chọn text :3
; error: bad argument type: lentityp nil

Trong trường hợp này, text của mình là ABC1234ABC. Mình đã thử đi thử lại vẫn không được! Vì thực chất mình cũng không biết gì về lisp cả, chỉ biết đi xin và sử dụng thôi. Nên chắc còn phải nhờ mọi người giúp đỡ dài dài!
Còn lisp của bác Tue_NV cho, mình đã sử dụng rồi, và suôn sẻ bạn ạ!
  • 0

#3589 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 09 June 2011 - 09:23 AM

Mình đã dùng lisp bác cho, nhưng không hiểu sao nó vẫn báo lỗi. Lỗi như sau ạ:
Command: ltext
Chọn text :
Thay đổi chữ thứ mấy ? :5
; error: no function definition: VLAX-GET-ACAD-OBJECT

Command:
Command: ltext
Chọn text :6
; error: bad argument type: lentityp nil

Command:
Command: ltext
Chọn text :3
; error: bad argument type: lentityp nil

Trong trường hợp này, text của mình là ABC1234ABC. Mình đã thử đi thử lại vẫn không được! Vì thực chất mình cũng không biết gì về lisp cả, chỉ biết đi xin và sử dụng thôi. Nên chắc còn phải nhờ mọi người giúp đỡ dài dài!
Còn lisp của bác Tue_NV cho, mình đã sử dụng rồi, và suôn sẻ bạn ạ!

Bạn thêm dòng (vl-load-com) vào trong Lisp của Ketxu là được.

(defun C:lText (/ h ent str num truoc sau so pt msp)
(vl-load-com)
(setq ent (car(entsel "Ch\U+1ECDn text :")))
.....
  • 0

#3590 tranhoangxd

tranhoangxd

    biết vẽ circle

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

Đã gửi 09 June 2011 - 10:16 AM

nhờ các bác viết hộ em một cái lisp mà nó thực hiện như sau
vd nếu đoạn trước mình move một đoạn 100
thì đoạn move sau cũng vậy
hay stretch cung vậy
( đại loại là nếu thực hiện những lệnh nào liên quan đến chuyển khoảng cách thì nó sẽ nhớ đc khoảng cách trước đó mà mình đã thưc hiên)
cảm ơn các bác trươc
  • 0

#3591 beba

beba

    biết zoom

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

Đã gửi 09 June 2011 - 10:29 AM

Em đã sửa " (wcmatch (cdadr (entget ent)) "*POLYLINE") " và đã dùng ngon rồi
Cảm ơn Tue_NV
Cảm ơn Ketxu
  • 0

#3592 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 09 June 2011 - 12:20 PM

rất cảm ơn pro phamngoctukts đã nhiệt tình giúp đỡ
lisp chạy rất ổn

pro nào rảnh chỉnh lại em đoan lisp ko biết pro nào viết
dây là lisp nối line
chỉnh lại là chỉ nối những line được chon được không a
vì lisp này chọn line xong những line nào dính chạm điểm đầu đều nối tất
tuy cũng tiện nhưng cũng có lúc bất tiện
mong các pro giúp đỡ


(defun c:jj (/ tdt ssdt sodt index)
(defun ObjName (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
(defun MoPL (ssdt /)
(= (cdr (assoc '70 (entget ssdt))) 0)
)
(defun NoiPL (ssdt /)
(if (MoPL ssdt)
(command ".PEDIT" ssdt "J" "All" "" "X")
)
)
(defun NoiLC (ssdt /)
(command ".PEDIT" ssdt "Y" "J" "All" "" "X")
)
(setq
tdt (ssget)
sodt (sslength tdt)
index 0
)
(repeat sodt
(setq
ssdt (ssname tdt index)
index (1+ index)
)
(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE")
)
(NoiPL ssdt)
)
(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt)
)
)
(command "osnap" "end,cen,mid,ins,int,nea,nod,qua,per,tan,app,ext,par" )
(princ)
)

Hề hề hề,
Chả biết mình có lẩm cẩm không, nhưng nếu như mình hiểu đúng yêu cầu của bạn thì bạn chỉ cần chọn các đối tượng cần nối là Ok mà. Vì trong lisp này tập đối tượng tdt là do bạn có quyền lựa chọn. Những thằng nào bạn không muốn nối thì chỉ việc cóc thèm chọn nó là xong.
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.

#3593 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 09 June 2011 - 02:03 PM

nhờ các bác viết hộ em một cái lisp mà nó thực hiện như sau
vd nếu đoạn trước mình move một đoạn 100
thì đoạn move sau cũng vậy
hay stretch cung vậy
( đại loại là nếu thực hiện những lệnh nào liên quan đến chuyển khoảng cách thì nó sẽ nhớ đc khoảng cách trước đó mà mình đã thưc hiên)
cảm ơn các bác trươc

Theo mình nghĩ là khó !
  • 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


#3594 3d.decor

3d.decor

    biết vẽ arc

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

Đã gửi 09 June 2011 - 02:14 PM

Hề hề hề,
Chả biết mình có lẩm cẩm không, nhưng nếu như mình hiểu đúng yêu cầu của bạn thì bạn chỉ cần chọn các đối tượng cần nối là Ok mà. Vì trong lisp này tập đối tượng tdt là do bạn có quyền lựa chọn. Những thằng nào bạn không muốn nối thì chỉ việc cóc thèm chọn nó là xong.
Hề hề hề....

không được bác à
kể cả ẩn layer khác chạm vào đầu line chọn nó cũng nối nữa ko tin bác dùng thử thì biết
em toàn chon một line và ok thì line nào chạm nó nối tất
em tạm thời lock layer không nối để dùng tạm thì được
  • 0

#3595 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 09 June 2011 - 02:47 PM

không được bác à
kể cả ẩn layer khác chạm vào đầu line chọn nó cũng nối nữa ko tin bác dùng thử thì biết
em toàn chon một line và ok thì line nào chạm nó nối tất
em tạm thời lock layer không nối để dùng tạm thì được

Bạn dùng tạm cái này. Lisp bạn post chủ đích của bác Hoành là làm nó nối tất mà chỉ cần chọn 1 Line đầu, giờ bạn lại muốn k xài cái đặc ích của nó thì quả không phù hợp, chi bằng viết cái khác :)
(defun c:jj (/ lstSS lstEt ss)
(setq lstSS (acet-ss-to-list (setq ss(ssget)))
lstEtype (mapcar 'cdadr (mapcar 'entget lstSS)))
(if (or (vl-position "LINE" lstEtype) (vl-position "ARC" lstEtype))
(command ".pedit" "m" ss "" "Y" "J" 0 "")
(command ".pedit" "m" ss "J" 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


#3596 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 09 June 2011 - 02:53 PM

không được bác à
kể cả ẩn layer khác chạm vào đầu line chọn nó cũng nối nữa ko tin bác dùng thử thì biết
em toàn chon một line và ok thì line nào chạm nó nối tất
em tạm thời lock layer không nối để dùng tạm thì được

Hề hề hề,
Bạn thử xài cái này coi sao hỉ???

(defun c:jj (/ tdt ssdt sodt index)
(defun ObjName (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
(defun MoPL (ssdt /)
(= (cdr (assoc '70 (entget ssdt))) 0)
)
(defun NoiPL (ssdt ss /)
(if (MoPL ssdt)
(command ".PEDIT" ssdt "J" ss "" "X")
)
)
(defun NoiLC (ssdt ss/)
(command ".PEDIT" ssdt "Y" "J" ss "" "X")
)
(setq
tdt (ssget)
sodt (sslength tdt)
index 0
)
(repeat sodt
(setq
ssdt (ssname tdt index)
index (1+ index)
)
(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE")
)
(NoiPL ssdt tdt)
)
(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt tdt)
)
)
(command "osnap" "end,cen,mid,ins,int,nea,nod,qua,per,tan,app,ext,par" )
(princ)
)

Hy vọng đúng ý bạn.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3597 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 09 June 2011 - 03:15 PM

các bác ai có cái lisp tính khoảng cách cho em xin với
ý tưởng của em là :
1) pick vào điểm A
2) pick vào điểm B
3)pick vào text cần thay đổi ( nếu có bước 3 thì kết thúc luôn không cần bước 4 )
4) nếu không có text cầ thay đổi thì chọn điểm ghi text mới


và em có 1 cái lisp với nội dung như dưới đây , nhưng khi em dùng nó thì nó chống với các lisp khác , có cao thủ nào chỉnh sửa nó hộ em vơi .
cái lisp đó là lisp tính cao độ .

nội dung :


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq sc 1)
(setvar "dimzin" 0)
(defun c:os () (setvar "osmode" 545))
;;;;;===============================
;; Silent load.
(princ)
(defun c:e1 () (command "erase" "all" ""))

(defun c:+++++ () (command "'.zoom" "8x"))
(defun c:++++++ () (command "'.zoom" "16x"))
(defun c:++++ () (command "'.zoom" "4x"))
(defun c:+++ () (command "'.zoom" "2x"))
(defun c:++ () (command "'.zoom" "1.5x"))
(defun c:+ () (command "'.zoom" "1.2x"))
(defun c:- () (command "'.zoom" "0.9x"))
(defun c:-- () (command "'.zoom" "0.5x"))
(defun c:--- () (command "'.zoom" "0.2x"))
(defun c:---- () (command "'.zoom" "0.1x"))
(defun c:----- () (command "'.zoom" "0.05x"))
(defun c:------ () (command "'.zoom" "0.01x"))
(defun c:1 () (ssget) (command "change" "p" "" "p" "c" "1" ""))
(defun c:2 () (ssget) (command "change" "p" "" "p" "c" "2" ""))
(defun c:3 () (ssget) (command "change" "p" "" "p" "c" "3" ""))
(defun c:4 () (ssget) (command "change" "p" "" "p" "c" "4" ""))
(defun c:5 () (ssget) (command "change" "p" "" "p" "c" "5" ""))
(defun c:6 () (ssget) (command "change" "p" "" "p" "c" "6" ""))
(defun c:7 () (ssget) (command "change" "p" "" "p" "c" "7" ""))
(defun c:8 () (ssget) (command "change" "p" "" "p" "c" "8" ""))
(defun c:9 () (ssget) (command "change" "p" "" "p" "c" "9" ""))
(defun c:10 () (ssget) (command "change" "p" "" "p" "c" "10" ""))
(defun c:11 () (ssget) (command "change" "p" "" "p" "c" "11" ""))
(defun c:0 () (ssget) (command "change" "p" "" "p" "c" "BY LAYER" ""))
;**********************************************************************
(defun c:goc ()
(setvar "cmdecho" 0)
;(setq osm (getvar "osmode"))
(if (= sc nil)(setq sc (getreal (strcat"\nChon ty le ve (=kt ve/kt Autocad):"))))
(prompt "\n*****Chu y: Ty le hien tai la*****:")(princ sc)
;(if (/= sc2 nil)(setq sc sc2))
(command ".zoom" "e")
;(setq sspl (SSGET "c" '(10.5 20.25) '(10.5 27.5) (LIST(CONS 0 "lwpolyline"))));su dung khi ban ve co 1 cn o toa do co dinh
;(if (= th nil) (setq th (ssget "w" '(10.5 19.25 0) '(11.5 18.00 0) (list(cons 0 "TEXT")))))
(command "zoom" "p")
(if (and (= a nil)(/= sspl nil))(setq a (cdr(assoc 10 (entget (ssname sspl 0))))))
(IF (= a nil)
(setq a (Getpoint "\n Chon mot diem lam chuan (co cao do):"))
(progn
(setq kitu nil)
(initget "Co Khong")
(setq kitu (getkword "\n Ban co chon lai diem chuan khong?[Co/Khong]:<K>"))
(If (= kitu "Co")(setq a (Getpoint "\n Chon lai diem lam chuan (co cao do):")))
)
)

;(if (and(= nil g)(/= nil th)) (setq g (atof (cdr (ASSOC 1 (ENTGET (SSNAME th 0)))))))
(IF (= nil g)
(progn
(prompt "Khong co cao do tai vi tri can tim!")
(setq g (Getreal "\n Nhap cao do diem chuan [Bang ban phim/Chon tren man hinh]:<Chon>" ))
(if (= nil g)
(progn
(setq sscd (entsel "\n Moi ban chon cao do tren man hinh:"))
(setq g (atof (cdr (assoc 1 (entget (car sscd))))))
(prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
)
)
)
(If(= kitu "Co")
(progn
(setq g (Getreal "\n Nhap lai cao do diem chuan [Bang ban phim/Chon tren man hinh]:<Chon>" ))
(if (= nil g)
(progn
(setq sscd (entsel "\n Moi ban chon lai cao do tren man hinh:"))
(setq g (atof (cdr (assoc 1 (entget (car sscd))))))
(prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
)
)
)
)
)
)


;;============Tinh cao do khi biet cao do diem chon lam c:goc====================
(defun c:tcd ()
(PROMPT "\n(Lenh tinh toa do & K/C 1 diem bat ky)")
(c:goc)
(setq xa (* sc (car a)))
(setq ya (* sc (cadr a)))
(setq l1 xa)
(setq l3 ya)
(While
(setq b (Getpoint "\n Chon diem can tinh:"))
(setq xb (* sc (car B)))
(setq x (- xb xa))
(setq yb (* sc (cadr B)))
(setq y (+ g (- yb ya)))
(setq ypr (rtos y 2 3))
(setq l2 xb)
(setq l4 yb)
(setq dy (- l4 l3))
(setq l3 l4)
(setq l (- l2 l1))
(setq ypr1 (rtos L 2 3))
(setq l1 l2)
(Prompt "\nCao do diem vua chon:") (princ (rtos y 2 3))
(Prompt "\nK/C x le:") (princ (rtos l 2 3))
(Prompt " _ K/C x den diem goc:") (princ (rtos x 2 3))
(if (= 0 l)
(Prompt " _ Do doc doan vua chon: E%")
(Progn
(setq dd (* 100 (/ dy l)))
(Prompt " _ Do doc doan vua chon:")(princ (rtos dd 2 3))(princ "%")
)
)

;(setq pt2 (getpoint "\nDiem ghi cao do vua tinh duoc :"))
;(command "TEXT" pt2 "" "90" ypr)
;(setq pt3 (getpoint "\nDiem ghi K/C le vua tinh duoc :"))
;(command "TEXT" pt3 "" "90" ypr1)
;(setq a '(0 0 0) g 0)
(setq thchon (nentselp"\nChon text can thay the:"))
(if (/= nil thchon)
(progn
(setq ens (car thchon))
(COMMAND "CHANGE" ens "" "" "" "" "" ""(rtos y 2 2))
(COMMAND "CHANGE" ens "" "p" "c" "6" "")
)
)
(princ)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Bài viết đã được chỉnh sửa nội dung bởi ketxu: 09 June 2011 - 03:32 PM
Nhắc bạn hakhoailang lần sau post code thì cho vào thẻ code!

  • -1

#3598 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 09 June 2011 - 03:44 PM

các bác ai có cái lisp tính khoảng cách cho em xin với
ý tưởng của em là :
1) pick vào điểm A
2) pick vào điểm B
3)pick vào text cần thay đổi ( nếu có bước 3 thì kết thúc luôn không cần bước 4 )
4) nếu không có text cầ thay đổi thì chọn điểm ghi text mới

Của bạn :
(defun c:kc (/ kc ent A) 
(vl-load-com)
(setq kc (rtos (distance (setq A (getpoint "\nDiem A :"))(getpoint A "\nDiem B :")) 2 2))
(if (setq ent (car(entsel "\n Chon text sua :")))
(vla-put-TextString (vlax-ename->vla-object ent) kc)
(vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) kc
(vlax-3d-point (getpoint "\n Diem dat text :")) (* (getvar "dimtxt")(getvar "dimscale")))
))

  • 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


#3599 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 09 June 2011 - 04:21 PM

các bác ai có cái lisp tính khoảng cách cho em xin với
ý tưởng của em là :
1) pick vào điểm A
2) pick vào điểm B
3)pick vào text cần thay đổi ( nếu có bước 3 thì kết thúc luôn không cần bước 4 )
4) nếu không có text cầ thay đổi thì chọn điểm ghi text mới

Cái này dùng dim vẫn được sao phải dùng lisp nhỉ?
  • 0

#3600 3d.decor

3d.decor

    biết vẽ arc

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

Đã gửi 09 June 2011 - 05:00 PM

Bạn dùng tạm cái này. Lisp bạn post chủ đích của bác Hoành là làm nó nối tất mà chỉ cần chọn 1 Line đầu, giờ bạn lại muốn k xài cái đặc ích của nó thì quả không phù hợp, chi bằng viết cái khác :)

(defun c:jj (/ lstSS lstEt ss)
(setq lstSS (acet-ss-to-list (setq ss(ssget)))
lstEtype (mapcar 'cdadr (mapcar 'entget lstSS)))
(if (or (vl-position "LINE" lstEtype) (vl-position "ARC" lstEtype))
(command ".pedit" "m" ss "" "Y" "J" 0 "")
(command ".pedit" "m" ss "J" 0 "")
))

quá đúng ý em
thank pro
yêu cadviet quá
  • 0