Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Minh Nghĩa

SỬA LISP ĐÁNH SỐ THỨ TỰ ĐỈNH PLINE

Các bài được khuyến nghị

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

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

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

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

  • Vote tăng 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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×