Chuyển đến nội dung
Diễn đàn CADViet

bach1212

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    193

  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi bach1212

  1. Đã đăng · Trả lời báo cáo

    Đây bạn Quoc93!

    ;Writen by PTB, changed by DVH (03/01/2012).
;Noi suy cao do tung diem tren Curve theo 2 Text cao do dau va cuoi Curve.
;Thu tu cua Text co the chon bat ky.
(defun c:nscdpl (/ pl oldos obj enta entb ha ha pa pb p1 p2 pllength pl1 sole hd hc pt hp)
(vl-load-com)
(setq oldos (getvar "osmode"))
(command "undo" "be")
(setq pl (car (entsel "\nChon Curve can noi suy cao do: "))
     	obj (vlax-ename->vla-object pl)
     	enta (car (entsel "\nChon Text cao do thu 1: "))
     	entb (car (entsel "\nChon Text cao do thu 2: "))
     	ha (atof (cdr (assoc 1 (entget enta))))
     	hb (atof (cdr (assoc 1 (entget entb))))
     	pa (cdr (assoc 10 (entget enta)))
     	pb (cdr (assoc 10 (entget entb)))
     	p1 (vlax-curve-getStartPoint obj)
     	p2 (vlax-curve-getEndPoint obj)
     	pllength (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)))
(or *sole* (setq *sole* 2))
(setq sole (getint (strcat "\nSo chu so thap phan ban khoai <" (itoa *sole*) ">: ")))
(if (not sole) (setq sole *sole*) (setq *sole* sole))
(if (< (distance p1 pa) (distance p1 pb))
 (setq hd ha hc hb)
 (setq hd hb hc ha))
(princ "\nLan luot chon cac diem can noi suy thuoc Curve...")
(while (setq pt (getpoint "\nChon diem: "))
 (setq pl1 (vlax-curve-getdistatpoint obj pt)
       	hp (+ hd (* (- hc hd) (/ pl1 pllength))))
 (command "text" pt 2 0 (rtos hp 2 sole)))
(command "undo" "end")
(setvar "osmode" oldos)
(princ))

    Nhiều khi e cần chọn 2 điểm đầu và cuối bất kỳ VD: A,B.... nằm trên curve (chứ không phải lúc nào cũng là 2 điểm mút của đường curve) đã có cao độ, rồi nội suy ra cao độ tại 1 điểm nằm giữa 2 điểm được chọn đó (vẫn nằm trên curve). Em thấy lisp này chưa có lựa chọn đó. Mong các bác giúp e bổ sung thêm lựa chọn cho lisp:

    111.jpg

    1. Chọn điểm mốc thứ nhất

    2.Chọn cao độ của mốc thứ nhất (Có thể pick vào text có sẵn hoặc nhập tay vào)

    3. Chọn điểm mốc thứ hai

    4.Chọn cao độ của mốc thứ hai (Có thể pick vào text có sẵn hoặc nhập tay vào)

    (Lisp tự động tính độ dốc giữa 2 điểm A-B: lấy cao độ 2 đầu trừ nhau chia cho chiều dài đoạn AB, AB không phân biệt cong thẳng, chỉ cần lấy chiều dài)

    5.Chọn vị trí cần nội suy (xin đừng làm mất chế độ bắt điểm :D)

    6.Kết quả nội suy thể hiện trên command

    7.Chọn vị trí tiếp theo hoặc thoát lệnh

  2. Đã đăng · Trả lời báo cáo

    Hề hề hề,

    Cứ theo cái ngu ý của mình thì là do các đối tượng này của bạn là đang nằm trong không gian chứ không phải trên mặt phẳng vẽ. Bạn hãy thử dùng lệnh flatten với chúng để chuyển chúng về cao độ là 0.0000 và test lại xem nhé.

    Hy vọng bạn hài lòng.

    Oài, khỏe rùi. :D

    Sự copy đều được thực hiện trên chế độ 2D, sao chúng lại nhảy sang chế độ không gian được nhỉ? (Chẳng có nhẽ chúng thích thám hiểm vũ trụ :D)

    Ccho e hỏi 1 chút ngu ý: nhận biết được chúng ở không gian với mặt phẳng như thế nào?

    E thấy thuộc tính của 2 tên sau khi flatten thì không thấy có sự khác nhau????

  3. Đã đăng · Trả lời báo cáo

    Tue_VN thân!

    Đúng rồi Tue_NV ạ, ý mình là như thế! Nhưng có một điều mình muốn hỏi cho rõ nhé Tue_VN!

    1. Còn trường hợpx 10a7.1->10a7.2-->10a7.3.....có giống với trường hợp 1.1.1-->1.1.2 không?

    2. Câu này chắc mình hỏi hơi thừa một chút, nhưng cũng nên hỏi để Tue_NV giúp mình dễ dàng hơn.

    Nếu như mình đánh số được 1.1.1-->1.1.2 thì mình sẽ đánh được số 1.1-->1.2-->1.3 chứ Tue_NV.

    Cảm ơn Tue_NV nhé!

    ;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=51710
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=34029
;; free lisp from cadviet.com
;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh oCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************

;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
n2 (itoa (+ dn (atoi n)))
i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;-------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
i (strlen c)
c1 (substr c 1 (- i 1))
c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
(progn (command "erase" (entlast) "") (alert "Over character!") (exit))
(strcat c1 c2)
)
)
;;;============================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
cn (getstring "\nBegin at <1>: " T)
dn (getint "\nIncrement <1>: ")
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point <exit>: "))
(wtxt cn p)
(if (= n "")
   	(setq cn (incC cn))
   	(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))      
)
)
(princ)
)
;;;============================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(command "undo" "be")
(setq
e (car (entsel "\nSelect template text:"))
dn (getint "\nIncrement <1>: ")
p1 (getpoint "\nBase point:")
cn (cdr (assoc 1 (entget e)))
k (strlen cn)
i (getint "\n Nhap so ky tu can giu trong suffix: ")
cn0 (substr cn 1 (- k i))
cn1 (substr cn (1+ (- k i)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn0)
n (vl-string-subst "" c cn0)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
(command "copy" e "" p1 p2)
(if (= n "")
   	(setq cn0 (incC cn0))
   	(setq cn0 (strcat c (incN (vl-string-subst "" c cn0) dn)))      
)
(setq
   	dat (entget (entlast))
   	dat (subst (cons 1 (strcat cn0 cn1)) (assoc 1 dat) dat)
)
(entmod dat)  
)
(command "undo" "e")
(princ)
)
;;;============================
(defun C:oCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
e0 (car (entsel "\nSelect attribute block:"))
e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq
dn (getint "\nIncrement <1>: ")
p1 (getpoint "\nBase point:")
cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
(command "copy" e0 "" p1 p2)
(if (= n "")
   	(setq cn (incC cn))
   	(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))      
)
(setq
   	dat (entget (entnext (entlast)))
   	dat (subst (cons 1 cn) (assoc 1 dat) dat)
)
(entmod dat)
(command "regen")
)
(princ)
)
;;;============================

    Mình góp vui tí nhé. Trên diễn đàn đã có lisp này có thể đáp ứng được yêu cầu copy tăng dần của bạn nè.

    Lệnh: OC

  4. Đã đăng · Trả lời báo cáo

    File đính kèm: http://www.cadviet.c..._duong_tron.rar

    File trên của e bị lỗi các text và circle: Hiện tại không thao tác được 1 số lệnh với 2 đối tượng trên như là:

    1. Không dùng được lệnh tcircle với text.

    2. Move hay copy circle trên thì không cho bắt điểm (chỉ bắt được tâm).

    Nguyên nhân có lẽ là do quá trình copy từ bản vẽ khác vào (Text và circle gốc từ bản vẽ khác đó không bị lỗi).

    Tạo 1 text và circle mới hoàn toàn thì lại dùng các lệnh bình thường được.

    Vậy làm thế nào để có thể thực hiện các lệnh bình thường với các đối tượng bị lỗi trên ah???? Mong các bác chỉ giáo!

    Hic, lỗi này không có cách khắc phục chắc e phải mỏi tay dài dài quá ah..... :wacko:

  5. Đã đăng · Trả lời báo cáo

    File đính kèm: http://www.cadviet.c...304_wipeout.rar

    Cho e hỏi trong bản vẽ kèm theo trên: dùng lisp HA của bác Doan Van Ha thì bỏ sót 1 đường polyline (đường này dùng lệnh PL vẽ mới) không được chọn. Dùng xong lisp HA chỉ tạo được 3 đường wipeout? Nguyên nhân do đâu ah?

    Dùng HA2, sau khi biến đường wipeout về polyline, rồi dùng lại HA thì lisp HA ko nhận đường polyline vừa chuyển đổi đó được? Còn dùng WO2PL thì vẫn oki.....

    Có thể bổ sung cho chọn đối tượng là đường tròn không ah hay nói chung là tất cả các đối tượng miễn sao là kín ah? Cái này cũng hay dùng đến các bác ah!!! :D

  9. Đã đăng · Trả lời báo cáo

    Ồ, lần trước nói ý nói tứ rồi mà bạn lại lập tiếp cái nữa.

    Thôi thì nói thẳng với bạn vậy : Hãy tránh dùng từ "Tôi muốn", vì bạn đang ở vị trí người cần được giúp đỡ ^^ (Mặc dù đội ngũ BQT thống nhất với tiền tố [Yêu cầu] cho ngắn gọn)

    - Về vấn đề của bạn, Hatch là đối tượng khó chịu, với khả năng của mình thì chỉ giúp bạn được ở mức thực hiện thao tác trim + Hatch lại giúp bạn thôi.

    Lệnh : brh

    Thao tác : Chọn Pline chia, Pick vào 1 phía của miếng Hatch

    (defun c:brh ()
(grtext -1 "Free Lisp From Cadviet @Ketxu")
(setq Pline (car (entsel "\n Pick vao Pline"))
 	e (entsel "\nPick vao vung Hatch ")
     hObj (car e)
 	pt (cadr e)
)
(command ".trim"  Pline "" pt "" "-hatch" pt "" "_MATCHPROP" hObj (entlast) ""))

    Bác ketxu bổ sung thêm lựa chọn đường cắt là nhiều đường 1 lúc, và có thể chọn cả pline, arc, spline....được không ah? Thanks bác

    • Like 1

  12. Đã đăng · Trả lời báo cáo

    File đính kèm: http://www.cadviet.c...ua_khu_11_1.rar

    Bản vẽ của e có các text ghi chú có nội dung: D600,L30 hay D800,L60

    Đây là thông số đường kính và chiều dài của cống. Để thống kê chiều dài của 1 loại cống nào đó (D600 chẳng hạn) e phải cộng lần lượt các số như số 30 sau chữ L, nên rất mất thời gian. Hic hic...

    Mong các bác viết giúp e lisp: tính tổng các số sau chữ L mỗi khi pick chọn vào từng text như trên, kết quả thể hiện trên dòng command hoặc trên màn hình

    Lisp đưa ra lựa chọn:

    1.Chọn các text cần tính: Người dùng sẽ pick chọn vào lần lượt các text như trên. (Text được thể hiện là đã chọn rồi, và chỉ tính 1 lần, để không bị nhầm lẫn nếu lỡ pick lại text đó lần nữa)

    2.Kết quả cho trên thanh command hoặc màn hình.

    3.Kết thúc lệnh

    VD: có 3 text: D600,L30 D600,L40 D600,L50

    Dùng lisp: kết quả được: 120

    Mong tin các bác ah! Thanks nhìu ah!

  14. Đã đăng · Trả lời báo cáo

    Các bác có thể biến đổi thêm thế này giúp e với: Chọn text A trừ đi 1 số nhập từ bàn phím (và có lưu giá trị này cho các lần lặp lại sau) rồi điền kết quả phép trừ vào text B.

    VD: text A=5, số nhập vào: 2.

    Text B ban đầu = 1, sau khi thay B sẽ = 3

    Tiếp tục lệnh: số 2 được lưu để không phải gõ lại nếu vẫn giữ nguyên số cần nhập, nếu không có thể nhập số khác

  15. Đã đăng · Trả lời báo cáo

    Bạn xem hướng dẫn ở đây:

    1. Sử dụng chương trình

    Chạy chương trình HASPHL2007

    Chọn Tab “Driver” rồi nhấn Install Driver

     

    Chọn tab Emulator rồi nhấn Start service

     

    Chọn Tab Dongles rồi nhấn Load dump

    Tuỳ chương trình bạn cần mà chọn File *.DNG của NoVa hay HS

    Khoá sẽ được lưu giữ trong chương trình đến khi bạn load dump khác

    Nếu bạn muốn chương trình HASPHL2007 chạy khi máy tính khởi động thì chọn tab Driver rồi chọn như hình dưới rồi nhấn rồi nhấn Save State

     

    5 Khởi động chương trình:

    Mỗi khi khởi động lại máy bạn phải chạy lại chương trình “Harmony Software Check Active Module” (Phải đảm bảo chương trình HASPHL2007 đã được chạy và bạn phải nhấn vào nút Start service trong tab Emulator)

     

    Nhấn vào nút thiết lập

     

    Chọn đường dẫn cho Autocad tùy theo phiên bản CAD 2004, 2005, 2006

    Nếu bạn chạy HS thì kích vào mục HS sao cho có 2 số 1 như hình dưới rồi chọn Run Modunle hoặc chạy chương trình Harmony Software ngoài màn hình

     

    Nếu bạn chạy Nova thì bạn nhấn OK chương trình sẽ thông báo

     

     

    Bạn tiếp tục nhấn OK rồi chạy chương trình Nova_TDN ngoài màn hình.

  18. Đã đăng · Trả lời báo cáo

    Yêu cầu của bạn có vẻ giống yêu cầu này, bạn tham khảo, tự tạo Block theo form của mình (miễn là có tên - thứ tự giống thế ) :

    http://www.cadviet.c...showtopic=47442

    cám ơn bác ketxu, e tìm trên diễn đàn mãi mà không được như ý, nên mới gửi yêu cầu

    Chúc bác zui

  19. Đã đăng · Trả lời báo cáo

    Có bác nào làm bên thủy lợi không ạ? e đang cần 1 bản vẽ về mặt cắt ngang và các chi tiết của 1 mương tưới tiêu thủy lợi. Bác nào có cho e xin bản tham khảo với. E làm bên giao thông, làm mở rộng cái đường mới cần phải phá mương cũ, nên phải làm lại mương sang bên cạnh mà hổng có biết j về mương hết. hjjjjj

  20. Đã đăng · Trả lời báo cáo

    Mình viết tạm cho bạn thế này thôi. ngại viết code lập bảng lắm.

    Khi dùng, Chọn xong đường tròn thì nhấn tiếp Ctrl+V là được. Cũng không khác việc lập bảng là mấy..

    (defun c:ytc (/ SetClipBoardText ytc-g i a r en ent)
(defun SetClipBoardText (text / htmlfile result ) ; By XShrimp
(if (= 'STR (type text))
(progn
(setq htmlfile (vlax-create-object "htmlfile")
result (vlax-invoke(vlax-get(vlax-get htmlfile'ParentWindow)'ClipBoardData)'SetData "Text" text ))
(vlax-release-object htmlfile) text)))
(defun ytc-g (goc / gd gp gs )
(setq Gd (fix Goc)
Gp (fix (* (- Goc Gd) 60))
Gs (* (- (* (- Goc Gd) 60) Gp) 60))
(strcat (if (< Gd 10) (strcat "0" (rtos Gd 2 0)) (rtos Gd 2 0)) "d"
(if (< Gp 10) (strcat "0" (rtos Gp 2 0)) (rtos Gp 2 0)) "'"
(if (< Gs 9.5) (strcat "0" (rtos Gs 2 0)) (rtos Gs 2 0)) "''"))
(and
(setq i (getint "nhap ten duong cong (nhap so):"))
(setq i (itoa i))
(not (while (not (and (setq en (car (entsel "\n chon duong can lay yeu to cong:\n")))
(wcmatch (cdr (assoc 0 (setq ent (entget en)))) "ARC")))))
(setq a (* (vlax-get-property (vlax-ename->vla-object en) 'TotalAngle) 0.5))
(SetClipBoardText (princ (strcat "A" i " = " (ytc-g (+ (/ (* (- pi a a) 180.) pi) 0.00002))
"\nR" i " = " (rtos (setq R (cdr (assoc 40 ent)))) "m"
"\nT" i " = " (rtos (/ (* R (sin a)) (cos a)) 2 2) "m"
"\nP" i " = " (rtos (- (/ R (cos a)) R) 2 2) "m"
"\nK" i " = " (rtos (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)) 2 2) "m"))))
(princ))

    e cám ơn bác. cho e hỏi, làm thế nào để rút bớt số chữ số thập phân sau dấu phẩy của thông số bán kính R khi dùng lisp này từ 4 về 2 con số thui ah?

  21. Đã đăng · Trả lời báo cáo

    Một đường cong tròn thường có các thông số kỹ thuật là: góc ngoặt chuyển hướng tại đỉnh A, bán kính R, chiều dài đường cong K, độ dài đoạn tiếp tuyến T, độ dài đoạn phân giác P

    Em thường phải thống kê các đường cong tại các nút giao ngã 3, ngã tư đường nên Em muốn nhờ các bác giúp e viết lisp lập được bảng các thông số trên như file đính kèm:http://www.cadviet.c...4_nutgiaohl.rar

    Chúc các bác vui vẻ....

  24. Đã đăng · Trả lời báo cáo

    Đoạn AB là Line :

    (defun c:chial(/ e ename p1 p2 x1 y1 x2 y2 sk i )
(setq e (entget(setq ename (car(entsel "\n Chon Line can chia : "))))	   
	x1 (car (setq p1 (getpoint "\n Diem 1")))
	y1 (cadr p1)
	x2 (car (setq p2 (getpoint p1 "\n Diem 2")))
	y2 (cadr p2)
	sk (getint "\n So khoang chia: ")
	i 0
)
(command "_Pline")
(command (cdr (assoc '10 e)))
(repeat (+ 1 sk)
(command (setq points
(list (+ x1 (* i (/ (- x2 x1) sk)))
  	(+ y1 (* i (/ (- y2 y1) sk)))
		0)))
	(setq i (1+ i))
	)
(command (cdr (assoc '11 e)) "")
(entdel ename)	   
)

    bác ket ah, bác sửa thêm lisp này dùng được cho cả trường hợp nếu như đoạn AB là 1 đoạn của pline ABCD..... gì đó chẳng hạn đi ah.

    Sau khi chia đoạn AB thành nhiều đoạn xong, thì pline ABCD.....vẫn sẽ là pline và tên mới là AA1A2A3......BCD.....

×