Viết lisp theo yêu cầu [phần 2]

Tháng 6 23, 2011

Hề hề hề,

Có nhẽ đây là lỗi do cái biến key_ctnc mà ra. Vì khi bạn nhập t có thể lisp sẽ hiểu nhầm là một biến logic chứ không phải cái key.

Bạn có thể đổi cái key này đi bằng một chử cái khác xem sao nhé.

Híc, nó báo lỗi giống hệt vậy với cùng 4 key C,T,N,H. mình thử đổi key rồi nhưng không ăn thua

Tháng 6 23, 2011

vâng .đã nghe rõ .sorry.

mong muốn là muốn mong thôi các bác .

ước mơ để mơ ước đến nhanh thêm một tý thôi .

vì cũng đã và đang vất vả và vật vã nên nó mới vạ vật như thế bác à .bác thông cảm cho em nhé.

Hề hề hề,

Có chi mà bạn vạ vật vậy hỉ???? Cái yêu cầu của bạn là chọn hai điểm trên một đường đã có trước để ghi độ dốc thì không quá khó, Nó đây nè:

(defun c:gdd (/ en p1 p2 doc dd goc p txt et )
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 512)
(setq ;;;;; en (car (entsel "\n Chon LINE can xac dinh do doc"))
       p1 (getpoint "\n Chon diem thu nhat tren duong can ghi do doc");;;;;;;;(cdr (assoc 10 (entget en)))
       p2 (getpoint p1 "\n Chon diem thu hai tren duong can ghi do doc");;;;;;(cdr (assoc 11 (entget en)))
       doc (abs (* (/ (sin (angle p1 p2)) (cos (angle p1 p2))) 100))        
)
(if (equal (- doc (fix doc)) 0 0.0099)
   (setq dd (strcat (rtos doc 2 0) "%%%"))
   (setq dd (strcat (rtos doc 2 2) "%%%"))
)
(if  (and (> (angle p1 p2) (/ pi 2)) (< (angle p1 p2) (* pi 1.5)))
    (setq goc (+ (angle p1 p2) pi))
    (setq goc (angle p1 p2))
)
(setq txt  (car (entsel "\n Chon text can ghi do doc")))
(if (= txt nil)
   (progn 
          (setq p (getpoint "\n Pick diem can ghi do doc"))
          (setq txt (car (entsel "\n Chon text mau")))
          (if (/= txt nil)                     
              (entmake (list (cons 0 "text")  (assoc 40 (entget txt)) (cons 10 p) (assoc 8 (entget txt)) (assoc 7 (entget txt)) (cons 1 dd) (cons 50 goc)))
          )
   )
   (progn
          (setq et (entget txt)
                  et (subst (cons 1 dd) (assoc 1 et) et)
          )
          (entmod et)
   )
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)     
)

Hề hề hề, hết bức xúc chưa hè????

Chỉnh sửa Tháng 6 23, 2011 theo phamthanhbinh
Bổ sung yêu cầu thể hiện độ dốc của bạn hakhoailang

Tháng 6 23, 2011

Hề hề hề,

Có chi mà bạn vạ vật vậy hỉ???? Cái yêu cầu của bạn là chọn hai điểm trên một đường đã có trước để ghi độ dốc thì không quá khó, Nó đây nè:

(defun c:gdd (/ en p1 p2 doc dd goc p txt et )
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 512)
(setq ;;;;; en (car (entsel "\n Chon LINE can xac dinh do doc"))
       p1 (getpoint "\n Chon diem thu nhat tren duong can ghi do doc");;;;;;;;(cdr (assoc 10 (entget en)))
       p2 (getpoint p1 "\n Chon diem thu hai tren duong can ghi do doc");;;;;;(cdr (assoc 11 (entget en)))
       doc (abs (* (/ (sin (angle p1 p2)) (cos (angle p1 p2))) 100))

)
(if (equal (- doc (fix doc)) 0 0.0099)
   (setq  dd (strcat (rtos doc 2 0) "%%%"))
   (setq  dd (strcat (rtos doc 2 2) "%%%"))
)
(if  (and (> (angle p1 p2) (/ pi 2)) (< (angle p1 p2) (* pi 1.5)))
    (setq goc (+ (angle p1 p2) pi))
    (setq goc (angle p1 p2))
)
(setq txt  (car (entsel "\n Chon text can ghi do doc")))
(if (= txt nil)
   (progn 
          (setq p (getpoint "\n Pick diem can ghi do doc"))
          (setq txt (car (entsel "\n Chon text mau")))
          (if (/= txt nil)                     
              (entmake (list (cons 0 "text")  (assoc 40 (entget txt)) (cons 10 p) (assoc 8 (entget txt)) (assoc 7 (entget txt)) (cons 1 dd) (cons 50 goc)))               
          )
   )
   (progn
          (setq et (entget txt)
                  et (subst (cons 1 dd) (assoc 1 et) et)
          )
          (entmod et)
   )
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)     
)

Hề hề hề, hết bức xúc chưa hè????

cảm ơn bác đúng là cái em cần thank bác nhiều . mỗi người một hoàn cảnh bác à.

ko ai giống ai .có người ở hoàn cảnh tốt người ở hoàn cảnh ko dc tốt

nên phải vạ vật bác à.

có những cái trước mắt là của mình . mình nhìn thấy chính xác là của mình nhưng vẫn phải im lặng cho người khác cướp đi .

cuộc đời mà bác .

Chỉnh sửa Tháng 6 23, 2011 theo phamthanhbinh
Bổ sung yêu cầu thể hiện độ dốc của bạn hakhoailang

Tháng 6 23, 2011

sẵn đay nhờ bác xem hộ em cái này luôn bác à .

nó chống các lip khác khi chạy nó lên và nó không lưu tính chất của text cũ . nó đổi màu text và làm đậm nét hơn

em thì lại muốn nó vẫn mang tính chất của text cũ vì mình chỉ cần thay số liệu thôi mà bác .

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq sc 1)
(setvar "dimzin" 0)
(defun c:os () (setvar "osmode" 545))
;;;;;===============================
;; Silent load.
(princ)
(defun c:e1 () (command "erase" "all" ""))

(defun c:+++++ ()  (command "'.zoom" "8x"))
(defun c:++++++ ()  (command "'.zoom" "16x"))
(defun c:++++ ()  (command "'.zoom" "4x"))
(defun c:+++ ()  (command "'.zoom" "2x"))
(defun c:++ ()  (command "'.zoom" "1.5x"))
(defun c:+ ()  (command "'.zoom" "1.2x"))
(defun c:- ()  (command "'.zoom" "0.9x"))
(defun c:-- ()  (command "'.zoom" "0.5x"))
(defun c:--- ()  (command "'.zoom" "0.2x"))
(defun c:---- ()  (command "'.zoom" "0.1x"))
(defun c:----- ()  (command "'.zoom" "0.05x"))
(defun c:------ ()  (command "'.zoom" "0.01x"))
(defun c:1 () (ssget) (command "change" "p" "" "p" "c" "1" ""))
(defun c:2 () (ssget) (command "change" "p" "" "p" "c" "2" ""))
(defun c:3 () (ssget) (command "change" "p" "" "p" "c" "3" ""))
(defun c:4 () (ssget) (command "change" "p" "" "p" "c" "4" ""))
(defun c:5 () (ssget) (command "change" "p" "" "p" "c" "5" ""))
(defun c:6 () (ssget) (command "change" "p" "" "p" "c" "6" ""))
(defun c:7 () (ssget) (command "change" "p" "" "p" "c" "7" ""))
(defun c:8 () (ssget) (command "change" "p" "" "p" "c" "8" ""))
(defun c:9 () (ssget) (command "change" "p" "" "p" "c" "9" ""))
(defun c:10 () (ssget) (command "change" "p" "" "p" "c" "10" ""))
(defun c:11 () (ssget) (command "change" "p" "" "p" "c" "11" ""))
(defun c:0 () (ssget) (command "change" "p" "" "p" "c" "BY LAYER" ""))
;**********************************************************************
(defun c:goc ()
 (setvar "cmdecho" 0)
 ;(setq osm (getvar "osmode"))
 (if (= sc nil)(setq sc (getreal (strcat"\nChon ty le ve (=kt ve/kt Autocad):"))))
 (prompt "\n*****Chu y: Ty le hien tai la*****:")(princ sc)
 ;(if (/= sc2 nil)(setq sc sc2))
 (command ".zoom" "e")
 ;(setq sspl (SSGET "c" '(10.5 20.25) '(10.5 27.5) (LIST(CONS 0 "lwpolyline"))));su dung khi ban ve co 1 cn o toa do co dinh
 ;(if (= th nil) (setq th (ssget "w" '(10.5 19.25 0) '(11.5 18.00 0) (list(cons 0 "TEXT")))))
 (command "zoom" "p")
 (if (and (= a nil)(/= sspl nil))(setq a (cdr(assoc 10 (entget (ssname sspl 0))))))
 (IF (= a nil)
   (setq a (Getpoint "\n Chon mot diem lam chuan (co cao do):"))
   (progn
     (setq kitu nil)
     (initget "Co Khong")
     (setq kitu (getkword "\n Ban co chon lai diem chuan khong?[Co/Khong]:<K>"))
     (If (= kitu "Co")(setq a (Getpoint "\n Chon lai diem lam chuan (co cao do):")))
     )
   )

 ;(if (and(= nil g)(/= nil th)) (setq g (atof (cdr (ASSOC 1 (ENTGET (SSNAME th 0)))))))
 (IF (= nil g)
   (progn
     (prompt "Khong co cao do tai vi tri can tim!")
     (setq g (Getreal "\n Nhap cao do diem chuan [bang ban phim/Chon tren man hinh]:<Chon>" ))
     (if (= nil g)
(progn
  (setq sscd (entsel "\n Moi ban chon cao do tren man hinh:"))
  (setq g (atof (cdr (assoc 1 (entget (car sscd))))))
  (prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
  )
)
     )
   (If(= kitu "Co")
     (progn
(setq g (Getreal "\n Nhap lai cao do diem chuan [bang ban phim/Chon tren man hinh]:<Chon>" ))
(if (= nil g)
  (progn
    (setq sscd (entsel "\n Moi ban chon lai cao do tren man hinh:"))
    (setq g (atof (cdr (assoc 1 (entget (car sscd))))))
    (prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
  )
  )
)
     )
   )
 )


;;============Tinh cao do khi biet cao do diem chon lam c:goc====================
(defun c:tcd ()
 (PROMPT "\n(Lenh tinh toa do & K/C 1 diem bat ky)")
 (c:goc)
 (setq xa (* sc (car a)))
 (setq ya (* sc (cadr a)))
 (setq l1 xa)
 (setq l3 ya)
 (While
   (setq b (Getpoint "\n Chon diem can tinh:"))
   (setq xb (* sc (car B)))
   (setq x (- xb xa))
   (setq yb (* sc (cadr B)))
   (setq y (+ g (- yb ya)))
   (setq ypr (rtos y 2 3))
   (setq l2 xb)
   (setq l4 yb)
   (setq dy (- l4 l3))
   (setq l3 l4)
   (setq l (- l2 l1))
   (setq ypr1 (rtos L 2 3))
   (setq l1 l2)
   (Prompt "\nCao do diem vua chon:")  (princ (rtos y 2 3))
   (Prompt "\nK/C x le:")  (princ (rtos l 2 3))
   (Prompt " _ K/C x den diem goc:")  (princ (rtos x 2 3))
   (if (= 0 l)
     (Prompt " _ Do doc doan vua chon: E%")
     (Progn
(setq dd (* 100 (/ dy l)))
(Prompt " _ Do doc doan vua chon:")(princ (rtos dd 2 3))(princ "%")
)
     )

   ;(setq pt2 (getpoint "\nDiem ghi cao do vua tinh duoc :"))
   ;(command "TEXT" pt2 "" "90" ypr)
   ;(setq pt3 (getpoint "\nDiem ghi K/C le vua tinh duoc :"))
   ;(command "TEXT" pt3 "" "90" ypr1)
   ;(setq a '(0 0 0) g 0)
   (setq thchon (nentselp"\nChon text can thay the:"))
   (if (/= nil thchon)
     (progn
(setq ens (car thchon))
(COMMAND "CHANGE" ens "" "" "" "" "" ""(rtos y 2 2))
(COMMAND "CHANGE" ens  "" "p" "c" "6" "")
)
     )
   (princ)
   )
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Tháng 6 23, 2011

Híc, nó báo lỗi giống hệt vậy với cùng 4 key C,T,N,H. mình thử đổi key rồi nhưng không ăn thua

Hề hề hề,

Lỗi ở dòng code này:

(setq t_left (ssadd txt t_left))

Lý do là lúc này chửa có cái tập chọn t_left nên nó chả biết ghép cái thằng txt vào tập chọn nào. Vậy nên nó báo lỗi ; error: bad argument type: lselsetp nil

Bạn chỉ cần vô hiệu hóa dòng code này là được thôi...

Tháng 6 23, 2011

Hề hề hề,

Lỗi ở dòng code này:

(setq t_left (ssadd txt t_left))

Lý do là lúc này chửa có cái tập chọn t_left nên nó chả biết ghép cái thằng txt vào tập chọn nào. Vậy nên nó báo lỗi ; error: bad argument type: lselsetp nil

Bạb chỉ cần vô hiệu hóa dòng code này là được thôi...

Ý, cho thêm dòng này (setq t_left (ssadd)) vào sau (setq t_right (ssadd)) chứ ạ ?

Tháng 6 23, 2011

Ý, cho thêm dòng này (setq t_left (ssadd)) vào sau (setq t_right (ssadd)) chứ ạ ?

Hề hề hề,

Thêm làm chi vì bác ấy có dùng chi tới thằng t_left đâu. Chỉ là bác ấy vui tay thêm vô cho có tụ rồi lại quên hổng xóa ấy mừ. Hề hề hề,...

Tháng 6 23, 2011

sẵn đay nhờ bác xem hộ em cái này luôn bác à .

nó chống các lip khác khi chạy nó lên và nó không lưu tính chất của text cũ . nó đổi màu text và làm đậm nét hơn

em thì lại muốn nó vẫn mang tính chất của text cũ vì mình chỉ cần thay số liệu thôi mà bác .

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq sc 1)
(setvar "dimzin" 0)
(defun c:os () (setvar "osmode" 545))
;;;;;===============================
;; Silent load.
(princ)
(defun c:e1 () (command "erase" "all" ""))

(defun c:+++++ ()  (command "'.zoom" "8x"))
(defun c:++++++ ()  (command "'.zoom" "16x"))
(defun c:++++ ()  (command "'.zoom" "4x"))
(defun c:+++ ()  (command "'.zoom" "2x"))
(defun c:++ ()  (command "'.zoom" "1.5x"))
(defun c:+ ()  (command "'.zoom" "1.2x"))
(defun c:- ()  (command "'.zoom" "0.9x"))
(defun c:-- ()  (command "'.zoom" "0.5x"))
(defun c:--- ()  (command "'.zoom" "0.2x"))
(defun c:---- ()  (command "'.zoom" "0.1x"))
(defun c:----- ()  (command "'.zoom" "0.05x"))
(defun c:------ ()  (command "'.zoom" "0.01x"))
(defun c:1 () (ssget) (command "change" "p" "" "p" "c" "1" ""))
(defun c:2 () (ssget) (command "change" "p" "" "p" "c" "2" ""))
(defun c:3 () (ssget) (command "change" "p" "" "p" "c" "3" ""))
(defun c:4 () (ssget) (command "change" "p" "" "p" "c" "4" ""))
(defun c:5 () (ssget) (command "change" "p" "" "p" "c" "5" ""))
(defun c:6 () (ssget) (command "change" "p" "" "p" "c" "6" ""))
(defun c:7 () (ssget) (command "change" "p" "" "p" "c" "7" ""))
(defun c:8 () (ssget) (command "change" "p" "" "p" "c" "8" ""))
(defun c:9 () (ssget) (command "change" "p" "" "p" "c" "9" ""))
(defun c:10 () (ssget) (command "change" "p" "" "p" "c" "10" ""))
(defun c:11 () (ssget) (command "change" "p" "" "p" "c" "11" ""))
(defun c:0 () (ssget) (command "change" "p" "" "p" "c" "BY LAYER" ""))
;**********************************************************************
(defun c:goc ()
 (setvar "cmdecho" 0)
 ;(setq osm (getvar "osmode"))
 (if (= sc nil)(setq sc (getreal (strcat"\nChon ty le ve (=kt ve/kt Autocad):"))))
 (prompt "\n*****Chu y: Ty le hien tai la*****:")(princ sc)
 ;(if (/= sc2 nil)(setq sc sc2))
 (command ".zoom" "e")
 ;(setq sspl (SSGET "c" '(10.5 20.25) '(10.5 27.5) (LIST(CONS 0 "lwpolyline"))));su dung khi ban ve co 1 cn o toa do co dinh
 ;(if (= th nil) (setq th (ssget "w" '(10.5 19.25 0) '(11.5 18.00 0) (list(cons 0 "TEXT")))))
 (command "zoom" "p")
 (if (and (= a nil)(/= sspl nil))(setq a (cdr(assoc 10 (entget (ssname sspl 0))))))
 (IF (= a nil)
   (setq a (Getpoint "\n Chon mot diem lam chuan (co cao do):"))
   (progn
     (setq kitu nil)
     (initget "Co Khong")
     (setq kitu (getkword "\n Ban co chon lai diem chuan khong?[Co/Khong]:<K>"))
     (If (= kitu "Co")(setq a (Getpoint "\n Chon lai diem lam chuan (co cao do):")))
     )
   )

 ;(if (and(= nil g)(/= nil th)) (setq g (atof (cdr (ASSOC 1 (ENTGET (SSNAME th 0)))))))
 (IF (= nil g)
   (progn
     (prompt "Khong co cao do tai vi tri can tim!")
     (setq g (Getreal "\n Nhap cao do diem chuan [bang ban phim/Chon tren man hinh]:<Chon>" ))
     (if (= nil g)
(progn
  (setq sscd (entsel "\n Moi ban chon cao do tren man hinh:"))
  (setq g (atof (cdr (assoc 1 (entget (car sscd))))))
  (prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
  )
)
     )
   (If(= kitu "Co")
     (progn
(setq g (Getreal "\n Nhap lai cao do diem chuan [bang ban phim/Chon tren man hinh]:<Chon>" ))
(if (= nil g)
  (progn
    (setq sscd (entsel "\n Moi ban chon lai cao do tren man hinh:"))
    (setq g (atof (cdr (assoc 1 (entget (car sscd))))))
    (prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
  )
  )
)
     )
   )
 )


;;============Tinh cao do khi biet cao do diem chon lam c:goc====================
(defun c:tcd ()
 (PROMPT "\n(Lenh tinh toa do & K/C 1 diem bat ky)")
 (c:goc)
 (setq xa (* sc (car a)))
 (setq ya (* sc (cadr a)))
 (setq l1 xa)
 (setq l3 ya)
 (While
   (setq b (Getpoint "\n Chon diem can tinh:"))
   (setq xb (* sc (car B)))
   (setq x (- xb xa))
   (setq yb (* sc (cadr B)))
   (setq y (+ g (- yb ya)))
   (setq ypr (rtos y 2 3))
   (setq l2 xb)
   (setq l4 yb)
   (setq dy (- l4 l3))
   (setq l3 l4)
   (setq l (- l2 l1))
   (setq ypr1 (rtos L 2 3))
   (setq l1 l2)
   (Prompt "\nCao do diem vua chon:")  (princ (rtos y 2 3))
   (Prompt "\nK/C x le:")  (princ (rtos l 2 3))
   (Prompt " _ K/C x den diem goc:")  (princ (rtos x 2 3))
   (if (= 0 l)
     (Prompt " _ Do doc doan vua chon: E%")
     (Progn
(setq dd (* 100 (/ dy l)))
(Prompt " _ Do doc doan vua chon:")(princ (rtos dd 2 3))(princ "%")
)
     )

   ;(setq pt2 (getpoint "\nDiem ghi cao do vua tinh duoc :"))
   ;(command "TEXT" pt2 "" "90" ypr)
   ;(setq pt3 (getpoint "\nDiem ghi K/C le vua tinh duoc :"))
   ;(command "TEXT" pt3 "" "90" ypr1)
   ;(setq a '(0 0 0) g 0)
   (setq thchon (nentselp"\nChon text can thay the:"))
   (if (/= nil thchon)
     (progn
(setq ens (car thchon))
(COMMAND "CHANGE" ens "" "" "" "" "" ""(rtos y 2 2))
(COMMAND "CHANGE" ens  "" "p" "c" "6" "")
)
     )
   (princ)
   )
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Hề hề hề,

Cái vụ đổi màu text thì mình có thể giúp bạn bỏ đi, còn cái vụ làm text đậm lên thì mình chịu chết vì theo như mình đọc trong lisp thì đâu có vụ này. Chỉ có mỗi việc thay đổi nội dung text và đổi màu nó chứ có đụng gì đến các thông số khác của text đâu. Có nhẽ chỉ do đổi màu mà nó làm bạn cảm thấy nét chữ to lên mà thôi.

Để sửa bạn chỉ cần vô hiệu hóa dòng code sau :

(COMMAND "CHANGE" ens "" "p" "c" "6" "")

Tuy nhiên theo mình thì không nên sửa vì điều này sẽ giúp bạn nhận ra text nào đã được sửa và text nào thì chưa sửa. Như vậy rất có lợi với việc chỉnh sửa các bản vẽ có rất nhiều text mà nó` lại nằm chồng chéo lên nhau nữa bạn ạ.

Hề hề hề.

Cách vô hiệu hóa đơn giản nhất là bạn thêm vào đầu dòng code ấy một hay vài ký tự chấm phẩy ;

Khi bạn cần khôi phục nó thì lại xóa các ký tự này đi.

Hề hề hề,...

Tháng 6 23, 2011

thứ 2 nữa là, nhờ bạn Tue và Phamthanhbinh tích hợp thêm cho lisp có thể trừ tất cả text số (chú ý là các text số rời rạc ở các vị trí ngẫu nhiên, hướng xoay ngẫu nhiên) cho 1 hằng số, kết quả trả trả về được ghi lại ở đúng vị trí của text bị trừ và góc xoay của text không đổi. mở rộng cho cả 4 phép tính cộng/trừ/ nhân/ chia thì càng tốt.

Điều cốt lõi nhất là góc xoay của text không đổi và nếu kết quả trả về được ghi ở dạng số thập phân làm tròn 2 số sau dấu phẩy thì thật tuyệt.

Hề hề hề,

Phải chăng bạn cần cái lisp thế này:

(defun c:Chgt (/ tsl hs key_ctnc key_ctnc1 t1 txt num et)
(vl-load-com)
(command "undo" "be")
(setq tsl (acet-ss-to-list (ssget (list (cons 0 "text")))))
(setq hs (getreal "\n Nhap hang so tinh toan: "))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(foreach txt tsl
    (setq et (entget txt))
    (setq t1 (cdr (assoc 1 et)))
    (setq num (congtrunhanchia key_ctnc (atof t1) hs))
    (setq et (subst (cons 1 (rtos num 2 2)) (assoc 1 et) et))
    (entmod et)
)
(command "undo" "e")
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
	((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
	((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
	((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
	((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))	
)
kq
)

Hế hề hề, nếu bạn muốn ghép nó vào lisp nào thì chỉ việc copy và paste nó vào thôi nhé. Nhớ các lệnh khi chạy lisp.

Tháng 6 24, 2011

Hề hề hề,

Thêm làm chi vì bác ấy có dùng chi tới thằng t_left đâu. Chỉ là bác ấy vui tay thêm vô cho có tụ rồi lại quên hổng xóa ấy mừ. Hề hề hề,...

Hề hề, srr các bác vì e hấp tấp quá, chỉ thấy thiếu thì bỏ thêm vô chứ hổng đọc hết code được ^^ Mong các bác lượng thứ.

P/S : dạo này bác Bình quay trở lại, quả có lợi hại, đánh đông dẹp bắc các loại request ^^ Chúc bác sớm đẻ được nhiều thứ hay để bọn em mót.

Tháng 6 24, 2011

Mình muốn nhờ bạn viết cho mình cái lisp nối dài một hình chữ nhật (rec) tới một đoạn thẳng (line), giống như là nối đoạn thẳng (line) với đoạn thẳng (line) thông dụng và có sẳn trong auto cad vậy.

Và nếu có thể thì viết luôn nối hact giúp.

Mong được giúp đở.

Tháng 6 24, 2011

Mình muốn nhờ bạn viết cho mình cái lisp nối dài một hình chữ nhật (rec) tới một đoạn thẳng (line), giống như là nối đoạn thẳng (line) với đoạn thẳng (line) thông dụng và có sẳn trong auto cad vậy.

Mong được giúp đở.

Bạn có "nối dài tới" và "nối với" nên chưa rỏ "thông dụng và có sẳn trong auto cad" ở đây là bạn nói đến lệnh extend hay Pedit.

-Nếu là extend thì bạ dùng STRETCH với hình chữ nhật xem.

-Nếu là Pedit thì nên cho bản vẽ trước và sau khi thực hiện mong muốn.

Tháng 6 24, 2011

nhờ các bác giúp cho cái lip với ý tưởng như trong hình vẽ sau

http://www.cadviet.com/upfiles/3/thaytencoc_1.dwg

thank cac bac

Tháng 6 24, 2011

Bạn có "nối dài tới" và "nối với" nên chưa rỏ "thông dụng và có sẳn trong auto cad" ở đây là bạn nói đến lệnh extend hay Pedit.

-Nếu là extend thì bạ dùng STRETCH với hình chữ nhật xem.

-Nếu là Pedit thì nên cho bản vẽ trước và sau khi thực hiện mong muốn.

Mình muốn dùng lệnh extend cho hình chữ nhật (kéo dài "extend" cho hình chữ nhật chứ không phải di chuyển như lệnh "stretch")

Thông thường mình hay dùng lệnh "extend" cho đường thẳng bậy giờ là cho hình chữ nhật.

Tháng 6 24, 2011

Mình muốn dùng lệnh extend cho hình chữ nhật (kéo dài "extend" cho hình chữ nhật chứ không phải di chuyển như lệnh "stretch")

Thông thường mình hay dùng lệnh "extend" cho đường thẳng bậy giờ là cho hình chữ nhật.

Bạn có lường trước được tình huống cả 2 phía của HCN nếu kéo dài thì đều gặp Line không ? Hoặc bạn có chỉ định cho HCN kéo dài thì gặp Line ở điểm giao nào ? Nếu là điểm Extend đầu mút thì là đầu mút nào ?

Tháng 6 24, 2011

Hề hề hề,

Phải chăng bạn cần cái lisp thế này:

(defun c:Chgt (/ tsl hs key_ctnc key_ctnc1 t1 txt num et)
(vl-load-com)
(command "undo" "be")
(setq tsl (acet-ss-to-list (ssget (list (cons 0 "text")))))
(setq hs (getreal "\n Nhap hang so tinh toan: "))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(foreach txt tsl
    (setq et (entget txt))
    (setq t1 (cdr (assoc 1 et)))
    (setq num (congtrunhanchia key_ctnc (atof t1) hs))
    (setq et (subst (cons 1 (rtos num 2 2)) (assoc 1 et) et))
    (entmod et)
)
(command "undo" "e")
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
	((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
	((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
	((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
	((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))	
)
kq
)

Hế hề hề, nếu bạn muốn ghép nó vào lisp nào thì chỉ việc copy và paste nó vào thôi nhé. Nhớ các lệnh khi chạy lisp.

chuẩn luôn. thanks bạn nhiều! ^^

Hề hề hề,

Lỗi ở dòng code này:

(setq t_left (ssadd txt t_left))

Lý do là lúc này chửa có cái tập chọn t_left nên nó chả biết ghép cái thằng txt vào tập chọn nào. Vậy nên nó báo lỗi ; error: bad argument type: lselsetp nil

Bạn chỉ cần vô hiệu hóa dòng code này là được thôi...

ừ đúng rồi. mình làm được rồi. giờ nó chạy ngon. hề hề. thanks bạn nhiều.

Tháng 6 24, 2011

Bạn có lường trước được tình huống cả 2 phía của HCN nếu kéo dài thì đều gặp Line không ? Hoặc bạn có chỉ định cho HCN kéo dài thì gặp Line ở điểm giao nào ? Nếu là điểm Extend đầu mút thì là đầu mút nào ?

Mình muốn nói ở đây là kéo dài thêm ra giống như sử dụng lệnh extend với đường thẳng vậy. Khi đó đối tượng được kéo dài ra sẽ chỉ dài tới đường thẳng mình đã chọn làm ranh giới. Đơn giản giống như bạn xài cho đường thẳng thôi mà.

Mình cũng đã nhắc lại ở trên rồi mà. Thay vì dùng lệnh extend cho đường thẳng thì bây giờ các bạn có thể giúp mình làm tương tự đối với hình chữ nhật thôi.

Để dể hiểu hơn thì mình có một ví dụ nho nhỏ :

Cho hình chữ nhật ABCD có AB=600mm , AD=800mm

Khoảng cách từ đoạn thẳng AB tới một đường thẳng D cho trước là X

Vậy làm sao để kéo dài đồng thời đoạn thẳng AD và BC đến đoạn thẳng D cho trước.

Vì ABCD là hình chữ nhật khép kín nên đường thẳng AB chắc hắn phải di chuyển theo.

Bài toán của mình đưa ra là vậy

Mong các bạn viết giúp mình cái lisp giải quyết bài toán này.

Tháng 6 24, 2011

Mình muốn nói ở đây là kéo dài thêm ra giống như sử dụng lệnh extend với đường thẳng vậy. Khi đó đối tượng được kéo dài ra sẽ chỉ dài tới đường thẳng mình đã chọn làm ranh giới. Đơn giản giống như bạn xài cho đường thẳng thôi mà.

Mình cũng đã nhắc lại ở trên rồi mà. Thay vì dùng lệnh extend cho đường thẳng thì bây giờ các bạn có thể giúp mình làm tương tự đối với hình chữ nhật thôi.

Để dể hiểu hơn thì mình có một ví dụ nho nhỏ :

Cho hình chữ nhật ABCD có AB=600mm , AD=800mm

Khoảng cách từ đoạn thẳng AB tới một đường thẳng D cho trước là X

Vậy làm sao để kéo dài đồng thời đoạn thẳng AD và BC đến đoạn thẳng D cho trước.

Vì ABCD là hình chữ nhật khép kín nên đường thẳng AB chắc hắn phải di chuyển theo.

Bài toán của mình đưa ra là vậy

Mong các bạn viết giúp mình cái lisp giải quyết bài toán này.

-Bạn chỉ cần biết dùng lệnh STRETCH là làm được thôi. Qua cách diển đạt của bạn mình biết bạn chưa biết cách dùng STRETCH.

-Còn bạn bảo "đơn giản" sau khi bác ket đã nêu các trường hợp chứng tỏ bạn dùng cad chưa thạo. Minh hoạ ý bác ket bằng hình để bạn dể hình dung:

*Đây là mục lisp nhưng mình xin pép hướng dẩn bạn dùng lệnh STRETCH ở đây luôn.

-Hình chử nhật có 4 đỉnh. Khi tạo vùng chọn thì bạn chọn bằng cửa sổ như cái nét gạch đứt trong hình. Đỉnh nào nằm trong vùng chọn phần mình thể hiện màu xanh thì sẽ di chuyển các đỉnh khác giữ nguyên.

-Bạn xem 4 trường hợp chọn đối tượng làm theo xong kéo thử để nhận ra sự khác biệt.

Tháng 6 24, 2011

Mình muốn nói ở đây là kéo dài thêm ra giống như sử dụng lệnh extend với đường thẳng vậy. Khi đó đối tượng được kéo dài ra sẽ chỉ dài tới đường thẳng mình đã chọn làm ranh giới. Đơn giản giống như bạn xài cho đường thẳng thôi mà.

Mình cũng đã nhắc lại ở trên rồi mà. Thay vì dùng lệnh extend cho đường thẳng thì bây giờ các bạn có thể giúp mình làm tương tự đối với hình chữ nhật thôi.

Để dể hiểu hơn thì mình có một ví dụ nho nhỏ :

Cho hình chữ nhật ABCD có AB=600mm , AD=800mm

Khoảng cách từ đoạn thẳng AB tới một đường thẳng D cho trước là X

Vậy làm sao để kéo dài đồng thời đoạn thẳng AD và BC đến đoạn thẳng D cho trước.

Vì ABCD là hình chữ nhật khép kín nên đường thẳng AB chắc hắn phải di chuyển theo.

Bài toán của mình đưa ra là vậy

Mong các bạn viết giúp mình cái lisp giải quyết bài toán này.

Nếu bạn đã ngại đọc kỹ mấy câu mình hỏi thì bạn post hình lên để mọi người cùng hiểu nhé :) Như ý bạn thì rõ ràng HCN sẽ k còn là HCN nữa

Tháng 6 24, 2011

nhờ các bác giúp cho cái lip với ý tưởng như trong hình vẽ sau

http://www.cadviet.com/upfiles/3/thaytencoc_1.dwg

thank cac bac

Hề hề hề,

bạn xài thử cái nàu coi đã ưng cái bụng chưa hè???


(defun c:retn (/ tsl1 tsl2 txt tx t1 t2 t3 elt)
(vl-load-com)
(command "undo" "be")
(alert "\n Chon ten coc tren trac doc theo thu tu thay the")
(setq tsl1 (acet-ss-to-list (ssget (list (cons 0 "text")))))
(alert "\n Chon ten coc tren trac ngang theo thu tu thay the")
(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text")))))
(foreach txt tsl1
       (setq t1 (cdr (assoc 1 (entget txt))))
       (setq n (vl-position txt tsl1))
       (setq tx (nth n tsl2))
       (if tx
           (progn
               (setq elt (entget tx)
                       t2 (substr (cdr (assoc 1 elt)) 1 4)
                       t3 (strcat t2 " " t1)
                       elt (subst (cons 1 t3) (assoc 1 elt) elt)
               ) 
               (entmod elt)
          )
       )
)
(command "undo" "e")
(princ)
)

Tháng 6 24, 2011

Hề hề hề,

bạn xài thử cái nàu coi đã ưng cái bụng chưa hè???


(defun c:retn (/ tsl1 tsl2 txt tx t1 t2 t3 elt)
(vl-load-com)
(command "undo" "be")
(alert "\n Chon ten coc tren trac doc theo thu tu thay the")
(setq tsl1 (acet-ss-to-list (ssget (list (cons 0 "text")))))
(alert "\n Chon ten coc tren trac ngang theo thu tu thay the")
(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text")))))
(foreach txt tsl1
       (setq t1 (cdr (assoc 1 (entget txt))))
       (setq n (vl-position txt tsl1))
       (setq tx (nth n tsl2))
       (if tx
           (progn
               (setq elt (entget tx)
                       t2 (substr (cdr (assoc 1 elt)) 1 4)
                       t3 (strcat t2 " " t1)
                       elt (subst (cons 1 t3) (assoc 1 elt) elt)
               ) 
               (entmod elt)
          )
       )
)
(command "undo" "e")
(princ)
)

thank bác nó rất đúng ý em nhưng có một vấn đè rằng khi mình kích thủ công theo thứ tự các tên cọc thì nó rất chuẩn nhưng khi mình quét từ phải sang trái và từ dưới lên thì nó không nhận đúng cọc bác à.

ko biết nói gì hơn chỉ biết cảm ơn bác đã giúp đỡ em nhiều.

Tháng 6 24, 2011

thank bác nó rất đúng ý em nhưng có một vấn đè rằng khi mình kích thủ công theo thứ tự các tên cọc thì nó rất chuẩn nhưng khi mình quét từ phải sang trái và từ dưới lên thì nó không nhận đúng cọc bác à.

ko biết nói gì hơn chỉ biết cảm ơn bác đã giúp đỡ em nhiều.

Hề hề hề,

Đúng như vậy bạn ạ. Việc xác định thứ tự các đối tượng trong một tập chọn là khá đau đầu. Vì thế cách tốt nhất để chọn đúng thứ tự của các phần tử trong tập chọn là dùng cách pick chọn lần lượt bạn ạ. Đặc biệt là với những bản vẽ đã qua nhiều lần chỉnh sửa.

Vẫn biết đây là cách hơi thủ công, xong chậm mà chắc còn hơn nhanh mà hỏng việc.

Hề hề hề,...

Giá như bác nào có cách khác hay hơn thì....... mình lại được mót.

Hề hề hề,

Nếu như trên bản vẽ của bạn, các tên cọc trên trắc dọc được sắp xếp theo một trật tự từ trái qua phải và các trắc ngang tại mỗi vị trí được sắp xếp theo đúng thứ tự từ trên xuống dưới thì sẽ có thể có cách làm đỡ phải thủ công hơn bạn ạ.

Bạn có đồng ý sắp xếp trên bản vẽ của bạn như vầy không???

Tuy nhiên trong trường hợp này nếu như bạn thiếu đi một vài cái trắc ngang tại vị trí các cọc thì nó cũng sẽ bị sai đấy.

Vì thế cách tốt nhất vẫn là bạn nên xác định rõ tùng thằng trên trắc dọc ứng với từng trác ngang bạn có .

Hề hề hề,...

Tháng 6 24, 2011

Nếu bạn đã ngại đọc kỹ mấy câu mình hỏi thì bạn post hình lên để mọi người cùng hiểu nhé :) Như ý bạn thì rõ ràng HCN sẽ k còn là HCN nữa

http://www.mediafire.com/?9sdodwm63vpb5fv

Tháng 6 24, 2011

Hề hề hề,

Đúng như vậy bạn ạ. Việc xác định thứ tự các đối tượng trong một tập chọn là khá đau đầu. Vì thế cách tốt nhất để chọn đúng thứ tự của các phần tử trong tập chọn là dùng cách pick chọn lần lượt bạn ạ. Đặc biệt là với những bản vẽ đã qua nhiều lần chỉnh sửa.

Vẫn biết đây là cách hơi thủ công, xong chậm mà chắc còn hơn nhanh mà hỏng việc.

Hề hề hề,...

Giá như bác nào có cách khác hay hơn thì....... mình lại được mót.

Hề hề hề,

Nếu như trên bản vẽ của bạn, các tên cọc trên trắc dọc được sắp xếp theo một trật tự từ trái qua phải và các trắc ngang tại mỗi vị trí được sắp xếp theo đúng thứ tự từ trên xuống dưới thì sẽ có thể có cách làm đỡ phải thủ công hơn bạn ạ.

Bạn có đồng ý sắp xếp trên bản vẽ của bạn như vầy không???

Tuy nhiên trong trường hợp này nếu như bạn thiếu đi một vài cái trắc ngang tại vị trí các cọc thì nó cũng sẽ bị sai đấy.

Vì thế cách tốt nhất vẫn là bạn nên xác định rõ tùng thằng trên trắc dọc ứng với từng trác ngang bạn có .

Hề hề hề,...

hihi dúng bác nhỉ thế thì thầy trò đường tăng mình lại ngồi chờ có phương án mới hay hơn hả bác .

cảm ơn bác nhiều .

quên mất còn vụ này nữa bác à .

chẳng hạn như hàng loạt text dạng A và hàng loạt text dạng B đều dc viết bằng 1 layẻr có cách nào để tắt text dữ lại text B ko bác .

có thể nhúng líp vào dc ko bác .

chẳng han như thế nhày nhé em có các text tên cọc từ cọc 1 đến cọc n

bên dưới dòng text cọc là text lý trình Km 00+00 đến Km xx+xx em muốn tắt 1 trong 2 cái để sử dụng nhưng ko dc vì nó có cái éo le là dùng chung 1 layer

còn nữa là nếu có cái lip chỉ hiện tất cả những text mà mình đánh mấy ký tự đầu lÀ dc ấy bác giống như kiểu lẹnh find ấy bác thì bác cho em với .

vì crânỳ rất tiện cho việc thiết kế nó giúp rất nhiều .

tiết kiệm thời gian không phải thủ công .

Tháng 6 24, 2011

http://www.mediafire.com/?9sdodwm63vpb5fv

Mặc định thầm nội quy box post file CAD ver 2004 hoặc 07, chứ cao quá nhiều người hok đọc đc :)

Đăng nhập

Viết lisp theo yêu cầu [phần 2]

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

gasmanc 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

phamthanhbinh 3147

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

hakhoailang 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

hakhoailang 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

phamthanhbinh 3147

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

ketxu 3000

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

phamthanhbinh 3147

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

phamthanhbinh 3147

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

phamthanhbinh 3147

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

ketxu 3000

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

minhvanvui 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

duy782006 1593

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

hakhoailang 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

minhvanvui 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

ketxu 3000

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

gasmanc 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

minhvanvui 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

duy782006 1593

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

ketxu 3000

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

phamthanhbinh 3147