namnhim

Tháng 10 1, 2013

tình hình như này, mình coppy giường ở thư viện, dùng xong rồi copy tiếp cái cửa, ctrl V thì nó vẫn ra cái giường, bây giờ phải làm thế nào?

Lý do có thể cái Block giường và cửa trùng tên nên đã copy cái giường sang bản vẽ rồi, giờ muốn copy cái cửa nữa sang bản vẽ thì nó vần hiểu là cái Block giường. bạn thử EXPLODE nó ra và đặt lại tên khác xem có được không.

Tháng 10 1, 2013

Bạn dùng thử cái này xem có đúng ý không. Trước khi quét vùng cần Boundary thì cần tắt bớt 1 số Layer đối tượng bên trong thửa như là nhà hoặc ao và chỉ để đối tượng là thửa đất thôi nhé!

(defun c:BN (/ boun_lst cnt i ov sec ss time vl)
(command "-layer" "n" "BOUNDARY" "l" "CONTINUOUS" "BOUNDARY" "c" 4 "BOUNDARY" "")
   (command "-layer" "s" "BOUNDARY" "")
  (vl-load-com)
  (command "_.undo" "_begin")  
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (setq vl '("DELOBJ" "CMDECHO") ; Sys Var list
	    ov (mapcar 'getvar vl))  ; Get Old values
      (setq time (getvar "millisecs"))
      (mapcar 'setvar vl '( 1 0))
      (setq ss (break_SSLine ss))
      (command "region" ss "")
      (if (setq ss (ssget "x" '((0 . "region"))))
	(progn
	  (setq i 0)
	  (while (< i (sslength ss))
	    (if (> (sslength ss) 50)
	      (princ (strcat "Objects Convert " (itoa i) "\r"))  )
	    (command "explode" (ssname ss i))
	    (command "pedit" "l" "" "j" (ssget "p") "" "")
	    (setq boun_lst (cons (entlast) boun_lst))
	    (setq i (1+ i))    )
	  (setq boun_lst(moveAreaMax boun_lst))
	  (setq sec (/ (- (getvar "MILLISECS") time) 1000.0)  )
	  (if (>(setq cnt (length boun_lst))0)
	    (princ (strcat "\nTao duoc " (itoa cnt)
			   " duong bao voi Th/gian = "(rtos sec 2 2) " s."))
	    (princ (strcat "\nSorry! Khong tao duoc duong bao!")))  ))
      (mapcar 'setvar vl ov)))
  (command "_.undo" "_end")
  (princ))

(defun moveAreaMax (lst / area otmp tmp)
  (setq	tmp 0
	otmp nil)
  (foreach e lst
    (if (> (setq area (vla-get-area (vlax-ename->vla-object e))) tmp)
      (setq tmp area
	    otmp e)) )
  (if otmp
    (progn
      (entdel otmp)
      (vl-remove otmp lst)  )  ))

(defun break_SSLine (ss / ds ent intpts lastentindatabase lst masterlist oc sslst)
  (defun ssget->vla-list (ss / i ename allobj)
    (setq i -1)
    (while (setq  ename (ssname ss (setq i (1+ i))))
      (setq allobj (cons (vlax-ename->vla-object ename) allobj))       )
    allobj  )

  (defun list->3pair (old / new)
    (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
                 old (cdddr old)))
    (reverse new)  )
  
  (defun get_interpts (obj1 obj2 / iplist)
    (if (not (vl-catch-all-error-p
	       (setq iplist (vl-catch-all-apply
                            'vlax-safearray->list
                            (list
                              (vlax-variant-value
                                (vla-intersectwith obj1 obj2 acextendnone) ))))))
    iplist  ))
  
;;====================================
;;  CAB - get last entity in datatbase
(defun GetLastEnt ( / ename result )
  (if (setq result (entlast))
    (while (setq ename (entnext result))
      (setq result ename)    )  )
  result)

(defun GetNewSS (ename / new)
  (setq new (ssadd))
  (cond
    ((null ename) (alert "Ename nil"))
    ((eq 'ENAME (type ename))
      (while (setq ename (entnext ename))
        (if (entget ename) (ssadd ename new)) )    )
    ((alert "Ename wrong type."))  )
  new)

(defun break_line (ent brkptlst / pt1 pt2  x)
  (if brkptlst
    (progn
      (setq brkptlst (mapcar '(lambda(x) (list x (vlax-curve-getdistatparam ent
						   ;; ver 2.0 fix
						   (cond ((vlax-curve-getparamatpoint ent x))
							 ((vlax-curve-getparamatpoint ent
							    (vlax-curve-getclosestpointto ent x))))))
				) brkptlst))
      ;; sort primary list on distance
      (setq brkptlst (vl-sort brkptlst '(lambda (a1 a2) (< (cadr a1) (cadr a2)))))
      (setq pt1 (car(car brkptlst)))
      (foreach e (cdr brkptlst)
	(setq pt2 (car e))
	(entmake (list '(0 . "LINE")(cons 10 pt1)(cons 11 pt2) ))
	(setq pt1 pt2)
	(and *BrkVerbose* (princ (setq *brkcnt* (1+ *brkcnt*))) (princ "\r"))	)      ) ))
  
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ;;         S T A R T  S U B R O U T I N E   H E R E              
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  (setq LastEntInDatabase (GetLastEnt))
  (if ss
    (progn
      (setq oc 0
            ssLst (ssget->vla-list ss))
      (if (> (length ssLst) 22) (setq *BrkVerbose* t) )
      (and *BrkVerbose*
	   (princ (strcat "Objects to be Checked: "
			  (rtos (* 0.5(length ssLst)(length ssLst))2 0) "\n")))
      ;;  CREATE a list of entity & it's break points
      (foreach obj ssLst
        (setq lst nil)
	;; check for break pts with other objects in ss2brkwith
	(foreach intobj (vl-remove obj ssLst)
	  (if (and (not (equal obj intobj))
		   (setq intpts (get_interpts obj intobj)))
	    (setq lst (append (list->3pair intpts) lst)) )  )
	(if lst
	  (setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist)) ) )
      
      (and *BrkVerbose* (princ "\nBreaking Objects.\n"))
      (setq *brkcnt* 0) ; break counter
      (if masterlist
        (foreach obj2brk masterlist
          (break_line (car obj2brk) (cdr obj2brk)) ) ) ) )
;;==============================================================
   (and (zerop *brkcnt*) (princ "\nNone to be broken."))
   (setq *BrkVerbose* nil)
  (GetNewSS LastEntInDatabase) ; return list of enames of new objects
)

Tháng 7 15, 2013

Bạn dùng cái này xem có đúng ý không

(defun c:lktd ( )
(command "undo" "be")
  (if (null dolora)(setq dolora "4"))
(Setq temp T)
(While temp
(setq a (strcat "\nKhoang cach dim hien hanh la (" dolora ") /<Diem dau tien>: "))
(Initget "k K")
(setq str (getpoint a))
(Cond
  ((= str "k") (setq dolora (getstring (strcat"\nKhoang cach dim voi line <" dolora "> :"))))
  ((= str "K") (setq dolora (getstring (strcat"\nKhoang cach dim voi line <" dolora "> :"))))
   (Progn
  (Setq a str)
   (setq temp nil)
  )
)
)
 
(setq b (getpoint a"\nChon diem tiep theo: "))
(setq luubatdiem (getvar "osmode"))
  (setvar "osmode" 0)
 (setq doclora (atof dolora))
 (setq gocxeo(angle a B))
 (setq daiab (distance a B))
 (setq c (polar a gocxeo (/ daiab 2)))
 (setq d (polar c (+ gocxeo (/ pi 2)) doclora))
(command "DIMALIGNED" a b d)
(cond
((> gocxeo (/ pi 2)) (command ".rotate" "last" "" c 180))
)
(setvar "osmode" luubatdiem)
(command "undo" "end")
 (Princ)
)

Tháng 4 11, 2013

cảm ơn anh đã có lời khuyên, thực sự là em cũng rất muốn học nếu có thời gian và nhất định trong thời gian tới em sẽ tham ra!

- anh ơi, đoạn này nó có vấn đề gì không mà em load lên nó báo lỗi này ; error: malformed string on input anh ạ:

"r" (/ (* 180 (angle (setq p3 (getpoint "\n Nhap diem dau tren pline tim duong")) (setq p4 (getpoint p3 "\n Nhap diem dinh huong thu hai tren pline tim duong)))) pi)

Tháng 4 10, 2013

vấn đề đã được giải quyết đơn giản và hiệu quả hơn rồi anh ạ,

có 1 chút nữa em muốn hỏi "r" 50 thì ok, nhưng muốn R quay theo mình chọn như dòng nhắc "nhap diem goc tren ben trai cua dong text" => "nhap diem goc duoi ben phai dong text" thì không được anh nhỉ

anh ơi, nếu bỏ góc quay "R" 50 mà chỉ để "R" và pick điểm đầu và cuối của của đoạn thẳng làm hướng cho text song song được không

Tháng 4 10, 2013

vấn đề đã được giải quyết đơn giản và hiệu quả hơn rồi anh ạ,

có 1 chút nữa em muốn hỏi "r" 50 thì ok, nhưng muốn R quay theo mình chọn như dòng nhắc "nhap diem goc tren ben trai cua dong text" => "nhap diem goc duoi ben phai dong text" thì không được anh nhỉ

Tháng 4 10, 2013

Có lẽ là rất khó có thể làm được rồi!

vậy có lẽ phải làm thêm thao tác gọi Text nhưng nhờ các anh thêm và sửa giúp em:

- Đoạn hỏi ở đây thì mặc định là R không hỏi lại:

Specify opposite corner or [Height/Justify/Line spacing/Rotation/Style/Width]: R

- Đến đoạn nhập Mtext: ..... thì phải Enter 2 lần, sửa như thế nào để Enter 1 lần là được(đoạn nhập Text mình có thể viết sẵn 1 đoạn text bất kỳ được không các anh nhỉ?)

(DEFUN C:TD5()
(setvar "CMDECHO" 0.000)
(prompt "\nChon cac duong muon chuyen: ")
   (setq tl (getvar "textstyle"))
   (COMMAND "-LAYER" "m" "Tim duong" "color" 3 "" "")(PRINC)
   (SETQ A (SSGET))
   (COMMAND"CHPROP" A PAUSE "c" "3" "la" "Tim duong" "lt" "acad_iso10w100" "s" "0.15" "")(princ)
   (command "-style" "TEXT" "Times New Roman" "1.1" "1" "0" "n" "n" )
   (command "-layer" "m" "Text""c" "White" "" "")
(command "-Mtext") (princ))

Tháng 4 9, 2013

các bác ơi, giúp em với :(

Tháng 4 8, 2013

[Yêu cầu] nhờ sửa thêm phần gọi Block text và cho nó song song đoạn thẳng

em xin lỗi vì giải thích không rõ ràng!

* mục đích cuối cùng của em là khi em vẽ được tim đường rồi, giờ em muốn dùng 1 lệnh để vừa chuyển layer + chuyển nét tim đường (vấn đề này đã thực hiện được rồi) chỉ có phần nhập tên đường thì đã có cho chữ chạy song song với đoạn thẳng nhưng vì nó là nhập dưới dòng command nên em không thực hiện được với kiểu Unicode phông Times New Roman. bởi vậy em muốn có cách nào đó để thêm vào lisp TD5 phần gọi 1 Mtext được tạo sẵn để khi thực hiện các bước chuyển layer + chuyển nét tim đường xong => sẽ gọi 1 text cho nó song song và có thể sửa được vidu như Mtext!

cảm ơn anh về sự giúp đỡ nhiệt tình của anh!

Tháng 4 8, 2013

cảm ơn anh, cái lisp trên chạy tốt anh ạ, nhưng nó chỉ chạy với điều kiện riêng để gọi block, sửa text và quay chữ thôi, còn phần chuyển layer và nét tim đường thì phải làm riêng! anh có thể bổ sung giúp em cái phần của anh vào cái lisp này được không ạ!

(DEFUN C:TD5(/ cnt enam ent pnt s1 tot v1 val)(setvar "CMDECHO" 0.000)
(prompt "\nChon cac duong muon chuyen: ")
   (setq tl (getvar "textstyle"))
   (COMMAND "-LAYER" "m" "Tim duong" "color" 3 "" "")(PRINC)
   (SETQ A (SSGET))
   ("CHPROP" A PAUSE "c" "3" "la" "Tim duong" "lt" "acad_iso10w100" "s" "0.15" "")(princ)
   (command "insert" "D:\\Dowload\\62465_ten_duong.dwg" (getpoint "\n Chon diem bat ky tren ban ve") 1 1 0)
  (command "textstyle" tl)(princ))

Tháng 4 7, 2013

dạ, cảm ơn anh!

http://www.cadviet.com/upfiles/3/62465_ten_duong.dwg

Tháng 4 7, 2013

namnhim, on 04 Apr 2013 - 12:22, said:

các bác ơi cho em hỏi 1 tí, nếu dùng cái lisp này muốn cho thêm đoạn gọi 1 Mtext được tạo sẵn trong support để:

- khi gõ lệnh => chọn đoạn thẳng => chọn điểm đầu và điểm cuối => hiện lên cái Mtext mẫu có sẵn đó song song với đoạn thẳng và lúc đó ta có thể sửa tên đường tùy ý được không các bác nhỉ?

==================================

- Ý của em là muốn sau khi thực hiện TD5 thì nó chuyển Layer và nét tim đường thì được rồi còn phần nhập tên đường vì nó dùng cho nhập dưới dòng commond nên không nhập được chữ có dấu với font Unicode, bởi vậy em muốn nó thêm chức năng gọi 1 file Text được tạo sẵn và lưu trong support ra để song song với tim đường rồi ta sửa tên đường thôi!

- lisp của anh Binh em dùng được với điều kiện nó đã có chữ sẵn trong bản vẽ rồi, còn bản vẽ mới chưa có chữ thì không dùng được anh ạ! cảm ơn anh. anh có thể giúp em thêm cái phần nội dung màu đỏ ở trên không ạ?

Tháng 4 7, 2013

các bác ơi cho em hỏi 1 tí, nếu dùng cái lisp này muốn cho thêm đoạn gọi 1 Mtext được tạo sẵn trong support để:

- khi gõ lệnh => chọn đoạn thẳng => chọn điểm đầu và điểm cuối => hiện lên cái Mtext mẫu có sẵn đó song song với đoạn thẳng và lúc đó ta có thể sửa tên đường tùy ý được không các bác nhỉ?

- Ý của em là muốn sau khi thực hiện TD5 thì nó chuyển Layer và nét tim đường thì được rồi còn phần nhập tên đường vì nó dùng cho nhập dưới dòng commond nên không nhập được chữ có dấu với font Unicode, bởi vậy em muốn nó thêm chức năng gọi 1 file Text được tạo sẵn và lưu trong support ra để song song với tim đường rồi ta sửa tên đường thôi!

- lisp của anh Binh em dùng được với điều kiện nó đã có chữ sẵn trong bản vẽ rồi, còn bản vẽ mới chưa có chữ thì không dùng được anh ạ! cảm ơn anh. anh có thể giúp em thêm cái phần nội dung màu đỏ ở trên không ạ?

Tháng 4 6, 2013

cảm ơn bác bình! em dùng cái của bác nó báo lỗi sau khi "Chon diem xac dinh huong dat text ; error: bad argument type: fixnump: nil "

cái em đang dùng khi thực hiện chọn đường muốn chuyển thì nó chuyển cả layer và nét tim đường luôn nhưng text thì ko ghi được, bởi vậy em muốn gọi 1 mtext được tạo sẵn trong suppor và tự sửa tên đường thôi

Tháng 4 5, 2013

đây là bản vẽ của em, em muốn thực hiện như trên sau khi chọn 2 điểm cần hiện tên đường thí nó sẽ xuất hiện 1 mtext song song với đoạn mình trọn (em muốn mtext vì nó gõ unicode dễ hơn)

http://www.cadviet.com/upfiles/3/62465_text_duong.dwg

Tháng 4 4, 2013

các bác ơi cho em hỏi 1 tí, nếu dùng cái lisp này muốn cho thêm đoạn gọi 1 Mtext được tạo sẵn trong support để:

- khi gõ lệnh => chọn đoạn thẳng => chọn điểm đầu và điểm cuối => hiện lên cái Mtext mẫu có sẵn đó song song với đoạn thẳng và lúc đó ta có thể sửa tên đường tùy ý được không các bác nhỉ?

(DEFUN C:TD5(/ cnt enam ent pnt s1 tot v1 val)(setvar "CMDECHO" 0.000)
(prompt "\nChon cac duong muon chuyen: ")
   (setq tl (getvar "textstyle"))
   (COMMAND "-LAYER" "m" "Tim duong" "color" 3 "" "")(PRINC)
   (SETQ A (SSGET))
   ("CHPROP" A PAUSE "c" "3" "la" "Tim duong" "lt" "acad_iso10w100" "s" "0.15" "")(princ)
   (SETQ B (GETPOINT "CHON DIEM : diem dau  -  "))(PRINC)
   (SETQ C (GETPOINT "CHON DIEM : diem cuoi"))
   (command "-style" "TEXT" "Times New Roman" "1.1" "1" "0" "n" "n" )
   (command "-layer" "m" "Text"" "" "" "")
   (command "text" "j" "bl" B C (strcase(getstring T "NHAP TEN DUONG:   ")))
  (command "textstyle" tl)(princ))

Tháng 4 3, 2013

các bác ơi cho em hỏi 1 tí, nếu dùng cái lisp này muốn cho thêm đoạn gọi 1 Mtext được tạo sẵn trong support để:

- khi gõ lệnh => chọn đoạn thẳng => chọn điểm đầu và điểm cuối => hiện lên cái Mtext có sẵn đó song song với đoạn thẳng và lúc đó ta có thể sửa tên đường tùy ý được không các bác nhỉ?

 (DEFUN C:TD5(/ cnt enam ent pnt s1 tot v1 val)(setvar "CMDECHO" 0.000)
(prompt "\nChon cac duong muon chuyen: ")
   (setq tl (getvar "textstyle"))
   (COMMAND "-LAYER" "m" "Tim duong" "color" 3 "" "")(PRINC)
   (SETQ A (SSGET))
   (COMMAND"CHPROP" A PAUSE "c" "3" "la" "Tim duong" "lt" "acad_iso10w100" "s" "0.15" "")(princ)
   (SETQ B (GETPOINT "CHON DIEM : diem dau  -  "))(PRINC)
   (SETQ C (GETPOINT "CHON DIEM : diem cuoi"))
   (command "-style" "TEXT" "Times New Roman" "1.1" "1" "0" "n" "n" )
   (command "-layer" "m" "Text""c" "White" "" "")
   (command "text" "j" "bl" B C (strcase(getstring T "NHAP TEN DUONG:   ")))
  (command "textstyle" tl)(princ))

Tháng 12 11, 2012

trường hợp cả đường PLine làm dao cắt và các PLine bị cắt đều là Pline gấp khúc anh ạ!

Tháng 12 11, 2012

Lisp Trim 2n Lines này bởi 2m Lines khác, mà các Lines này song song với trục X và Y.

(defun C:HA( / ssd ssb layo lay lst3 lst4 pd pc p i)
;Doan Van Ha - CADViet.com - Ngay 10/12/2012
;Chuc nang: Trim 2n Lines boi 2m Lines khac. Cac Lines nay // voi truc X va Y.
(vl-load-com) (command "undo" "be") (setq layo (getvar "clayer"))
(if
 (and
  (princ "\nChon cac Line lam dao cat...")
  (setq ssd (ssget '((0 . "Line"))))
  (princ "\nChon cac Line bi cat...")
  (setq ssb (ssget '((0 . "Line")))))
 (progn
  (foreach ent1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssb)))
   (setq lay (cdr (assoc 8 (entget ent1))))
   (setq lst3 (list (setq pd (cdr (assoc 10 (entget ent1)))) (setq pc (cdr (assoc 11 (entget ent1))))))
   (foreach ent2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssd)))
(if (setq p (car (acet-geom-intersectwith ent1 ent2 0)))
     (setq lst3 (cons p lst3))))
   (if (equal (cadr pd) (cadr pc) 1E-8)
(setq lst4 (cons (list lay (vl-sort lst3 '(lambda (p1 p2) (> (car p1) (car p2))))) lst4))
(setq lst4 (cons (list lay (vl-sort lst3 '(lambda (p1 p2) (> (cadr p1) (cadr p2))))) lst4)))
   (vla-delete (vlax-ename->vla-object ent1)))
  (foreach lst (reverse lst4)
   (setq i 0)
   (repeat (/ (length (cadr lst)) 2)
(setvar "clayer" (car lst))
(entmake (list (cons 0 "LINE") (cons 10 (nth i (cadr lst))) (cons 11 (nth (1+ i) (cadr lst)))))
(setq i (+ i 2))))))
(setvar "clayer" layo) (command "undo" "end") (princ))

bác có thể thê m cắt được cả đối tượng là Pline được không ạ!

Tháng 10 1, 2012

các anh giúp em tạo Linetype dạng này với:

cảm ơn các anh rất nhiều!

Tháng 9 16, 2012

oh, cảm ơn anh rất nhanh và nhiệt tình. em đã làm được rồi. chúc anh ngủ ngon!

Tháng 9 16, 2012

cảm ơn anh Tue, e làm được rồi. còn đoạn này làm sao nó lại báo: CHON GOC TRAI-DUOI BAN VEUnknown command "CG". Press F1 for help.

Tháng 9 16, 2012

Nhờ các bác sửa giúp em code dưới đây, để khi gọi lệnh CG thì phần hiển thị nội dung ở dòng command dưới màn hình không hiển thị phần phần đánh dấu màu đỏ bên dưới đây:

Command: CG

CHON GOC TRAI-DUOI BAN VEUnknown command "CG". Press F1 for help. (chỗ này nó báo lỗi gì vậy nhỉ?)

Unknown command "N". Press F1 for help.