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

laivanyen

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

  • Số lượng nội dung

    38

  • Đã tham gia

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

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

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

    Nhờ các anh /chị viết giúp em lisp đánh số tự động vào phía sau của text có sẵn (text dim, mtext, text). theo 2 phương X và Y

    với phương X thứ tự từ trái qua phải đánh số X1, X2..Xn

    với phương Y thự tự trừ dưới lên đánh số Y1, Y2...Yn

    như bản vẽ mình đính kèm. Trân trọng cảm ơn !

     

    CadViet.Danh So Tu Dong.dwg

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

    Vào lúc 21/4/2019 tại 20:07, tien2005 đã nói:

    Đây nè Bạn, theo đúng yêu cầu. Hết 

    
;-------------------------------------------------------------------------------------------------------------------------
;          ==============>>  GT: TINH SL DAI VA GHI VAO DIM <<================ 
;-------------------------------------------------------------------------------------------------------------------------

(defun C:gt (/ ctc ss)
  (or *ctc* (setq *ctc* 200))
  (initget 6)
  (setq	ctc (getint
	      (strcat "\nNh\U+1EADp b\U+01B0\U+1EDBc th\U+00E9p < "
		      (itoa *ctc*)
		      ">:"
	      ) ;_ end of strcat
	    ) ;_ end of getint
  ) ;_ end of setq
  (if ctc
    (setq *ctc* ctc)
  ) ;_ end of if
  (if (setq ss (ssget "_:L" (list (cons 0 "DIMENSION"))))
    (progn
      (command "_.undo" "_begin")
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(vla-put-TextOverride
	  (vlax-ename->vla-object ent)
	  (strcat
	    "<>\\X"
;;;	    (itoa (+ (fix (/ (cdr (assoc 42 (entget ent))) *ctc*)) 1))
	    (itoa (+ (fix (/ (- (cdr (assoc 42 (entget ent)))200) *ctc*)) 1))
	    "%%c10A"
	    (itoa *ctc*)
	  ) ;_ end of strcat
	) ;_ end of vla-put-TextOverride
      ) ;_ end of foreach
      (command "_.undo" "_end")
      (princ)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun
(defun C:cl (/ num ss)
  (if (setq ss (ssget "_:L"))
    (progn
      (command "_.undo" "_begin")
      (or *num* (setq *num* 15))
      (initget 4)
      (setq num (getint (strcat "\nNhap color <" (itoa *num*) ">:")))
      (while (not (if num
		    (<= num 256)
		    T
		  ) ;_ end of if
	     ) ;_ end of not
	(princ "\nGia tri <=256.")
	(setq num (getint (strcat "\nNhap color <" (itoa *num*) ">:")))
      ) ;_ end of while
      (if num
	(setq *num* num)
      ) ;_ end of if
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(vla-put-Color (vlax-ename->vla-object ent) *num*)
      ) ;_ end of foreach
      (command "_.undo" "_end")
      (princ)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

     

    Em không muốn xuống dòng mà để ngang ở trên và sửa lại  ví dụ 8000=40x200  hoặc 40x200=8000 thì sửa như nào anh giúp em với

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

    Bản vẽ em có nhiều layout nhưng do người vẽ trước đó  không để cùng tọa độ nên giờ khi in publish em phải chuyển từng layout về cùng 1 tọa độ (0,0,0). Nhờ anh chị viết lisp chuyển bản vẽ ở tất cả các layout về tọa độ 0, 0,0 giúp em Như bản vẽ minh họa em đính kèm ạ. File Cadviet là bản vẽ chỉnh sửa, Frame.CN là khung tên xref ạ

    Frame.CN.dwg

    CadViet.dwg

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

    20 phút trước, Doan Nguyen Van đã nói: 
    
(defun c:te (/ ss ent n)
  (if (setq ss (acet-ss-to-list (ssget (list (cons 0 "MTEXT,TEXT"))))) (progn
  (foreach ent ss
    (if  (setq n (vl-string-search "-" (cdr (assoc 1 (entget ent))))) (progn
(entmod (subst (cons 1 (strcat (substr (cdr (assoc 1 (entget ent))) (+ n 2) ) "-"
			       (substr (cdr (assoc 1 (entget ent))) 1 n)))
	       (assoc 1 (entget ent)) (entget ent)))
)))
  (princ)))
  )

    Bạn test thử xem được chưa

    Cám ơn anh, cơ bản text không có gạch chân (%%u) thì đạt kết quả rất tốt . Trường hợp có gạch chân thì sẽ mất 1 vế không còn gạch chân, anh có thể khắc phục được nhược điểm này không giúp em thêm được không ạ

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

    Em có cái lisp khá hay về Hatch nhưng nó quá tổng quát ! mà em muốn rút gọn cho phù hợp nhu cầu của em nhưng em lại không đủ khả năng chỉnh sửa ! các bác giúp em với nhé : yêu cầu của em cụ thể trong bản vẽ ạ ! ( File em gửi gồm cả bản vẽ và cái lisp đó ạ )

    http://www.cadviet.com/upfiles/3/1.rar

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

    Bác xem bản vẻ của em mới hiểu rõ ý em: Nghĩa là ban đầu Hatch của em có nhiều loại khi mà gộp Hatch thì nó chỉ có 1 loại Hatch thôi (ý em là loại chứ không phải đối tuợng ) ! cho em hỏi chút nữa là tại sao khi Hatch có chế độ Associative rồi mà vẫn xảy ra trường hợp strech Hatch vẫn không thay dổi theo ạ !

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

    Vì khi người hatch đã bỏ chức năng Associative từ lúc ng ta hatch,bây giờ bạn nhận lại,theo mình thấy thì nó k cho enable chức năng đó lên nữa.Nếu dùng lisp tạo lại đường bao r bật chế độ đó lên thì mình nghĩ cũng k đơn giản đâu bạn :undecided: Nhất là trong trường hợp biên hatch là spline,điều này đề cập nhiều trên 4room r.Chắc phải nhờ các bác cao thủ tính đã

    Việc hatch lại cũng không có lâu mà :wub: .

    Nếu bạn vẫn muốn k phải hatch lại,thủ công thì bạn có thể mần theo cách này : Click đúp vào vùng hatch,chọn Recreate Boundary,chọn Polyline,rồi lúc nó hỏi có muốn Reassociative k,thì bạn chọn Yes :)

    Hic cách của Bác đúng yêu cầu của em nhưng như thế mất nhiều động tác mà chỉ có tác dụng cho 1 đối tượng Hatch và nhược điểm nữa là nó để lại cái đường bao rẩt đễ gây chồng chéo . Bác cố gằng giúp em phương án hoàn thiện hơn với ạ !

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

    Cái này mình viết hồi mới tập tọe Lisp, dùng có mấy lần rồi chẳng bao giờ dùng nữa. có thể có những lỗi người viết không lường trước vì hồi đó còn gà. Nếu dùng nó gặp lỗi gì thì thông báo lại để mình sửa.

    ;===========================================================================
(prompt"\nCmd:SRT- [Cong-Tru-Nhan-Chia 2 hang TEXT] by Thaistreetz - huuthais@yahoo.com\n")
;===========================================================================
(defun c:srt (/ cmd ss lst data i lst1 lst2)
(setq ctnc (cond (ctnc) ("Cong")))
(initget "Cong Tru Nhan CHia")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [Cong/Tru/Nhan/CHia/] <" ctnc ">"))) (ctnc)))
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "ucs" "world")
(prompt"\nChon hang-cot text thu nhat\n")
(if (setq ss1 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst1 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
		   '(lambda (x y) (if (equal (car(setq x1 (cdr (assoc 10 x)))) (car(setq y1 (cdr (assoc 10 y)))))
				      (> (cadr x1) (cadr y1)) (< (car x1) (car y1))))))))
(prompt"\nChon hang-cot text thu 2\n")
(if (setq ss2 (ssget (list (cons 0 "TEXT"))))
(if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1))))) 
                (- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
	(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
                       '(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
                        (> (cadr x2) (cadr y2))  (< (car x2) (car y2))))))
	(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
                       '(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
                        (< (cadr x2) (cadr y2)) (> (car x2) (car y2))))))
	))
(if (/= (sslength ss2) (sslength ss1)) (alert "\n    Hai tap hop text co so \ndoi tuong khong bang nhau!")
(progn
 (setq ptkq (getpoint "\nChon diem ghi ket qua hoac enter de ghi ket qua vao hang-cot text khac\n"))
 (if (= ptkq nil) 
 (progn
(prompt"\nChon hang-cot text ghi ket qua\n")
(if (setq ss3 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst3 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss3))))
		   '(lambda (x y) (if (equal (car(setq x3 (cdr (assoc 10 x)))) (car(setq y3 (cdr (assoc 10 y)))))
				      (> (cadr x3) (cadr y3))  (< (car x3) (car y3))))))))
(if (/= (sslength ss2) (sslength ss3)) (alert "\nTap hop text ghi ket qua \nthua hoac thieu doi tuong!"))
 );progn
 );if
);progn
);if
;----------------------------------
(command "undo" "be")
(setq angbs (getvar "angbase"))
(setq oldos (getvar "osmode"))
(setq Ladim (getvar "Dimzin"))
(setq olstyle (getvar "textstyle"))
(setq olcol (getvar "CEColor"))
(setvar "Dimzin" 0)
(setq txti 0)

(while (< txti (sslength ss1))
(if (eq ctnc "Cong") (setq kqi (+ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Tru")  (setq kqi (- (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Nhan") (setq kqi (* (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "CHia") (setq kqi (/ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if ptkq
 (progn
 (if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1))))) 
    (- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1)))))) 
 (setq ptkqi (list (car (cdr(assoc 10 (nth txti lst1)))) (cadr ptkq)))
 (setq ptkqi (list (car ptkq) (cadr (cdr(assoc 10 (nth txti lst1)))))))
 (command "textstyle" (cdr(assoc 7 (nth txti lst1))) "osmode" 0 "angbase" 0 "color" 1)
 (command "text" ptkqi (cdr(assoc 40 (nth txti lst1))) (/ (* 180 (cdr(assoc 50 (nth txti lst1)))) pi) (rtos kqi 2 2))
 );progn
 (entmod (subst (cons 1 (rtos kqi 2 2)) (assoc 1 (nth txti lst3)) (nth txti lst3)))
);if
(setq txti (1+ txti))
);while
;----------------------------------
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "Dimzin" Ladim)
(setvar "CECOLOR" olcol) 
(setvar "angbase" angbs)
(setvar "osmode" oldos)
(command "undo" "e")
(setvar "cmdecho" cmd)
(princ)
)

     

    Tiện Bác giúp em viết lisp co yêu cầu như sau ạ:

     

    Khi em lấy bản vẽ mẫu để chỉnh sửa thì các Hatch bản vẽ mẫu không có ASSOCIATIVE nên khi em Stretch co kéo thường phải bỏ Hatch và hach lại. Bác giúp em làm sao để Hatch cũ có chế độ ASSOCIATIVE để Stretch thì Hatch theo luôn ạ !

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

    Cái này mình viết hồi mới tập tọe Lisp, dùng có mấy lần rồi chẳng bao giờ dùng nữa. có thể có những lỗi người viết không lường trước vì hồi đó còn gà. Nếu dùng nó gặp lỗi gì thì thông báo lại để mình sửa.

    ;===========================================================================
(prompt"\nCmd:SRT- [Cong-Tru-Nhan-Chia 2 hang TEXT] by Thaistreetz - huuthais@yahoo.com\n")
;===========================================================================
(defun c:srt (/ cmd ss lst data i lst1 lst2)
(setq ctnc (cond (ctnc) ("Cong")))
(initget "Cong Tru Nhan CHia")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [Cong/Tru/Nhan/CHia/] <" ctnc ">"))) (ctnc)))
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "ucs" "world")
(prompt"\nChon hang-cot text thu nhat\n")
(if (setq ss1 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst1 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
		   '(lambda (x y) (if (equal (car(setq x1 (cdr (assoc 10 x)))) (car(setq y1 (cdr (assoc 10 y)))))
				      (> (cadr x1) (cadr y1)) (< (car x1) (car y1))))))))
(prompt"\nChon hang-cot text thu 2\n")
(if (setq ss2 (ssget (list (cons 0 "TEXT"))))
(if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1))))) 
                (- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1))))))
	(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
                       '(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
                        (> (cadr x2) (cadr y2))  (< (car x2) (car y2))))))
	(setq lst2 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
                       '(lambda (x y) (if (equal (car(setq x2 (cdr (assoc 10 x)))) (car(setq y2 (cdr (assoc 10 y)))))
                        (< (cadr x2) (cadr y2)) (> (car x2) (car y2))))))
	))
(if (/= (sslength ss2) (sslength ss1)) (alert "\n    Hai tap hop text co so \ndoi tuong khong bang nhau!")
(progn
 (setq ptkq (getpoint "\nChon diem ghi ket qua hoac enter de ghi ket qua vao hang-cot text khac\n"))
 (if (= ptkq nil) 
 (progn
(prompt"\nChon hang-cot text ghi ket qua\n")
(if (setq ss3 (ssget (list (cons 0 "TEXT"))))
(progn
(setq lst3 (vl-sort (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss3))))
		   '(lambda (x y) (if (equal (car(setq x3 (cdr (assoc 10 x)))) (car(setq y3 (cdr (assoc 10 y)))))
				      (> (cadr x3) (cadr y3))  (< (car x3) (car y3))))))))
(if (/= (sslength ss2) (sslength ss3)) (alert "\nTap hop text ghi ket qua \nthua hoac thieu doi tuong!"))
 );progn
 );if
);progn
);if
;----------------------------------
(command "undo" "be")
(setq angbs (getvar "angbase"))
(setq oldos (getvar "osmode"))
(setq Ladim (getvar "Dimzin"))
(setq olstyle (getvar "textstyle"))
(setq olcol (getvar "CEColor"))
(setvar "Dimzin" 0)
(setq txti 0)

(while (< txti (sslength ss1))
(if (eq ctnc "Cong") (setq kqi (+ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Tru")  (setq kqi (- (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "Nhan") (setq kqi (* (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if (eq ctnc "CHia") (setq kqi (/ (atof (cdr(assoc 1 (nth txti lst1)))) (atof (cdr(assoc 1 (nth txti lst2)))))))
(if ptkq
 (progn
 (if (< (- (cadr (cdr(assoc 10 (nth 0 lst1)))) (cadr (cdr(assoc 10 (nth 1 lst1))))) 
    (- (car (cdr(assoc 10 (nth 1 lst1)))) (car (cdr(assoc 10 (nth 0 lst1)))))) 
 (setq ptkqi (list (car (cdr(assoc 10 (nth txti lst1)))) (cadr ptkq)))
 (setq ptkqi (list (car ptkq) (cadr (cdr(assoc 10 (nth txti lst1)))))))
 (command "textstyle" (cdr(assoc 7 (nth txti lst1))) "osmode" 0 "angbase" 0 "color" 1)
 (command "text" ptkqi (cdr(assoc 40 (nth txti lst1))) (/ (* 180 (cdr(assoc 50 (nth txti lst1)))) pi) (rtos kqi 2 2))
 );progn
 (entmod (subst (cons 1 (rtos kqi 2 2)) (assoc 1 (nth txti lst3)) (nth txti lst3)))
);if
(setq txti (1+ txti))
);while
;----------------------------------
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "Dimzin" Ladim)
(setvar "CECOLOR" olcol) 
(setvar "angbase" angbs)
(setvar "osmode" oldos)
(command "undo" "e")
(setvar "cmdecho" cmd)
(princ)
)

     

     

    Hi hi đ­ược rồi ạ ! cảm ơn Mr Thái ! Chúc Bác mạnh khoẻ !

×