Đến nội dung


Hình ảnh
* * * - - 17 Bình chọn

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)


  • Please log in to reply
2851 replies to this topic

#2101 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 27 October 2014 - 03:35 PM

Nhoclangbat nên nghiên cứu cái khác đi, cái có rồi thì nghiên cứu chi cho mệt.

Hay nhoclangbat đang tập tành viết cho quen tay?

Rảnh ghê. ^^

- đúng rùi anh, nhoc đang tập viết cho quen tay rèn khả năng tư duy luôn thể, có rùi nhưng mình ko thấy nguồn, nhìn nó chạy viết lại đc cũng zui zui ^^, có gì lấy ra xài độc lập ko sợ bị phụ thuộc, ràng buộc của chương trình tổng ^^.

- nói chung công cụ cơ quan đã cung cấp đủ, mình nhìn mà viết lại đc gần hết cũng ko phải dễ ^^, viết lại đc tay nghề cũng lên đc kha khá kaka


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#2102 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 27 October 2014 - 03:47 PM

- đúng rùi anh, nhoc đang tập viết cho quen tay rèn khả năng tư duy luôn thể, có rùi nhưng mình ko thấy nguồn, nhìn nó chạy viết lại đc cũng zui zui ^^, có gì lấy ra xài độc lập ko sợ bị phụ thuộc, ràng buộc của chương trình tổng ^^.

- nói chung công cụ cơ quan đã cung cấp đủ, mình nhìn mà viết lại đc gần hết cũng ko phải dễ ^^, viết lại đc tay nghề cũng lên đc kha khá kaka

Uhm, em cứ tập cho quen tay. Viết cái con con trước. Sau đó đặt mục tiêu 1 sản phẩm to to 1 chút. Nếu không làm dc thì cũng sẽ đạt được 1 số bài toán nhỏ. Khi đó trình cứ dần dần lên.

Anh không biết 1 tí gì về Autolisp luôn, nhưng cứ vọc dần dần, được bác Phamthanhbinh, Ketxu, anh Gia_Bach, anh Tot77, anh Nguyễn Hoành, anh Tue_NV, bác Doan Van Ha......mà anh vọc được cũng tương đối. Vì thời gian nghiên cứu có hạn, phải đi kiếm miếng cơm nên học chỉ là tranh thủ.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2103 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 27 October 2014 - 03:55 PM

Trao đổi bằng tin nhắn để khỏi phiền người khác khỏi đụng đến riêng tư của mình.


  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#2104 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 27 October 2014 - 04:41 PM

Trao đổi bằng tin nhắn để khỏi phiền người khác khỏi đụng đến riêng tư của mình.

Em xin lỗi. Cảm ơn bác Doan Van Ha góp ý.

Vậy em nhờ Mod xóa dùm em với ạ. Em không được xóa sao ý.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2105 zed1987

zed1987

    biết pan

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

Đã gửi 27 October 2014 - 08:06 PM

   nhờ các cao thủ sửa lips giúp đỡ: e có 2 cái lips tính diện tích hình học,và 1 cái tính diện tích sai số nhưng cả 2 cái khi load lên sử dụng thì chỉ pick chọn được từng miền chứ ko pick chọn dc nhiều miền ,e muốn nhờ các cao thủ sửa jup em ,cho lúc sử dụng thì tính diện tích pick chọn duoc nhieu mien e ko biet up t up five ai quan tam thi de lai dc gmail e gui wa ,e cảm on

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...?showtopic=9910
;;;Tinh dien tich
;;;
 
(defun C:ae (/ P1 dtich dtich1 ss1 ss2 ss3 lacol)
 
  (command "UCS" "W" "")
  (command "Undo" "Mark")
  (setq lacol (getvar "CEColor"))
  (setq oldos (getvar "OsMODE"))
  (setvar "OSMODE" 0)
;(setvar "CECOLOR" 1)
  (command "CECOLOR" 1)
  
  (setq P1 (getpoint "\n Chi diem trong vung tinh dien tich"))
  (command "boundary" P1 "")
  (setq ss1 (ssget "L")
ss2 (ssadd)
ss2 (ssadd (ssname ss1 0) ss2)
ent (ssname ss1 0)
  )
  
  (command "area" "o" "l")
 
  (setq dtich (getvar "Area"))
 
  (setq P1 (getpoint "\n Chi diem tiep theo ..."))
  (while (/= P1 nil)
(command "boundary" P1 "")
(setq ss1 (ssget "L")
 ss2 (ssadd (ssname ss1 0) ss2)
 ent (ssname ss1 0)
)
(command "area" "o" "l")
(setq dtich1 (getvar "Area")
 dtich (+ dtich dtich1)
)
(setq P1 (getpoint "\n Chi diem tiep theo ..."))
  )
 
  (setq ss3 (chonchu "\nChon text chua kq dien tich..."))
  (if (/= ss3 nil)
(progn
 (setq ob (bocdt ss3 0))
 (setq st (sothanhchuintreal dtich))
 
 (thaychu ob st)
)
  )
  (command "erase" ss2 "")
  (setvar "OSMODE" OldOS)
  (command "CECOLOR" lacol)
)
 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...?showtopic=9910
;;;Tinh dien tich
;;;
 
(defun C:ae (/ P1 dtich dtich1 ss1 ss2 ss3 lacol)
 
  (command "UCS" "W" "")
  (command "Undo" "Mark")
  (setq lacol (getvar "CEColor"))
  (setq oldos (getvar "OsMODE"))
  (setvar "OSMODE" 0)
;(setvar "CECOLOR" 1)
  (command "CECOLOR" 1)
  
  (setq P1 (getpoint "\n Chi diem trong vung tinh dien tich"))
  (command "boundary" P1 "")
  (setq ss1 (ssget "L")
ss2 (ssadd)
ss2 (ssadd (ssname ss1 0) ss2)
ent (ssname ss1 0)
  )
  
  (command "area" "o" "l")
 
  (setq dtich (getvar "Area"))
 
  (setq P1 (getpoint "\n Chi diem tiep theo ..."))
  (while (/= P1 nil)
(command "boundary" P1 "")
(setq ss1 (ssget "L")
 ss2 (ssadd (ssname ss1 0) ss2)
 ent (ssname ss1 0)
)
(command "area" "o" "l")
(setq dtich1 (getvar "Area")
 dtich (+ dtich dtich1)
)
(setq P1 (getpoint "\n Chi diem tiep theo ..."))
  )
 
  (setq ss3 (chonchu "\nChon text chua kq dien tich..."))
  (if (/= ss3 nil)
(progn
 (setq ob (bocdt ss3 0))
 (setq st (sothanhchuintreal dtich))
 
 (thaychu ob st)
)
  )
  (command "erase" ss2 "")
  (setvar "OSMODE" OldOS)
  (command "CECOLOR" lacol)
)
 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...?showtopic=9910
;;;Tinh dien tich
;;;
 
(defun C:ae (/ P1 dtich dtich1 ss1 ss2 ss3 lacol)
 
  (command "UCS" "W" "")
  (command "Undo" "Mark")
  (setq lacol (getvar "CEColor"))
  (setq oldos (getvar "OsMODE"))
  (setvar "OSMODE" 0)
;(setvar "CECOLOR" 1)
  (command "CECOLOR" 1)
  
  (setq P1 (getpoint "\n Chi diem trong vung tinh dien tich"))
  (command "boundary" P1 "")
  (setq ss1 (ssget "L")
ss2 (ssadd)
ss2 (ssadd (ssname ss1 0) ss2)
ent (ssname ss1 0)
  )
  
  (command "area" "o" "l")
 
  (setq dtich (getvar "Area"))
 
  (setq P1 (getpoint "\n Chi diem tiep theo ..."))
  (while (/= P1 nil)
(command "boundary" P1 "")
(setq ss1 (ssget "L")
 ss2 (ssadd (ssname ss1 0) ss2)
 ent (ssname ss1 0)
)
(command "area" "o" "l")
(setq dtich1 (getvar "Area")
 dtich (+ dtich dtich1)
)
(setq P1 (getpoint "\n Chi diem tiep theo ..."))
  )
 
  (setq ss3 (chonchu "\nChon text chua kq dien tich..."))
  (if (/= ss3 nil)
(progn
 (setq ob (bocdt ss3 0))
 (setq st (sothanhchuintreal dtich))
 
 (thaychu ob st)
)
  )
  (command "erase" ss2 "")
  (setvar "OSMODE" OldOS)
  (command "CECOLOR" lacol)
)
 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...?showtopic=9910
;;;Tinh dien tich
;;;
 
(defun C:ae (/ P1 dtich dtich1 ss1 ss2 ss3 lacol)
 
  (command "UCS" "W" "")
  (command "Undo" "Mark")
  (setq lacol (getvar "CEColor"))
  (setq oldos (getvar "OsMODE"))
  (setvar "OSMODE" 0)
;(setvar "CECOLOR" 1)
  (command "CECOLOR" 1)
  
  (setq P1 (getpoint "\n Chi diem trong vung tinh dien tich"))
  (command "boundary" P1 "")
  (setq ss1 (ssget "L")
ss2 (ssadd)
ss2 (ssadd (ssname ss1 0) ss2)
ent (ssname ss1 0)
  )
  
  (command "area" "o" "l")
 
  (setq dtich (getvar "Area"))
 
  (setq P1 (getpoint "\n Chi diem tiep theo ..."))
  (while (/= P1 nil)
(command "boundary" P1 "")
(setq ss1 (ssget "L")
 ss2 (ssadd (ssname ss1 0) ss2)
 ent (ssname ss1 0)
)
(command "area" "o" "l")
(setq dtich1 (getvar "Area")
 dtich (+ dtich dtich1)
)
(setq P1 (getpoint "\n Chi diem tiep theo ..."))
  )
 
  (setq ss3 (chonchu "\nChon text chua kq dien tich..."))
  (if (/= ss3 nil)
(progn
 (setq ob (bocdt ss3 0))
 (setq st (sothanhchuintreal dtich))
 
 (thaychu ob st)
)
  )
  (command "erase" ss2 "")
  (setvar "OSMODE" OldOS)
  (command "CECOLOR" lacol)
)
 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...?showtopic=9910
;;;Tinh dien tich
;;;
 
(defun C:ae (/ P1 dtich dtich1 ss1 ss2 ss3 lacol)
 
  (command "UCS" "W" "")
  (command "Undo" "Mark")
  (setq lacol (getvar "CEColor"))
  (setq oldos (getvar "OsMODE"))
  (setvar "OSMODE" 0)
;(setvar "CECOLOR" 1)
  (command "CECOLOR" 1)
  
  (setq P1 (getpoint "\n Chi diem trong vung tinh dien tich"))
  (command "boundary" P1 "")
  (setq ss1 (ssget "L")
ss2 (ssadd)
ss2 (ssadd (ssname ss1 0) ss2)
ent (ssname ss1 0)
  )
  
  (command "area" "o" "l")
 
  (setq dtich (getvar "Area"))
 
  (setq P1 (getpoint "\n Chi diem tiep theo ..."))
  (while (/= P1 nil)
(command "boundary" P1 "")
(setq ss1 (ssget "L")
 ss2 (ssadd (ssname ss1 0) ss2)
 ent (ssname ss1 0)
)
(command "area" "o" "l")
(setq dtich1 (getvar "Area")
 dtich (+ dtich dtich1)
)
(setq P1 (getpoint "\n Chi diem tiep theo ..."))
  )
 
  (setq ss3 (chonchu "\nChon text chua kq dien tich..."))
  (if (/= ss3 nil)
(progn
 (setq ob (bocdt ss3 0))
 (setq st (sothanhchuintreal dtich))
 
 (thaychu ob st)
)
  )
  (command "erase" ss2 "")
  (setvar "OSMODE" OldOS)
  (command "CECOLOR" lacol)
)
 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...?showtopic=9910
;;;Tinh dien tich
;;;
 
(defun C:ae (/ P1 dtich dtich1 ss1 ss2 ss3 lacol)
 
  (command "UCS" "W" "")
  (command "Undo" "Mark")
  (setq lacol (getvar "CEColor"))
  (setq oldos (getvar "OsMODE"))
  (setvar "OSMODE" 0)
;(setvar "CECOLOR" 1)
  (command "CECOLOR" 1)
  
  (setq P1 (getpoint "\n Chi diem trong vung tinh dien tich"))
  (command "boundary" P1 "")
  (setq ss1 (ssget "L")
ss2 (ssadd)
ss2 (ssadd (ssname ss1 0) ss2)
ent (ssname ss1 0)
  )
  
  (command "area" "o" "l")
 
  (setq dtich (getvar "Area"))
 
  (setq P1 (getpoint "\n Chi diem tiep theo ..."))
  (while (/= P1 nil)
(command "boundary" P1 "")
(setq ss1 (ssget "L")
 ss2 (ssadd (ssname ss1 0) ss2)
 ent (ssname ss1 0)
)
(command "area" "o" "l")
(setq dtich1 (getvar "Area")
 dtich (+ dtich dtich1)
)
(setq P1 (getpoint "\n Chi diem tiep theo ..."))
  )
 
  (setq ss3 (chonchu "\nChon text chua kq dien tich..."))
  (if (/= ss3 nil)
(progn
 (setq ob (bocdt ss3 0))
 (setq st (sothanhchuintreal dtich))
 
 (thaychu ob st)
)
  )
  (command "erase" ss2 "")
  (setvar "OSMODE" OldOS)
  (command "CECOLOR" lacol)
)
 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...?showtopic=9910
;;;Tinh dien tich
;;;
 
(defun C:ae (/ P1 dtich dtich1 ss1 ss2 ss3 lacol)
 
  (command "UCS" "W" "")
  (command "Undo" "Mark")
  (setq lacol (getvar "CEColor"))
  (setq oldos (getvar "OsMODE"))
  (setvar "OSMODE" 0)
;(setvar "CECOLOR" 1)
  (command "CECOLOR" 1)
  
  (setq P1 (getpoint "\n Chi diem trong vung tinh dien tich"))
  (command "boundary" P1 "")
  (setq ss1 (ssget "L")
ss2 (ssadd)
ss2 (ssadd (ssname ss1 0) ss2)
ent (ssname ss1 0)
  )
  
  (command "area" "o" "l")
 
  (setq dtich (getvar "Area"))
 
  (setq P1 (getpoint "\n Chi diem tiep theo ..."))
  (while (/= P1 nil)
(command "boundary" P1 "")
(setq ss1 (ssget "L")
 ss2 (ssadd (ssname ss1 0) ss2)
 ent (ssname ss1 0)
)
(command "area" "o" "l")
(setq dtich1 (getvar "Area")
 dtich (+ dtich dtich1)
)
(setq P1 (getpoint "\n Chi diem tiep theo ..."))
  )
 
  (setq ss3 (chonchu "\nChon text chua kq dien tich..."))
  (if (/= ss3 nil)
(progn
 (setq ob (bocdt ss3 0))
 (setq st (sothanhchuintreal dtich))
 
 (thaychu ob st)
)
  )
  (command "erase" ss2 "")
  (setvar "OSMODE" OldOS)
  (command "CECOLOR" lacol)
)

  • 0

#2106 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 27 October 2014 - 09:13 PM

Bạn thử với LISP này xem. ^^

(defun c:tdt( / ss lst fn fid lstEn)
(vl-load-com)
(setvar "hpgaptol" 0.5)
(setq Olmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq Elast (entlast))
(setq Clor (getvar "CECOLOR"))
(setvar "CECOLOR" "2")
(while
	(setq pt (getpoint "\n Pick diem trong vung kin :"))
	(vl-cmdf  "-boundary" pt "")
)
(while
          (setq Elast  (entnext Elast ))
	  (setq lstEn (reverse (cons Elast lstEn)))
)
(setq h (LM:GetXWithDefault getreal "\nNhap chieu cao chu: " '*h* (atof "1")))
(foreach e lstEn
  (entmake (list (cons 0 "TEXT") (cons 10 (mid e)) (cons 40  h) (cons 1  (rtos (Area e) 2 2))))
  (entdel e)
)
(setvar "CECOLOR" Clor)
(setvar "OSMODE" 193)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dtd( / ss lst fn fid lstEn);Do dien tich
(vl-load-com)
(setvar "hpgaptol" 0.5)
(setq Olmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq Elast (entlast))
(setq Clor (getvar "CECOLOR"))
(setvar "CECOLOR" "2")
(setq ss (ssget (list (cons 0  "TEXT"))))
  (progn
      (setq ss (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss))))
      (foreach item ss
	   (setq temp  (entget item))
	   (setq   Tdo (TD:Text-Base item ))
	   (setq     h (cdr (assoc 40 temp)))
	   (setq   Pnt   (list (car Tdo) (cadr Tdo)))
	   (vl-cmdf  "-boundary" Pnt "")
	   (setq Elast (entlast))
	   (setq Dtich (rtos (Area Elast) 2 2))
           (setq Poin (polar Pnt  (/ (* 3 pi) 2) (* 2 h)))
;;;	   (entmake (list (cons 0 "TEXT") (cons 10 (mid Elast)) (cons 40  h) (cons 1  Dtich)))
	   (entmake (list (cons 0 "TEXT") (cons 10 Poin) (cons 40  h) (cons 1  Dtich)))
      )
     )
(setvar "CECOLOR" Clor)
(setvar "OSMODE" 193)
(princ)
)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Area (ent)
(setvar "hpgaptol" 0.1)
(vla-get-area (vlax-ename->vla-object ent))
)
(defun mid (ent / p1 p2)
	(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
	(setq p1 (vlax-safearray->list p1)
				p2 (vlax-safearray->list p2)
				pt (mapcar '+ p1 p2)
				pt (mapcar '* pt '(0.5 0.5 0.5))
	)
	pt
)
(defun wtxt_l(txt p / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq    sty (getvar "textstyle")    
d (tblsearch "style" sty)    
h1 (cdr (assoc 40 d))    
h2 (cdr (assoc 42 d))    
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p)(cons 62 4) (cons 1 txt) (cons 10 p)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun TD:Text-Base (ent)
  (setq Ma10  (cdr (assoc 10 (entget ent))))
  (setq Ma11  (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71  (cdr (assoc 71 (entget ent))))
  (setq Ma72  (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3) )
	  (and (= Ma71 0) (= Ma72 5) )
      )
    Ma10
    Ma11
   )
)


(defun LM:GetXWithDefault ( _function _prompt _symbol _default / _toString )
	(setq _toString
		(lambda ( x )
			(cond
				( (eq getangle _function) (angtos x) )
				( (eq 'REAL (type x)) (rtos x) )
				( (eq 'INT (type x)) (itoa x) )
				( x )
			)
		)
	)

	(set _symbol
	(
	(lambda ( input ) (if (or (not input) (eq "" input)) (eval _symbol) input))
	(_function (strcat _prompt "<" (_toString (set _symbol (cond ( (eval _symbol) ) ( _default )))) "> : "))
	)
	)
)

  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2107 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 31 October 2014 - 08:41 AM

- mấy anh cho nhoc hỏi mình có cách nào có thể tránh đc text với line trùng nhau không nhỉ, lsp chạy tọa độ lúc trước nhoc sửa cũng ok, giờ nhoc mún nó đẹp hơn tí ^^, để khi chạy các text số hiệu không bị trùng lên các line xung quanh ^^

104473_rfdetgbcxdeg.png

- như hình trên các text màu vàng khi chạy sẽ tự động tìm chỗ nào thoáng để đứng ^^, nhưng đừng quá xa mấy điểm donut màu vàng ^^


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#2108 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 31 October 2014 - 08:48 AM

 Cái này không đơn giản đâu nhoc, nó cũng giống bài toán dãn chữ không trùng, dời block không trùng vậy. Thuật toàn là lấy bounding box của text rồi ssget cái window đó xem có bắt cái line nào k, rồi move text cho xa dấn cái line đó cho tới khi không trùng nữa. NÓi thì dễ chứ làm mới khó.

Test thử:

(defun c:gian (/ ss sst ssl ss1 li d1 d2 tm ang eg)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT,*LINE"))))))
sst (vl-remove-if '(lambda (x) (vl-string-search "LINE" (dxf 0 x))) ss)
ssl (vl-remove-if-not '(lambda (x) (vl-string-search "LINE" (dxf 0 x))) ss)
  )
  (foreach v sst   
    (while (and  (not (vla-getBoundingBox (vlax-ename->vla-object v) 'minp 'maxp))
                 (setq li (mapcar 'vlax-safearray->list (list minp maxp))
      ss1 (ssget "C" (car li) (last li) '((0 . "*LINE")))))
      (setq ss1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
   d1 (dxf 10 v)
   tm (car (vl-sort (mapcar '(lambda (x) (list (distance d1 (setq d2 (vlax-curve-getclosestpointto x d1))) d2)) ss1)
'(lambda (x y) (> (car x) (car y)))))     
   ang (angle (last tm) d1)
   eg (entget v))
      (entmod (subst (cons 10 (polar d1 ang (car tm))) (assoc 10 eg) eg))
    )
  )
  (princ)
)

  • 1

#2109 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 31 October 2014 - 12:20 PM

- thanks a Tot77 nhiều nhiều ^^, nhoc cũng đoán là nó khá khó xơi ^^, nhoc test thấy ok lắm a ^^, nhoc chỉ mong như vậy là quá ổn, anh trong cơ quan gơi ý nhoc là mình thử hình dung có 1 tròn xung quanh điểm đó và bao lun cả text, tâm là điểm donut,  sau đó tìm giao điểm các line cắt vòng tròn đó, tìm ra góc lớn nhất hợp bởi tâm đg tròn và các line, góc nào nhỏ bỏ qua, tiếp theo tìm phần giác góc lớn đó, điểm đặt text sẽ nằm trong góc đó, nhoc thấy hay nhưng viết thì chưa nổi ^^, anh Tot77 nghĩ thuật này có dễ viết ko anh, nhoc trình bày hơi dở, úp cái hình ^^

104473_werewwerwerwerwe.png

- cái hình bên trái là lúc text mới tạo ra chưa chình sửa, các line màu trắng kể cả tím là các line cần né, tìm ra đc góc lớn nhất, tạo ra đường phân giác màu xanh, text nằm trên đường đó, kéo ra hoặc thu vào tùy theo chiều cao text, sao cho text ko trùng line 


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#2110 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 31 October 2014 - 04:54 PM

Thuật toán này cũng hay nhưng phải làm nhìu việc hơn, tìm góc lớn nhất, tìm phân giác, kiểm tra trùng ... nhoc nhắm làm dc k
  • 0

#2111 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 31 October 2014 - 05:10 PM

Thuật toán Nhoclangbat đưa ra là khá hay. Theo em nghĩ thì tại mỗi đỉnh ta xét có bao nhiêu Line, sắp xếp các line đó theo góc, tính góc kẹp bởi các Line => tìm dc góc lớn nhất. Từ đó cho cái Textbox di chuyển đến đó và trượt theo góc đó.

Cơ mà cũng khó nếu có line khác không đi qua đỉnh nhưng chạm vào.

Haizzzzz.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2112 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 31 October 2014 - 05:24 PM

Bảo dame là luôn đi qua đỉnh, vì nó là đỉnh thửa đát mà.
  • 0

#2113 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 06 November 2014 - 06:42 PM

Tôi nhớ mang máng là đã đọc nó ở đâu đấy rồi nhưng giờ quên mất, nên hỏi mọi người tí:

Diễn giải:

Khi mở máy, thường màn hình window sẽ gồm 1 toolbar ở dưới. Phần còn lại ở trên dành cho user làm việc khi mở Cad, Word, Excel...

Hỏi: làm sao lấy được size của màn hinh Cad (tức cả màn hình trừ đi thanh toolbar)? Không phải là screensize nhé.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#2114 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 06 November 2014 - 11:03 PM

Có phải thế này :)

127397_hh.png


  • 0

#2115 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 06 November 2014 - 11:04 PM

127397_hhh.png


  • 0

#2116 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 06 November 2014 - 11:14 PM

Đúng là tôi muốn lấy size của hình trên (trừ thanh đậm ở dưới). Lấy bằng lisp, ra kết quả là width và height (đơn vị pixel).


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#2117 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 07 November 2014 - 09:15 AM

Đúng là tôi muốn lấy size của hình trên (trừ thanh đậm ở dưới). Lấy bằng lisp, ra kết quả là width và height (đơn vị pixel).

Không biết cái này có đúng ý bác không ?

 (vl-load-com)
 (setq AcadObj (vlax-get-acad-object))
 (setq width (vlax-get-property AcadObj 'width))
 (setq height (vlax-get-property AcadObj 'height)) 

  • 1

#2118 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 07 November 2014 - 09:37 AM

H thì có vẽ hợp lý. Nhưng W thì sao hơi kỳ kỳ.

Máy của tôi:

- Kích thước Resolution là (1366 768): lấy bằng chuột phải >> Screen Resolution.

- Kích thước lấy theo lisp trên là (1382 744).

Chẳng lẻ màn hình Cad rộng hơn (1382>1366)?


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#2119 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 07 November 2014 - 09:58 AM

của mình là 1382 x 784, tất cả hơn 16 đơn vị


  • 0

#2120 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 November 2014 - 10:05 AM

Được mà bác. Màn hình CAD để form sizeable nên kéo lớn hơn cũng đc, vô tình làm lớn hơn cũng được


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC