Đến nội dung


Hình ảnh
- - - - -

[ yêu cầu] Viết tên layer và offset một khoảng a khi click vào một line


  • Please log in to reply
8 replies to this topic

#1 xuanhaoxd

xuanhaoxd

    biết zoom

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

Đã gửi 13 February 2012 - 02:25 PM

Em đang làm về kết cấu thép, có một bài toán xin được các anh giúp đỡ.
Trong file cad của em tên layer được viết theo kích thước ngoài nhân chiều dày, vd: 7620254 tức là (phi) D762x25.4, mặc định 3 số sau là bề dày có 1 số sau dấu phẩy, còn lại là đường kính ngoài có 1 số sau dấu phẩy: (vd: 4064220 là 406.4x22 )

Em nhờ các anh viết cho em 3 lisp là:
- Khi chọn vào một line thì viết tên layer kiểu 7620254 theo phương line đó và offset cách line đó 1 khoảng a nhập vào. Có thể chọn nhiều line và viết 1 lúc.
- Khi chọn vào một line thì viết text kiểu Phi 762x25.4 được suy ra từ tên layer theo phương line đó và offset cách line đó 1 khoảng a nhập vào
- một lisp chuyển đổi tên giữa 2 layer đó với nhau: 7620254 đổi sang 762x25.4 và ngược lại
Mong được sự giúp đỡ của các anh,
Em xin cảm ơn nhiều !!
file đính kèm: http://www.mediafire...yt1x9lav0v3t8n1 ( ko up trực tiếp được )
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 February 2012 - 06:31 PM

Lâu quá chưa làm cái nào, tái khởi động ^^ xuanhao thử dùng xem hợp ý chưa. 3 lệnh lần lượt là test1, test2 , test3, bạn có thể thay nếu thấy dùng được.

http://www.cadviet.c...7_test123_1.rar



@xuanhaoxd : bạn còn nhớ Topic này k :) Dạo này lại thay đổi chỗ làm r chăng ?
http://www.cadviet.c...ndpost&p=173217
  • 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


#3 xuanhaoxd

xuanhaoxd

    biết zoom

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

Đã gửi 14 February 2012 - 12:57 AM

Hihi, a nhắc lại làm e thấy ngại quá ^^, nói chung có vậy mình mới khôn thêm dc tý,
Cảm ơn anh Ketxu nhiều nha !!
Tuy có chút là những layer vd: 18300450 thì bị đưa về hết 183x45, thực tế là 1830x45, anh chỉnh hộ em chút được không ạ . thaks !!
@: Mà anh ketxu giận chú dai quá hay sao mà dành tặng luôn 1 câu, muốn sửa cũng ko dc , :D ! Thiện tai! thiện tai !! ^^
Chúc a ngày mới tốt lành !! :),
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 February 2012 - 08:54 AM


;1
(defun c:Test1(/ adoc msp ang)
(vl-load-com)
(alert "\n@Ketxu t\U+1EB7ng xuanhaoxd")
(or #h (setq #h 1))
(or #of (setq #of 1))
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))
msp (vla-get-modelspace adoc)
#h (cond ((getreal (strcat "Chieu cao chu <" (rtos #h 2 1) "> :")))(#h))
#of (cond ((getreal (strcat "Khoang offset <" (rtos #of 2 2) "> :")))(#of))
)
(prompt "\nChon Line(s) :")
(ssget (list (cons 0 "LINE")))
(vlax-for eLine (vla-get-ActiveSelectionSet aDoc)
(setq ang (reAng (angle (vlax-get eLine 'StartPoint) (vlax-get eLine 'EndPoint))))
(vla-put-Rotation
;AddText
(vla-addtext msp (vla-get-Layer eLine)
;MidPoint
(vlax-3d-point
(polar
((lambda(a B)(mapcar '* (mapcar '+ a B) '(0.5 0.5 0.5)))
(vlax-get eLine 'StartPoint)
(vlax-get eLine 'EndPoint)
)
(+ ang (* pi 0.5))
#of
)
)
#h
)
ang
)
)
)
;2
(defun c:Test2(/ adoc msp ang)
(vl-load-com)
(alert "\n@Ketxu t\U+1EB7ng xuanhaoxd")
(or #h (setq #h 1))
(or #of (setq #of 1))
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))
msp (vla-get-modelspace adoc)
#h (cond ((getreal (strcat "Chieu cao chu <" (rtos #h 2 1) "> :")))(#h))
#of (cond ((getreal (strcat "Khoang offset <" (rtos #of 2 2) "> :")))(#of))
)
(prompt "\nChon Line(s) :")
(ssget (list (cons 0 "LINE")))
(vlax-for eLine (vla-get-ActiveSelectionSet aDoc)
(setq ang (reAng (angle (vlax-get eLine 'StartPoint) (vlax-get eLine 'EndPoint))))
(vla-put-Rotation
;AddText
(vla-addtext msp (strcat "%%c" (parse (vla-get-Layer eLine)))
;MidPoint
(vlax-3d-point
(polar
((lambda(a B)(mapcar '* (mapcar '+ a B) '(0.5 0.5 0.5)))
(vlax-get eLine 'StartPoint)
(vlax-get eLine 'EndPoint)
)
(+ ang (* pi 0.5))
#of
)
)
#h
)
ang
)
)
)
;3
(defun c:Test3 ( / lay_col lay_nm lay)
(vl-load-com)
(alert "\n@Ketxu t\U+1EB7ng xuanhaoxd")
(setq lay_col (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for lay lay_col
(setq lay_nm (vla-get-name lay))
(if (and (< (strlen lay_nm) 9) (not (zerop (atof lay_nm))))
(vla-put-name lay (parse lay_nm))
)
)
(vlax-release-object lay_col)
(princ)
)
(defun Pur0 (x / sth)
(strcat (substr x 1 (1- (strlen x)))
(if (= (setq sth (substr x (strlen x))) "0") ""
(strcat "." sth))
))
(defun Pur0 (a / x)
(if (zerop (rem (atoi a) 10))
(itoa (/ (atoi a) 10))
(rtos (/ (distof a) 10) 2 1)
))
(defun Parse (str)
(strcat
(pur0 (substr str 1 (- (strlen str) 3)))
"x"
(pur0 (substr str (- (strlen str) 2)))
)
)
;18300450
(defun ReAng ( a )
( (lambda ( a ) (if (and (< (/ pi 2.0) a) (<= a (/ (* 3.0 pi) 2.0))) (+ a pi) a))
(rem (+ a pi pi) (+ pi pi))
)
)
(setvar "modemacro" "\n@Ketxu t\U+1EB7ng xuanhaoxd")

@Lispers : mọi người xem tại sao ở Lisp test3, nếu dùng distof thay cho (not(zerop...)) thì lại có thể gây lỗi ?
  • 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


#5 xuanhaoxd

xuanhaoxd

    biết zoom

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

Đã gửi 14 February 2012 - 09:07 AM

cảm ơn a S Tùng nhiều nha, chúc a có nhiều niềm vui trong cuộc sống,
@bên lề: Xin hỏi a STùng giờ đang làm ở đâu ạ, có dịp mời a đi cafe, :)
  • 0

#6 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 14 February 2012 - 09:35 AM

@Lispers : mọi người xem tại sao ở Lisp test3, nếu dùng distof thay cho (not(zerop...)) thì lại có thể gây lỗi ?

Do, chẳng hạn:
(atof "2.3a") => 2.3 => (not (zerop (atof "2.3a"))) => T
(distof "2.3a") => nil
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#7 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 February 2012 - 10:23 AM

Do, chẳng hạn:
(atof "2.3a") => 2.3 => (not (zerop (atof "2.3a"))) => T
(distof "2.3a") => nil

Đó là 1 lý do bác ạ
Ở đây lỗi e tránh lại là lỗi khác.
Kiểm tra tên layer xem nó có phải toàn số và số lượng số nhỏ hơn 9 (layer name) hay k, nếu phải thì đổi tên theo yêu cầu. Vậy đáng lý dùng distof mới phải, mà e dùng k được, tại sao vậy ^^

@xuanhaoxd : Nếu k phàn nàn gì thì bạn click Like this là được r. Mình làm XD, ở HN
  • 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


#8 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 14 February 2012 - 12:11 PM


;.........
(defun Parse (str)
(strcat
(pur0 (substr str 1 (- (strlen str) 3)))
"x"
(pur0 (substr str (- (strlen str) 2)))
)
)
;.......

@Lispers : mọi người xem tại sao ở Lisp test3, nếu dùng distof thay cho (not(zerop...)) thì lại có thể gây lỗi ?

Khi chiều dài của tên Layer nhỏ hơn 3 (VD : Layer zero), dòng (- (strlen str) 3) trả về giá trị âm
-> (substr ...) bị lỗi.

Đề nghị :
đổi : (and (< (strlen lay_nm) 9) (not (zerop (atof lay_nm))) )
thành : (and (< 2 (strlen lay_nm) 9) (distof lay_nm) )
  • 3

#9 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 February 2012 - 12:39 PM

Hi, k qua được mắt bác gia_bach ^^ Hàm báo -1 trong substr do trong sub funtcion Parse ketxu không chịu bắt tẹo lỗi nào, chứ không liên quan đến đoạn tung hỏa mù bên trên. Cái này đáng phải cho sang bên đố vui mới phải ^^ Tks bác gia_bach :">
  • 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