Minh Nghĩa 2 Báo cáo bài đăng Đã đăng Tháng 11 26, 2022 Nhờ các Bác sửa lại giúp em lệnh đánh đỉnh Pline Hiện tại Lệnh của em nó chỉ cho đánh từng đường pline Em muốn đánh toàn bộ đường pline cùng 1 lúc Nhờ các cao thủ sửa lại giúp em Em cảm ơn (defun c:TT5 (/ e ent n i j p) (if (and (setq e (car (entsel "\n Select a Polyline :"))) (member (cdr (assoc 0 (setq ent (entget e)))) '("POLYLINE" "LWPOLYLINE") ) (setq n 0 j 1 ) ) (while (> (setq i (1+ (fix (- (vlax-curve-getendparam e) (vlax-curve-getstartparam e) ) ) ) ) n ) (setq p (vlax-curve-getpointatparam e n)) (entmake (list '(0 . "TEXT") '(100 . "AdCbText") '(100 . "AdCbEntity") (cons 10 (trans p 1 0)) (cons 40 (getvar 'textsize)) (cons 1 (rtos j 2 0)) '(210 0.0 0.0 1.0) '(50 . 0.0) ) ) (setq n (1+ n) j (1+ j) ) ) (princ) ) (princ) ) 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
quangcda 7 Báo cáo bài đăng Đã đăng Tháng 11 28, 2022 Bạn thử xem! TT5.lsp 2 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
Minh Nghĩa 2 Báo cáo bài đăng Đã đăng Tháng 11 28, 2022 mình cảm ơn quangcda 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
Minh Nghĩa 2 Báo cáo bài đăng Đã đăng Tháng 11 28, 2022 Chào bạn quangcda, mình cảm ơn bạn giúp mình chỉnh sửa lisp đánh số thứ tự đỉnh Pline Bạn giúp mình kết hợp 2 lệnh sau thành 1 không bạn Mình muốn kết quả của 2 lệnh ghép thành 1 và ghi vào tim đường pline Lệnh 1 : ELC là lệnh gán nhãn cao độ đường pline vào tim đường pline Lệnh 2: SDP là lệnh ghi tổng số đỉnh Pline vào cuối đường Pline Mình muốn ghép 2 lệnh thành 1 và kết quả ghi ví dụ 1/5 ( trong đó 1 là cao độ, 5 là số đỉnh) vào tim đường Pline Lệnh ELC (vl-load-com) (defun c:ELC ( / 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;" "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) ">%).Elevation \\f \"%lu2%pr0\">%" ) ) ) (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) ) Lệnh SDP (defun c:SDP ( / e s p ) (if (setq s (ssget '((0 . "*POLYLINE")))) (while (setq e (ssname s 0)) (vl-cmdf "_.mleader" "_non" (setq p (trans (vlax-curve-getendpoint e) 0 0)) "_non" (polar p (/ pi 1.) (* 0 (getvar 'DIMTXT))) (itoa (1+ (fix (vlax-curve-getendparam e)))) ) (ssdel e s) ) ) (princ) ) (vl-load-com) Mình cảm ơn bạn 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
quangcda 7 Báo cáo bài đăng Đã đăng Tháng 11 28, 2022 Bạn thử xem ! ELC.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
Minh Nghĩa 2 Báo cáo bài đăng Đã đăng Tháng 11 28, 2022 Không được bạn ơi quangcda 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
Minh Nghĩa 2 Báo cáo bài đăng Đã đăng Tháng 11 28, 2022 Giống lệnh này bạn ơi, mình chỉnh thành CAO DO/Chieu dai Bây giờ mình muốn cao độ/số lượng đỉnh Pline mình cảm ơn (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%pr2\">%"" 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) ) 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
NTHAHT 103 Báo cáo bài đăng Đã đăng Tháng 11 28, 2022 Không biết có phải thế này không? (defun c:tt6 (/ ent par poi ss) (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)) (entmake (list (cons 0 "TEXT") (cons 10 poi) (cons 7 (getvar 'TEXTSTYLE)) (cons 40 (* (getvar 'DIMTXT) (getvar 'DIMSCALE))) (cons 1 (strcat (rtos (caddr poi) 2 2) "/" (itoa (1+ (fix par))))))))) (princ)) 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