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

[xuanhaoxd 2]

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.com/?yt1x9lav0v3t8n1 ( ko up trực tiếp được )

[ketxu 2.984]

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.com/upfiles/3/24067_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

[xuanhaoxd 2]

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 !! :),

[ketxu 2.984]

;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 ?

[xuanhaoxd 2]

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

[Doan Van Ha 3.185]

@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

[ketxu 2.984]

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

[gia_bach 1.549]

;.........
(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) )

[ketxu 2.984]

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

[nguoidungautocadvn 0]

Vào lúc 13/2/2012 tại 18:31, ketxu đã nói:

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.com/upfiles/3/24067_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

bạn có thể hướng dẫn cách sử dụng cho mình được không