Đến nội dung


Hình ảnh
- - - - -

NHỜ SỬA LISP


  • Please log in to reply
5 replies to this topic

#1 thachtrinh

thachtrinh

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 20 October 2014 - 03:41 PM

Em có tìm được file lisp trên diễn đàn (của bác kangkung) nhưng chưa đúng ý, nhờ anh chị trên diễn đàn sửa giúp ạ :) Cảm ơn mọi người.File lisp này dùng để gán cao độ đường đồng mức và ghi cao độ lên đường đồng mức. Bây giờ em cần bỏ 2 số 0 sau dấu phẩy khi ghi text, và điểm chèn text là vào giữa đường đồng mức (mặc định là có 2 số 0 sau dấu phẩy và ghi text cách đường đồng mức 1/2 chiều cao text.

Cho em hỏi thêm là có lệnh nào ẩn đường line dưới text đi không? (ngoài lệnh wipeout) Hay anh chị nào viết thêm cho em cái này vào lisp thì quá tuyệt. 
Em cảm ơn ạ :D


  • 0

#2 thachtrinh

thachtrinh

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 20 October 2014 - 03:43 PM

em đính kèm lisp mà không được, đành gửi link ở đây vậy ạ.

https://www.dropbox....kk (1).lsp?dl=0


  • 0

#3 anhduccec

anhduccec

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: 21 (tàm tạm)

Đã gửi 20 October 2014 - 10:03 PM

Sưu tầm và chắp vá giúp bạn.
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/70261-nho-viet-lisp-gan-cao-do-cho-duong-dong-muc-va-ghi-ra-text/
;GAN CAO DO CHO DUONG DONG MUC VA GHI RA TEXT
;=======KANGKUNG 14/04/2013 - REV1===========
(defun C:kk( / i index pt pt1 pt2 taphop lst huong)
(setvar "CMDECHO" 0)
(setvar "DIMZIN" 0)
(command "UNDO" "BE")
(setq os(getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq taphop (ssget '((0 . "POLYLINE,LWPOLYLINE")))) ;POLYLINE,LWPOLYLINE
(if (and (/= docao nil) (= (length list_caodo) 2))
(setq docao (read (lisped (rtos (+ (- (nth 1 list_caodo) (nth 0 list_caodo)) docao) 2 2))))
(if (/= docao nil)
(setq docao (read (lisped (rtos docao 2 2))))
(setq docao (read (lisped "Nhap do cao duong dong muc vao day")))
)
)
(if (< (length list_caodo) 2)
(setq list_caodo(append list_caodo (list docao)))
(setq list_caodo(append (list (nth 1 list_caodo)) (list docao)))
)
(if (= Height nil)
(setq Height(read(lisped "Nhap cao chu vao day")))
)
(setq index 0)
(while (< index (sslength taphop))
(vla-put-elevation (vlax-ename->vla-object (ssname taphop index)) docao)
(vla-put-color (vlax-ename->vla-object (ssname taphop index)) 2)
(setq index (1+ index))
)
(while (setq pt (getpoint "\n Pick diem chen TEXT: " ))
(huongtext)
(entmake (list '(0 . "TEXT") (cons 10 pt2) (cons 40 Height) (cons 1 (rtos docao 2 0)) (cons 50 huong)))(txt2mtxt)
)
(setvar "OSMODE" os)
(command "UNDO" "END")
(setvar "cmdecho" 1)
(princ)
)
(defun huongtext()
(setq i 0)
(setq lst(list))
(while (< i (sslength taphop))
(setq dt(ssname taphop i))
(setq pt1(vlax-curve-getClosestPointTo dt pt))
(if (and (<= pi (angle pt1 pt)) (<= (angle pt1 pt) (* 2 pi)))
(setq pt2(polar pt1 (angle pt pt1) (/ Height -2)))
(setq pt2(polar pt1 (angle pt1 pt) (/ Height -2)))
)
(if (= (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) (vla-get-length (vlax-ename->vla-object dt)))
(setq huong(angle ( vlax-curve-getPointAtDist dt (+ (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) -0.001)) (vlax-curve-getClosestPointTo dt pt) ))
(setq huong(angle (vlax-curve-getClosestPointTo dt pt) ( vlax-curve-getPointAtDist dt (+ (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) 0.001))))
)
(if (and (> huong (/ pi 2)) (< huong (/ (* 3 pi) 2))) (setq huong(- huong pi)))
(setq lst(append lst (list (list (distance pt pt1) huong pt2))))
(setq i(1+ i))
)
(setq lst(vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2)))))
(setq huong(cadr(nth 0 lst)))
(setq pt2(caddr(nth 0 lst)))
)
(princ "\n KangKung - 14/04/2013\n")
(princ "\n Nhap KK de chay chuong trinh\n")

(defun txt2mtxt (/ sset count num en el
mcontent bbox point1 point2 point3 point4
mwidth mheight mstyle njust mrotate nmtext ss)
(if (setq sset (ssget "L"))
(progn
(setq count 0
ss (ssadd)
) ;_ end of setq
(while (ssname sset COUNT)
(setq EN (ssname sset COUNT))
(setq EL (entget EN))
(if (= (cdr (assoc 0 EL)) "TEXT")
(progn
(setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
(setq EL (subst mcontent(assoc 1 EL) EL))
(setq bbox (acet-geom-textbox EL 0.1))
(setq point1 (car bbox))
(setq point2 (cadr bbox))
(setq point3 (cadr (cdr bbox)))
(setq point4 (cadr (cdr (cdr bbox))))
(setq mwidth (cons '41 (distance point1 point2)))
(setq mheight (cons '40 (cdr (assoc 40 el))))
(setq mstyle (cons '7 (cdr (assoc 7 el))))
(setq nspace (cons '410 (cdr (assoc 410 EL))))
(setq minsert (cons '10 (cdr (assoc 10 EL))))
(cond
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 3))
(setq NJUST (cons '71 1))
) ;JY
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 3))
(setq NJUST (cons '71 2))
) ;JU
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 3))
(setq NJUST (cons '71 3))
) ;JI
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 2))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 2))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 2))
(setq NJUST (cons '71 6))
) ;JK
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 4) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 1))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 1))
(setq NJUST (cons '71 8))
) ;JM
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 1))
(setq NJUST (cons '71 9))
) ;J,
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
) ;_ end of cond
(setq mrotate (cons '50 (cdr (assoc 50 el))))
(setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity")
'(67 . 0) nspace
'(8 . "TEXT") '(100 . "AcDbMText")
minsert njust
mheight mwidth
mstyle mcontent
mrotate
) ;_ end of list
) ;_ end of setq
(vla-put-backgroundfill
(vlax-ename->vla-object (entmakex nmtext))
:vlax-true
) ;_ end of vla-put-BackgroundFill
(ssadd (entlast) ss)
(entdel en)
(setq count (+ count 1))
) ;_ end of progn
(setq count (+ count 1))
) ;_ end of if
) ;_ end of while
(if (> (sslength ss) 0)
(command "_draworder" ss "" "_F")
) ;_ end of if
)
)
(princ)
) ;_ end of defun
(vl-load-com)

  • 1

#4 thachtrinh

thachtrinh

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 21 October 2014 - 09:13 AM

Cảm ơn bạn nhiều nhé! lisp dùng rất tốt, đúng ý mình. mà hôm qua mình lỡ nội suy cao độ theo lisp cũ rồi. buồn. Cảm ơn bạn rất nhiều :)


  • 0

#5 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 21 October 2014 - 02:39 PM

Sưu tầm và chắp vá giúp bạn.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/70261-nho-viet-lisp-gan-cao-do-cho-duong-dong-muc-va-ghi-ra-text/
;GAN CAO DO CHO DUONG DONG MUC VA GHI RA TEXT
;=======KANGKUNG 14/04/2013 - REV1===========
(defun C:kk( / i index pt pt1 pt2 taphop lst huong)
(setvar "CMDECHO" 0)
(setvar "DIMZIN" 0)
(command "UNDO" "BE")
(setq os(getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq taphop (ssget '((0 . "POLYLINE,LWPOLYLINE")))) ;POLYLINE,LWPOLYLINE
(if (and (/= docao nil) (= (length list_caodo) 2))
(setq docao (read (lisped (rtos (+ (- (nth 1 list_caodo) (nth 0 list_caodo)) docao) 2 2))))
(if (/= docao nil)
(setq docao (read (lisped (rtos docao 2 2))))
(setq docao (read (lisped "Nhap do cao duong dong muc vao day")))
)
)
(if (< (length list_caodo) 2)
(setq list_caodo(append list_caodo (list docao)))
(setq list_caodo(append (list (nth 1 list_caodo)) (list docao)))
)
(if (= Height nil)
(setq Height(read(lisped "Nhap cao chu vao day")))
)
(setq index 0)
(while (< index (sslength taphop))
(vla-put-elevation (vlax-ename->vla-object (ssname taphop index)) docao)
(vla-put-color (vlax-ename->vla-object (ssname taphop index)) 2)
(setq index (1+ index))
)
(while (setq pt (getpoint "\n Pick diem chen TEXT: " ))
(huongtext)
(entmake (list '(0 . "TEXT") (cons 10 pt2) (cons 40 Height) (cons 1 (rtos docao 2 0)) (cons 50 huong)))(txt2mtxt)
)
(setvar "OSMODE" os)
(command "UNDO" "END")
(setvar "cmdecho" 1)
(princ)
)
(defun huongtext()
(setq i 0)
(setq lst(list))
(while (< i (sslength taphop))
(setq dt(ssname taphop i))
(setq pt1(vlax-curve-getClosestPointTo dt pt))
(if (and (<= pi (angle pt1 pt)) (<= (angle pt1 pt) (* 2 pi)))
(setq pt2(polar pt1 (angle pt pt1) (/ Height -2)))
(setq pt2(polar pt1 (angle pt1 pt) (/ Height -2)))
)
(if (= (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) (vla-get-length (vlax-ename->vla-object dt)))
(setq huong(angle ( vlax-curve-getPointAtDist dt (+ (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) -0.001)) (vlax-curve-getClosestPointTo dt pt) ))
(setq huong(angle (vlax-curve-getClosestPointTo dt pt) ( vlax-curve-getPointAtDist dt (+ (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) 0.001))))
)
(if (and (> huong (/ pi 2)) (< huong (/ (* 3 pi) 2))) (setq huong(- huong pi)))
(setq lst(append lst (list (list (distance pt pt1) huong pt2))))
(setq i(1+ i))
)
(setq lst(vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2)))))
(setq huong(cadr(nth 0 lst)))
(setq pt2(caddr(nth 0 lst)))
)
(princ "\n KangKung - 14/04/2013\n")
(princ "\n Nhap KK de chay chuong trinh\n")

(defun txt2mtxt (/ sset count num en el
mcontent bbox point1 point2 point3 point4
mwidth mheight mstyle njust mrotate nmtext ss)
(if (setq sset (ssget "L"))
(progn
(setq count 0
ss (ssadd)
) ;_ end of setq
(while (ssname sset COUNT)
(setq EN (ssname sset COUNT))
(setq EL (entget EN))
(if (= (cdr (assoc 0 EL)) "TEXT")
(progn
(setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
(setq EL (subst mcontent(assoc 1 EL) EL))
(setq bbox (acet-geom-textbox EL 0.1))
(setq point1 (car bbox))
(setq point2 (cadr bbox))
(setq point3 (cadr (cdr bbox)))
(setq point4 (cadr (cdr (cdr bbox))))
(setq mwidth (cons '41 (distance point1 point2)))
(setq mheight (cons '40 (cdr (assoc 40 el))))
(setq mstyle (cons '7 (cdr (assoc 7 el))))
(setq nspace (cons '410 (cdr (assoc 410 EL))))
(setq minsert (cons '10 (cdr (assoc 10 EL))))
(cond
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 3))
(setq NJUST (cons '71 1))
) ;JY
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 3))
(setq NJUST (cons '71 2))
) ;JU
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 3))
(setq NJUST (cons '71 3))
) ;JI
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 2))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 2))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 2))
(setq NJUST (cons '71 6))
) ;JK
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 4) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 1))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 1))
(setq NJUST (cons '71 8))
) ;JM
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 1))
(setq NJUST (cons '71 9))
) ;J,
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
) ;_ end of cond
(setq mrotate (cons '50 (cdr (assoc 50 el))))
(setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity")
'(67 . 0) nspace
'(8 . "TEXT") '(100 . "AcDbMText")
minsert njust
mheight mwidth
mstyle mcontent
mrotate
) ;_ end of list
) ;_ end of setq
(vla-put-backgroundfill
(vlax-ename->vla-object (entmakex nmtext))
:vlax-true
) ;_ end of vla-put-BackgroundFill
(ssadd (entlast) ss)
(entdel en)
(setq count (+ count 1))
) ;_ end of progn
(setq count (+ count 1))
) ;_ end of if
) ;_ end of while
(if (> (sslength ss) 0)
(command "_draworder" ss "" "_F")
) ;_ end of if
)
)
(princ)
) ;_ end of defun
(vl-load-com)

 

Hề hề hề,

1/- Lisp này không sử dụng được với Cad2004 do sử dụng hàm (vla-put-backgroundfill ........) Hình như từ CAD2007 trở lên mới có hàm này.

2/- Trong lisp sử dụng khá nhiều hàm dạng (cons a (cdr (assoc a elst))), Vì sao không xài luôn thằng (assoc a elst) ???

3/- Vì sao không tạo mtext ngay từ đầu mà lại tạo text rồi mất công đổi sang mtext???

4/- Biến pt2 có còn cần thiết không nhỉ??


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#6 anhduccec

anhduccec

    biết vẽ arc

  • Members
  • PipPip
  • 45 Bài viết
Điểm đánh giá: 21 (tàm tạm)

Đã gửi 21 October 2014 - 09:19 PM

Hề hề... Mỳ ăn liền (Như comment là chắp vá). 1 khúc của KangKung, 1 khúc là lisp có sẵn chuyển từ text sang mtext và textmask ghép lại ấy mà!
  • 0