duongdinhdbp 0 Báo cáo bài đăng Đã đăng Tháng 12 28, 2022 Em có 2 lips được bạn chia sẻ để sử dụng để đánh nhãn cho PL nhưng sau khi đánh nhãn xong thì sử dụng chỉnh sửa thủ công để gán 2 nhãn vào cùng 1 gốc, duỗi thẳng nhãn để nhãn k chạm vào pl mất quá nhiều thời gian. Vậy em đăng lên đây để phiền các bác rút gọn lại giúp em để đạt được kết quả như mong muốn ạ. Kết quả em xin gửi link ảnh và file dwg. Cảm ơn các bác <img src="https://i.upanh.org/2022/12/28/1111111111111111111.png" alt="1111111111111111111.png" border="0"> https://upanh.org/image/3KhTLL 1. code lips dsh: (vl-load-com) (defun c:DSH ( / js htx AcDoc Space n obj ename pr pt deriv rtx nw_obj) (princ "\nSelect polylines: ") (setq js (ssget (list '(0 . "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) (cond (js (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nNhap chieu cao chu <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((null (tblsearch "LAYER" "Label Elevation")) (vlax-put (vla-add (vla-get-layers AcDoc) "Label Elevation") 'color 96) ) ) (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) ename (vlax-ename->vla-object obj) pr (* 0.5 (vlax-curve-getEndParam ename)) pt (vlax-curve-GetpointAtParam ename pr) deriv (vlax-curve-getFirstDeriv ename pr) rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR"))) ) (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE")))) 0.0 (strcat "{\\fArial|b0|i0|c0|p34;" "H ""%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) ">%).Elevation \\f \"%lu2%pr0\">%""/" "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) ">%).Length \\f \"%lu2%pr1\">%"" m" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'BackgroundFill) (list 1 (getvar "TEXTSIZE") 1 pt "Standard" "Label Elevation" rtx 0) ) ) ) ) (prin1) ) 2. code DSH2: (defun c:DSH2 (/ ent par poi ss len pt) (if (setq ss (ssget '((0 . "LWPOLYLINE")))) (while (and (setq ent (ssname ss 0)) (ssdel ent ss)) (setq par (vlax-curve-getEndParam ent) poi (vlax-curve-getpointatparam ent par)) (setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))) (setq pt (vlax-curve-getPointAtDist ent (/ len 2))) (entmake (list (cons 0 "TEXT") (cons 10 pt) (cons 7 (getvar 'TEXTSTYLE)) (cons 40 (* (getvar 'DIMTXT) (getvar 'DIMSCALE))) (cons 1 (strcat (rtos (caddr poi) 2 0) "/" (itoa (1+ (fix par))))))))) (princ)) rut gon lips.dwg Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Duong Nhat Duy 400 Báo cáo bài đăng Đã đăng Tháng 12 28, 2022 Mình sửa 2 cái text cùng 1 điểm đặt, nhưng 1 cái Mtext là Top left, 1 cái là left (theo như file lisp cũ), bạn sửa tay lại điểm đặt cái left thành top left là đc. Nhân tiện mình cũng hỏi luôn mn thao tác sửa tay điểm đặt text trong cad (left, right, ...) thì vào lisp làm ntn (giữ nguyên điểm đặt, đổi căn lề chữ á) DSH.lsp 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
duongdinhdbp 0 Báo cáo bài đăng Đã đăng Tháng 12 28, 2022 Em sửa tay cái Mtext thì cho về bottom left nhưng trong bản vẽ có đến gần 100.000 điểm text như vậy thì vẫn phải move gốc text của 2 nhãn vào nhau và các pl nó không chỉ hoàn toàn là đường thẳng song song, ngoài ra còn RO nhãn cho nó không che Polyline..., rơi vào khoảng 400.000 cú nhấp chuột + 400.000 lần ấn phím tắt để điều chỉnh, cực quá bác ạ, nhờ các bác chỉnh sửa lại lips giúp em với :D Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
duongdinhdbp 0 Báo cáo bài đăng Đã đăng Tháng 12 28, 2022 À chỉnh tay đc bác ạ, nó khớp rồi. Xin cảm ơn bác rất nhiều ạ Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Duong Nhat Duy 400 Báo cáo bài đăng Đã đăng Tháng 12 28, 2022 26 phút trước, duongdinhdbp đã nói: Em sửa tay cái Mtext thì cho về bottom left nhưng trong bản vẽ có đến gần 100.000 điểm text như vậy thì vẫn phải move gốc text của 2 nhãn vào nhau và các pl nó không chỉ hoàn toàn là đường thẳng song song, ngoài ra còn RO nhãn cho nó không che Polyline..., rơi vào khoảng 400.000 cú nhấp chuột + 400.000 lần ấn phím tắt để điều chỉnh, cực quá bác ạ, nhờ các bác chỉnh sửa lại lips giúp em với :D chọn nhiều đối tượng cùng lúc đc mà bạn 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
duongdinhdbp 0 Báo cáo bài đăng Đã đăng Tháng 12 28, 2022 Em chạy đc rồi ạ, vẫn phải chỉnh tay nhiều do các đường PL nó xiên xẹo nhưng không đòi hỏi được thêm gì nữa rồi. Cảm ơn bác đã giúp đỡ Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Duong Nhat Duy 400 Báo cáo bài đăng Đã đăng Tháng 12 28, 2022 13 phút trước, duongdinhdbp đã nói: Em chạy đc rồi ạ, vẫn phải chỉnh tay nhiều do các đường PL nó xiên xẹo nhưng không đòi hỏi được thêm gì nữa rồi. Cảm ơn bác đã giúp đỡ Text nó là 1 dải, nếu PL có đường cong hoặc quá gãy khúc thì bắt buộc phải move tay cho thuận mắt thôi b, lisp cũng ko thể làm đc Mình gửi lại, cái trên mình quên chưa chỉnh cao chữ. DSH.lsp Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Hoanghung97 10 Báo cáo bài đăng Đã đăng Tháng 12 28, 2022 5 giờ trước, Duong Nhat Duy đã nói: Mình sửa 2 cái text cùng 1 điểm đặt, nhưng 1 cái Mtext là Top left, 1 cái là left (theo như file lisp cũ), bạn sửa tay lại điểm đặt cái left thành top left là đc. Nhân tiện mình cũng hỏi luôn mn thao tác sửa tay điểm đặt text trong cad (left, right, ...) thì vào lisp làm ntn (giữ nguyên điểm đặt, đổi căn lề chữ á) DSH.lsp bác xem thử câu lệnh này xem mình hay dùng dt là text vừa tạo (setq dt (entlast)) (setq Obj (vlax-ename->vla-Object dt) (setq pt (vlax-get-property Obj 'InsertionPoint)) (vla-put-alignment Obj acAlignmentTopCenter)) (vla-put-TextAlignmentPoint Obj pt) 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Duong Nhat Duy 400 Báo cáo bài đăng Đã đăng Tháng 12 29, 2022 17 giờ trước, Hoanghung97 đã nói: bác xem thử câu lệnh này xem mình hay dùng dt là text vừa tạo (setq dt (entlast)) (setq Obj (vlax-ename->vla-Object dt) (setq pt (vlax-get-property Obj 'InsertionPoint)) (vla-put-alignment Obj acAlignmentTopCenter)) (vla-put-TextAlignmentPoint Obj pt) Thanks bạn nhé ! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác