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

Mọi người giúp em với ạ(Lisp xuất cao độ)

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

Chào mọi người. Em có chút việc mong mọi người giúp với ạ. Em cần xuất cao độ của 1 đường polyline có sẵn Elevation dọc trên đường Polyline có sẵn đó. Em có tìm trên mạng được 1 lisp nhưng nó chỉ xuất được text cao độ ra điểm đầu với điểm cuối của đường polyline đó. Mong mọi người giúp em chỉnh xửa cái lisp đó theo ý tưởng trên của em với ạ. Mọi khi không có lisp thì em toàn phải dùng lisp rải đối tượng, rải text đó theo Polyline đó.Nhưng đó là ít đường, giờ làm đến bản nhiều đường polyline quá thì mất rất nhiều thời gian. Cám ơn mọi người nhiều.

 

Lisp em tìm được đính kèm dưới đây ạ

;;; ghi cao do nhan duong dong muc theo 1 duong polyline
(defun c:tcd (/ ss c ssn ent ssp ssl i pt com)
  (SAVE_MODE)
  (prompt "\nChon duong polyline : ")
  (setq ss (ssget (list (cons 0 "*POLYLINE"))))
  (setq c 0)
     (repeat (sslength ss)
     (setq ssn (ssname ss c)
      ent (entget ssn))
     (setq sspt (getVert ssn))
     (setq ssl (length sspt)
      i 0)
     (repeat ssl
       (setq pt (nth i sspt))
       (setq com (nth 2 pt))
       (MAKE_TEXT (rtos com 2 2) pt 0.5 0.7 0.0 2 0 0)
       (setq i (1+ i))
       );while
       (setq c (1+ c))
       );while
  (RESTORE)
  (princ)
  );defun
  (defun getVert (e / i L) 
 
   (setq i -1 L nil)
 
   (repeat (fix (1+ (vlax-curve-getEndParam e) ))
 
      (setq  i (1+ i) L (append L (list (vlax-curve-getPointAtParam e i))))
 
   )
 
)
;;; ghi cao do nhan duong dong muc theo 1 duong polyline
(defun c:tcd (/ ss c ssn ent ssp ssl i pt com)
  (SAVE_MODE)
  (prompt "\nChon duong polyline : ")
  (setq ss (ssget (list (cons 0 "*POLYLINE"))))
  (setq c 0)
     (repeat (sslength ss)
     (setq ssn (ssname ss c)
      ent (entget ssn))
     (setq sspt (getVert ssn))
     (setq ssl (length sspt)
      i 0)
     (repeat ssl
       (setq pt (nth i sspt))
       (setq com (nth 2 pt))
       (MAKE_TEXT (rtos com 2 2) pt 0.5 0.7 0.0 2 0 0)
       (setq i (1+ i))
       );while
       (setq c (1+ c))
       );while
  (RESTORE)
  (princ)
  );defun
  (defun getVert (e / i L) 
 
   (setq i -1 L nil)
 
   (repeat (fix (1+ (vlax-curve-getEndParam e) ))
 
      (setq  i (1+ i) L (append L (list (vlax-curve-getPointAtParam e i))))
 
   )
 
)
;;; ghi cao do nhan duong dong muc theo 1 duong polyline
(defun c:tcd (/ ss c ssn ent ssp ssl i pt com)
  (SAVE_MODE)
  (prompt "\nChon duong polyline : ")
  (setq ss (ssget (list (cons 0 "*POLYLINE"))))
  (setq c 0)
     (repeat (sslength ss)
     (setq ssn (ssname ss c)
      ent (entget ssn))
     (setq sspt (getVert ssn))
     (setq ssl (length sspt)
      i 0)
     (repeat ssl
       (setq pt (nth i sspt))
       (setq com (nth 2 pt))
       (MAKE_TEXT (rtos com 2 2) pt 0.5 0.7 0.0 2 0 0)
       (setq i (1+ i))
       );while
       (setq c (1+ c))
       );while
  (RESTORE)
  (princ)
  );defun
  (defun getVert (e / i L) 
 
   (setq i -1 L nil)
 
   (repeat (fix (1+ (vlax-curve-getEndParam e) ))
 
      (setq  i (1+ i) L (append L (list (vlax-curve-getPointAtParam e i))))
 
   )
 
)
;;; ghi cao do nhan duong dong muc theo 1 duong polyline
(defun c:tcd (/ ss c ssn ent ssp ssl i pt com)
  (SAVE_MODE)
  (prompt "\nChon duong polyline : ")
  (setq ss (ssget (list (cons 0 "*POLYLINE"))))
  (setq c 0)
     (repeat (sslength ss)
     (setq ssn (ssname ss c)
      ent (entget ssn))
     (setq sspt (getVert ssn))
     (setq ssl (length sspt)
      i 0)
     (repeat ssl
       (setq pt (nth i sspt))
       (setq com (nth 2 pt))
       (MAKE_TEXT (rtos com 2 2) pt 0.5 0.7 0.0 2 0 0)
       (setq i (1+ i))
       );while
       (setq c (1+ c))
       );while
  (RESTORE)
  (princ)
  );defun
  (defun getVert (e / i L) 
 
   (setq i -1 L nil)
 
   (repeat (fix (1+ (vlax-curve-getEndParam e) ))
 
      (setq  i (1+ i) L (append L (list (vlax-curve-getPointAtParam e i))))
 
   )
 
)
;;; ghi cao do nhan duong dong muc theo 1 duong polyline
(defun c:tcd (/ ss c ssn ent ssp ssl i pt com)
  (SAVE_MODE)
  (prompt "\nChon duong polyline : ")
  (setq ss (ssget (list (cons 0 "*POLYLINE"))))
  (setq c 0)
     (repeat (sslength ss)
     (setq ssn (ssname ss c)
      ent (entget ssn))
     (setq sspt (getVert ssn))
     (setq ssl (length sspt)
      i 0)
     (repeat ssl
       (setq pt (nth i sspt))
       (setq com (nth 2 pt))
       (MAKE_TEXT (rtos com 2 2) pt 0.5 0.7 0.0 2 0 0)
       (setq i (1+ i))
       );while
       (setq c (1+ c))
       );while
  (RESTORE)
  (princ)
  );defun
  (defun getVert (e / i L) 
 
   (setq i -1 L nil)
 
   (repeat (fix (1+ (vlax-curve-getEndParam e) ))
 
      (setq  i (1+ i) L (append L (list (vlax-curve-getPointAtParam e i))))
 
   )
 
)

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
;;; ghi cao do nhan duong dong muc theo 1 duong polyline

http://www.cadviet.com/upfiles/3/36494_

(defun c:tcd (/ ss c ssn ent ssp ssl i pt com)
  (SAVE_MODE)
  (prompt "\nChon duong polyline : ")
  (setq ss (ssget (list (cons 0 "*POLYLINE"))))
  (setq c 0)
     (repeat (sslength ss)
     (setq ssn (ssname ss c)
      ent (entget ssn))
     (setq sspt (getVert ssn))
     (setq ssl (length sspt)
      i 0)
     (repeat ssl
       (setq pt (nth i sspt))
       (setq com (nth 2 pt))
       (MAKE_TEXT (rtos com 2 2) pt 0.5 0.7 0.0 2 0 0)
       (setq i (1+ i))
       );while
       (setq c (1+ c))
       );while
  (RESTORE)
  (princ)
  );defun
  (defun getVert (e / i L) 
 
   (setq i -1 L nil)
 
   (repeat (fix (1+ (vlax-curve-getEndParam e) ))
 
      (setq  i (1+ i) L (append L (list (vlax-curve-getPointAtParam e i))))
 
   )
 
)
;;; =======================================================================================
   ;;; =========================== CAC HAM CON THONG DUNG_TAUNV ==============================
   ;;; =======================================================================================
   ; HAM LUU VA TRA LAI CAC THONG SO BAN DAU
   (DEFUN SAVE_MODE ()
     (COMMAND "UNDO" "BEGIN")
     (SETQ OLD_OSMODE (GETVAR "OSMODE")
      OLD_CECOLOR (GETVAR "CECOLOR")
      OLD_AUTOSNAP (GETVAR "AUTOSNAP")
      OLD_ORTHOMODE (GETVAR "ORTHOMODE")
      OLD_LAYER (GETVAR "CLAYER")
      OLD_TEXTSTYLE (GETVAR "TEXTSTYLE")
      OLD_ERROR *ERROR*
      TIME (GETVAR "MILLISECS")
         )
     (SETVAR "CMDECHO" 0)
     )
   (DEFUN RESTORE ()
     (COMMAND "UNDO" "END")
     (SETVAR "OSMODE" OLD_OSMODE)
     (SETVAR "AUTOSNAP" OLD_AUTOSNAP)
     (SETVAR "ORTHOMODE" OLD_ORTHOMODE)
     (SETVAR "CLAYER" OLD_LAYER)
     (SETVAR "TEXTSTYLE" OLD_TEXTSTYLE)
     (COMMAND "CECOLOR" OLD_CECOLOR)
     (SETVAR "CMDECHO" 1)
     (PROMPT (STRCAT "\nWrite by Nguyen Van Tau-0982.767.231 >>> " (RTOS (/ (- (GETVAR "MILLISECS") TIME) 1000.0)) "s Completed!"))
     (PRINC)
     )
   ; HAM TRINH BAY LOI
   (DEFUN *ERROR* (MSG)
     (COND
       ((= MSG "QUIT / EXIT ABORT")
       (PRINC)
       )
       ( (/= MSG "FUNCTION CANCELLED")
       (PRINC)
       )
       )
       (SETQ *ERROR* OLD_ERROR)
       (PRINC)
       )
     ; HAM TAO TEXT
   (DEFUN MAKE_TEXT (COM PT HT WI AG CO D72 D73)
     (IF (/= PT NIL)
       (ENTMAKE (LIST
            (CONS 0 "TEXT")
            (CONS 10 PT)         ;POINT
            (CONS 40 HT)         ;HEIGHT
            (CONS 1 COM)         ;VALUE
            (CONS 41 WI)         ;WIDTH
            (CONS 50 AG)         ;ANGLE
            (CONS 62 CO)         ;COLOR
            (CONS 7 (GETVAR "TEXTSTYLE"))   ;TEXTSTYLE
            (CONS 72 D72)         ;0 = Left;1= Center;2 = Right;3 = Aligned (if vertical alignment = 0);
                           ;4 = Middle (if vertical alignment = 0);5 = Fit (if vertical alignment = 0)
            (CONS 11 PT)         ;POINT
            (CONS 73 D73)         ;0 = Baseline; 1 = Bottom; 2 = Middle; 3 = Top
          )
       )
     )
   )

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  

×