Đến nội dung


Hình ảnh
5 stars - based on 24598 reviews
* * * - - 18 Bình chọn

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


  • Please log in to reply
2895 replies to this topic

#2881 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 06 March 2017 - 10:27 AM

INSUNITS từ 6 qua 4


  • 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ờ. Và đừng làm điều ngược lại.

* 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.


#2882 Danh Cong

Danh Cong

    biết lệnh wblock

  • Moderator
  • PipPipPipPipPipPip
  • 460 Bài viết
Điểm đánh giá: 100 (tàm tạm)

Đã gửi 06 March 2017 - 11:19 AM

INSUNITS từ 6 qua 4

Cám ơn bác :) 


  • 0

              *** Vô lo - Vô nghĩ - Vô sầu hận ***
*** Chẳng thương - Chẳng giận - Chẳng đau lòng ***


#2883 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 18 March 2017 - 09:19 AM

Chào các bác!

Em đang tập làm quen và muốn nắm bắt được phương thức sử dụng hàm Grread kết hợp hàm Grdraw để hiển thị cho trực quan mà đang loay hoay mãi.

Em đang viết chương trình nội suy từ 2 điểm đã biết tọa độ. Khi chọn xong 2 điểm có độ cao, khi di chuyển con chuột đến đâu thì hiển thị độ cao điểm nội suy đến đó. Khi Pick vào màn hình thì nó sẽ ghi Text và cho mình tiếp tục chọn điểm tiếp theo để Pick (lại tiếp tục di chuyển con chuột và hiển thị độ cao điểm nội suy). Thêm một phương thức nữa là có thể sử dụng được Osnap khi chọn điểm Pick (Em biết phần này không dễ dàng chút nào nhưng cứ mạn phép xin được chỉ giáo điều đó)

Em chỉ làm được đến phần Pick vào màn hình thì nó ghi kết quả nội suy độ cao chứ không cho chọn liên tiếp. Rất mong các bác chỉ giáo cho phương thức thực hiện với ạ! Em cảm ơn các bác nhiều!

(vl-load-com)
(defun c:00 (/ CAOCHU	CAODO1 CAODO2 CAODO3 CHIEUCAO ENAMET1 ENAMET2
	       PT1A PT2A PTGR PT_I SLE TDO1 TDO2 TEXT X1 X2 Y1 Y2
	      )
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (_layer2 "TNS" 6)
  (setq sle 2)

  (if
    (and
      (setq EnameT1
	     (car
	       (entsel "\nCh\U+1ECDn Text th\U+1EE9 nh\U+1EA5t: ")
	     )
      )
      (setq EnameT2 (car (entsel "\nCh\U+1ECDn Text th\U+1EE9 hai ")))
    )
     (progn
       (setq Tdo1 (TD:Text-Base EnameT1))
       (setq Caodo1 (cdr (assoc 1 (entget EnameT1))))
       (setq x1 (car Tdo1))
       (setq y1 (cadr Tdo1))
       (setq Caochu (cdr (assoc 40 (entget EnameT1))))
       (setq Pt1A (list x1 y1 (atof Caodo1)))

       (setq Tdo2 (TD:Text-Base EnameT2))
       (setq Caodo2 (cdr (assoc 1 (entget EnameT2))))
       (setq x2 (car Tdo2))
       (setq y2 (cadr Tdo2))
       (setq Pt2A (list x2 y2 (atof Caodo2)))
       (prompt "\nV\U+1ECB tr\U+00ED ch\U+00E8n : ")
       (setvar "OSMODE" 0)
       (while (member (car (setq ptgr (grread 't 5 0))) '(5 2))
	 (if text
	   (progn
	     (setq PntPick (trans (cadr ptgr) 1 0))
	     (if (= (CheckPntbetween2Pnt
		      Pt1A
		      Pt2A
		      PntPick
		    )
		    1
		 )
	       (setq Caodo3
		      (NSG2D Pt1A Pt2A PntPick)
	       )
	       (setq Caodo3
		      (NSN2D Pt1A Pt2A PntPick)
	       )
	     )
	     (vlax-put text
		       'InsertionPoint
		       (mapcar '+ PntPick '(0.1 0.1 0.0))
	     )
	     (vlax-put
	       text
	       'TextString
	       (rtos Caodo3 2 3)
	     )
	     (redraw)
	     (grdraw Pt1A PntPick 7 1)
	     (grdraw Pt2A PntPick 7 1)
	   )
	   (setq text (vlax-ename->vla-object
			(MakeText Pt2A
				  (rtos (caddr Pt2A) 2 3)
				  Caochu
				  0
				  "L"
				  "TNS"
				  nil
				  nil
			)
		      )
	   )
	 )
       )
     )
  )
  (redraw)
  (setvar "OSMODE" Olmode)
  (princ)
)

(defun NSG2D (P1 P2 P / D D1 D2 DH DHZ PT1 PT2 PT3 Z1 Z2 Z3);;;;NOI SUY GIUA 2 DIEM
  (setq pt1 (TachXY P1))
  (setq pt2 (TachXY P2))
  (setq pt3 (TachXY P))
  (setq Z1 (caddr P1))
  (setq Z2 (caddr P2))
  (setq d1 (distance pt1 pt3))
  (setq d2 (distance pt2 pt3))
  (setq d (+ d1 d2))
  (setq dh (- Z2 Z1))
  (setq dhz (* dh (/ d1 d)))
  (setq Z3 (+ Z1 dhz))
  Z3
)




(defun NSN2D (P1 P2 P /	D13 D23	DELTAZ12 DELTAZ13 KC12 KC13 KC23 PT1
	      PT2 PT3 Z3
	     ) ;;;;NOI SUY NGOAI 2 DIEM
  (setq d13 (distance (TachXY P1) (TachXY P)))
  (setq d23 (distance (TachXY P2) (TachXY P)))
  (if (< d13 d23)
    (progn
      (setq pt1 P1)
      (setq pt2 P2)
      (setq pt3 P)
    )
    (progn
      (setq pt1 P2)
      (setq pt2 P1)
      (setq pt3 P)
    )
  )
  (setq KC12 (distance (TachXY Pt1) (TachXY Pt2)))
  (setq KC13 (distance (TachXY Pt1) (TachXY Pt3)))
  (setq KC23 (distance (TachXY Pt2) (TachXY Pt3)))
  (setq DeltaZ12 (- (caddr Pt1) (caddr Pt2)))
  (setq DeltaZ13 (/ (* KC13 DeltaZ12) KC12))
  (setq Z3 (+ (caddr Pt1) DeltaZ13))
  Z3
)





(defun TachXY (Pnt /)
  (setq Pt (list (car Pnt) (cadr Pnt)))
  pt
)





;;;;LAY TOA DO TEXT
(defun TD:Text-Base (ent / MA71 MA72 X11)
  (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 _layer2 (name colour)
  (if (null (tblsearch "LAYER" name))
    (entmake
      (list
	'(0 . "LAYER")
	'(100 . "AcDbSymbolTableRecord")
	'(100 . "AcDbLayerTableRecord")
	'(70 . 0)
	(cons 2 name)
	(cons 62 colour)
      )
    )
  )
)


(defun MakeText
       (point string Height Ang justify Layer Style Color / Lst)
 ; Ang: Radial
  (setq	Lst	(list '(0 . "TEXT")
		      (cons 10 point)
		      (cons 40 Height)
		      (cons 8
			    (if	Layer
			      Layer
			      (getvar "CLAYER")
			    )
		      )
		      (cons 1 string)
		      (if Ang
			(cons 50 Ang)
		      )
		      (cons 7
			    (if	Style
			      Style
			      (getvar "Textstyle")
			    )
		      )
		      (cons 62
			    (if	Color
			      Color
			      256
			    )
		      )
		)
	justify	(strcase justify)
  )
  (cond
    ((= justify "C")
     (setq Lst (append Lst (list (cons 72 1) (cons 11 point))))
    )
    ((= justify "L")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 73 0) (cons 10 point)))
     )
    )
    ((= justify "R")
     (setq Lst (append Lst (list (cons 72 2) (cons 11 point))))
    )
    ((= justify "M")
     (setq Lst (append Lst (list (cons 72 4) (cons 11 point))))
    )
    ((= justify "TL")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))
     )
    )
    ((= justify "TC")
     (setq
       Lst
	(append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))
     )
    )
    ((= justify "TR")
     (setq
       Lst
	(append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))
     )
    )
    ((= justify "ML")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))
     )
    )
    ((= justify "MC")
     (setq
       Lst
	(append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))
     )
    )
    ((= justify "MR")
     (setq
       Lst
	(append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))
     )
    )
    ((= justify "BL")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))
     )
    )
    ((= justify "BC")
     (setq
       Lst
	(append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))
     )
    )
    ((= justify "BR")
     (setq
       Lst
	(append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))
     )
    )
  )
  (entmakex Lst)
)


;;;;KIEM TRA DIEM NAM GIUA 2 DIEM
(defun CheckPntbetween2Pnt
       (P1 P2 P / KC1 KC12 KC2 OBJL_NEW P1A P2A PT VLALINE)
  (setq P1a (TachXY P1))
  (setq P2a (TachXY P2))
  (setq ObjL_New (MakeLine P1a P2a nil nil nil nil nil))
  (setq VlaLine (vlax-ename->vla-object ObjL_New))
  (setq Pt (vlax-curve-getClosestPointTo VlaLine P T))
  (setq KC1 (distance P1a Pt))
  (setq KC2 (distance P2a Pt))
  (setq KC12 (distance P1a P2a))
  (entdel ObjL_New)
  (if (equal (+ KC1 KC2) KC12 0.001)
    (setq KQ 1)
    (setq KQ 2)
  )
  KQ
)

(defun MakeLine	(PT1 PT2 Linetype LTScale Layer Color xdata)
  (entmakex (list '(0 . "LINE")
		  (cons	8
			(if Layer
			  Layer
			  (getvar "Clayer")
			)
		  )
		  (cons	6
			(if Linetype
			  Linetype
			  "bylayer"
			)
		  )
		  (cons	48
			(if LTScale
			  LTScale
			  1
			)
		  )
		  (cons	62
			(if Color
			  Color
			  256
			)
		  )
		  (cons 10 PT1)
		  (cons 11 PT2)
		  (cons	-3
			(if xdata
			  (list xdata)
			  nil
			)
		  )
	    )
  )
)




http://www.mediafire...DIEM DO CAO.LSP


  • 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







#2884 quocmanh04tt

quocmanh04tt

    biết lệnh adcenter

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

Đã gửi 18 March 2017 - 11:48 AM

Xem và nghiên cứu bài này: http://www.cadviet.c...ung-ham-grread/

Đơn giản thì bài của bác Hạ, nhiều hơn nữa thì bài của KangKung.


  • 1

#2885 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 18 March 2017 - 06:07 PM

Xem và nghiên cứu bài này: http://www.cadviet.c...ung-ham-grread/

Đơn giản thì bài của bác Hạ, nhiều hơn nữa thì bài của KangKung.

Cảm ơn bác Quocmanh04tt!

Em cũng đã nghiên cứu rồi nhưng  vẫn chưa nắm được phương thức. Chắc nó nằm ở chỗ kiểm soát vòng lặp.

Em muốn kết thúc bằng phím Enter hoặc chuột phải.

Có lẽ em cần thời gian mò thêm, rất mong dc các bác chỉ giáo.

Cảm ơn bác Quocmanh04tt nhiều!


  • 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







#2886 quocmanh04tt

quocmanh04tt

    biết lệnh adcenter

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

Đã gửi 19 March 2017 - 04:08 PM

1. Trước hết tìm hiểu về hàm Grread: (nó đọc giá trị từ thiết bị nhập vào (chuột, bàn phím...)
Kết quả trả về là 1 danh sách:
* Đối với chuột: (code point)
- Khi rê chuột: (5 pt) => pt là điểm.
- Khi nhấn phím trái chuột: (3 pt)
- Khi nhấn phím phải: (25 code)
- Pick chọn vào các menu, button... ra nhiều kết quả khác (có code để test ở dưới).
* Đối với bàn phím: (2 key) => trong đó key là mã ký tự bàn phím.
* Shift + Phím phải chuột: => '(11 1000)
* Thiết bị khác chưa dùng nên chưa biết (ví dụ bảng vẽ...)
2. Phân tích vòng lặp của bạn:
- Vòng while chỉ tiếp tục khi phần tử đầu của danh sách trả về là 5 hoặc 2 (tức là khi rê chuột và nhấn bàn phím)
- Khi nhấn phím trái (pick point) khi đó (car ptgr) = 3
- Khi gõ ký tự từ bàn phím: (car ptgr) = 2, (cadr ptgr) sẽ là mã ký tự chứ không phải point => Lỗi.
3. Đoạn code sửa lại vòng lặp (Phím phải hoặc Enter đều kết thúc lệnh)
*** Bổ sung thêm nhập từ bàn phím:
- Phím h, hoặc H: Chiều cao chữ sẽ tăng 1.05 lần...
- Phím s, hoặc S: Chiều cao chữ sẽ giảm 0.95 lần...

;; Them
(setq tmp t)
(setq text (vlax-ename->vla-object (MakeText Pt2A (rtos (caddr Pt2A) 2 3) Caochu 0 "L" "TNS" nil nil)))
;; Sua
(while (and tmp (setq ptgr (grread 't 12 0)))
(cond ;; Re chuot - Dragging
((eq (car ptgr) 5)
(setq PntPick (trans (cadr ptgr) 1 0))
(if text
(progn (if (= (CheckPntbetween2Pnt Pt1A Pt2A PntPick) 1)
(setq Caodo3 (NSG2D Pt1A Pt2A PntPick))
(setq Caodo3 (NSN2D Pt1A Pt2A PntPick)))
(vlax-put text 'InsertionPoint (mapcar '+ PntPick '(0.1 0.1 0.0)))
(vlax-put text 'TextString (rtos Caodo3 2 3))
(redraw)
(grdraw Pt1A PntPick 7 1)
(grdraw Pt2A PntPick 7 1))
(setq text (vlax-ename->vla-object
(MakeText PntPick (rtos (caddr Pt2A) 2 3) Caochu 0 "L" "TNS" nil nil)))))
;; Tang chieu cao chu: Nhan Phim H=72;h=104
((or (equal ptgr '(2 72)) (equal ptgr '(2 104)))
(setq Caochu (* Caochu 1.05))
(vlax-put text 'Height caochu))
;; Giam chieu cao chu: Nhan Phim S=72;s=104
((or (equal ptgr '(2 83)) (equal ptgr '(2 115)))
(setq Caochu (* Caochu 0.95))
(vlax-put text 'Height caochu))
;; Phim trai chuot - Picked point
((eq (car ptgr) 3) (setq text nil) (redraw))
;; Phim phai chuot hoac Enter - Right click or Enter
((or (eq (car ptgr) 25) (equal ptgr '(2 13))) (setq tmp nil) (and text (vla-delete text)))))

4. Còn đây là code để test grread:
- Sau khi gọi lệnh => rê chuột, phím trái, phím phải để xem kết quả dưới dòng command.
- Thả chuột, gõ ký tự từ bàn phím và xem kết quả.
(defun c:tt (/ grr tmp)
;; Test Grread - QuocManh04tt.
(setq tmp t)
(while (and tmp (setq grr (grread 't 15 0)))
(cond ((eq (car grr) 5) (princ "\nDI CHUOT, KET QUA grread: ") (princ grr))
((eq (car grr) 3) (princ "\nPHIM TRAI CHUOT, KET QUA grread: ") (princ grr))
((eq (car grr) 25) (princ "\nPHIM PHAI CHUOT, KET QUA grread: ") (princ grr))
((equal grr '(11 1000)) (princ "\nShift+Phim phai chuot, KET QUA grread: ") (princ grr))
((eq (car grr) 2)
(princ (strcat "\nBAN DA NHAN PHIM ["
(cond ((eq (cadr grr) 6) "F3")
((eq (cadr grr) 25) "F4")
((eq (cadr grr) 5) "F5")
((eq (cadr grr) 4) "F6")
((eq (cadr grr) 7) "F7")
((eq (cadr grr) 15) "F8")
((eq (cadr grr) 2) "F9")
((eq (cadr grr) 21) "F10")
((eq (cadr grr) 151) "F11")
((eq (cadr grr) 31) "F12")
((eq (cadr grr) 9) "Tab")
((eq (cadr grr) 8) "Back")
((eq (cadr grr) 32) "Space")
((eq (cadr grr) 13) "Enter")
(t (chr (cadr grr))))
"] KET QUA grread: "))
(princ grr))
(t (princ "\n") (princ grr))))
(princ))


  • 2

#2887 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 19 March 2017 - 10:20 PM

1. Trước hết tìm hiểu về hàm Grread: (nó đọc giá trị từ thiết bị nhập vào (chuột, bàn phím...)
Kết quả trả về là 1 danh sách:
* Đối với chuột: (code point)
- Khi rê chuột: (5 pt) => pt là điểm.
- Khi nhấn phím trái chuột: (3 pt)
- Khi nhấn phím phải: (25 code)
- Pick chọn vào các menu, button... ra nhiều kết quả khác (có code để test ở dưới).
* Đối với bàn phím: (2 key) => trong đó key là mã ký tự bàn phím.
* Shift + Phím phải chuột: => '(11 1000)
* Thiết bị khác chưa dùng nên chưa biết (ví dụ bảng vẽ...)
2. Phân tích vòng lặp của bạn:
- Vòng while chỉ tiếp tục khi phần tử đầu của danh sách trả về là 5 hoặc 2 (tức là khi rê chuột và nhấn bàn phím)
- Khi nhấn phím trái (pick point) khi đó (car ptgr) = 3
- Khi gõ ký tự từ bàn phím: (car ptgr) = 2, (cadr ptgr) sẽ là mã ký tự chứ không phải point => Lỗi.
3. Đoạn code sửa lại vòng lặp (Phím phải hoặc Enter đều kết thúc lệnh)
*** Bổ sung thêm nhập từ bàn phím:
- Phím h, hoặc H: Chiều cao chữ sẽ tăng 1.05 lần...
- Phím s, hoặc S: Chiều cao chữ sẽ giảm 0.95 lần...

;; Them
(setq tmp t)
(setq text (vlax-ename->vla-object (MakeText Pt2A (rtos (caddr Pt2A) 2 3) Caochu 0 "L" "TNS" nil nil)))
;; Sua
(while (and tmp (setq ptgr (grread 't 12 0)))
(cond ;; Re chuot - Dragging
((eq (car ptgr) 5)
(setq PntPick (trans (cadr ptgr) 1 0))
(if text
(progn (if (= (CheckPntbetween2Pnt Pt1A Pt2A PntPick) 1)
(setq Caodo3 (NSG2D Pt1A Pt2A PntPick))
(setq Caodo3 (NSN2D Pt1A Pt2A PntPick)))
(vlax-put text 'InsertionPoint (mapcar '+ PntPick '(0.1 0.1 0.0)))
(vlax-put text 'TextString (rtos Caodo3 2 3))
(redraw)
(grdraw Pt1A PntPick 7 1)
(grdraw Pt2A PntPick 7 1))
(setq text (vlax-ename->vla-object
(MakeText PntPick (rtos (caddr Pt2A) 2 3) Caochu 0 "L" "TNS" nil nil)))))
;; Tang chieu cao chu: Nhan Phim H=72;h=104
((or (equal ptgr '(2 72)) (equal ptgr '(2 104)))
(setq Caochu (* Caochu 1.05))
(vlax-put text 'Height caochu))
;; Giam chieu cao chu: Nhan Phim S=72;s=104
((or (equal ptgr '(2 83)) (equal ptgr '(2 115)))
(setq Caochu (* Caochu 0.95))
(vlax-put text 'Height caochu))
;; Phim trai chuot - Picked point
((eq (car ptgr) 3) (setq text nil) (redraw))
;; Phim phai chuot hoac Enter - Right click or Enter
((or (eq (car ptgr) 25) (equal ptgr '(2 13))) (setq tmp nil) (and text (vla-delete text)))))

4. Còn đây là code để test grread:
- Sau khi gọi lệnh => rê chuột, phím trái, phím phải để xem kết quả dưới dòng command.
- Thả chuột, gõ ký tự từ bàn phím và xem kết quả.
(defun c:tt (/ grr tmp)
;; Test Grread - QuocManh04tt.
(setq tmp t)
(while (and tmp (setq grr (grread 't 15 0)))
(cond ((eq (car grr) 5) (princ "\nDI CHUOT, KET QUA grread: ") (princ grr))
((eq (car grr) 3) (princ "\nPHIM TRAI CHUOT, KET QUA grread: ") (princ grr))
((eq (car grr) 25) (princ "\nPHIM PHAI CHUOT, KET QUA grread: ") (princ grr))
((equal grr '(11 1000)) (princ "\nShift+Phim phai chuot, KET QUA grread: ") (princ grr))
((eq (car grr) 2)
(princ (strcat "\nBAN DA NHAN PHIM ["
(cond ((eq (cadr grr) 6) "F3")
((eq (cadr grr) 25) "F4")
((eq (cadr grr) 5) "F5")
((eq (cadr grr) 4) "F6")
((eq (cadr grr) 7) "F7")
((eq (cadr grr) 15) "F8")
((eq (cadr grr) 2) "F9")
((eq (cadr grr) 21) "F10")
((eq (cadr grr) 151) "F11")
((eq (cadr grr) 31) "F12")
((eq (cadr grr) 9) "Tab")
((eq (cadr grr) 8) "Back")
((eq (cadr grr) 32) "Space")
((eq (cadr grr) 13) "Enter")
(t (chr (cadr grr))))
"] KET QUA grread: "))
(princ grr))
(t (princ "\n") (princ grr))))
(princ))

Không biết gì nói lời cảm ơn bác Quocmanh04tt!

Lần nào cũng được bác tư vấn và cho lời giải thật tuyệt.

Lần trước em hay được bác Doan Van Ha giúp và bác ấy cũng rất tuyệt. Nhiệt tình và tài giỏi. Em cũng đang mò mẫm từng bước một thôi.

Cũng nhân tiện đây, bác Quocmanh có thêm được cái bắt điểm nữa không ạ?

Nếu nó không dễ thì thôi ạ! Em dùng cái này cũng rất tuyệt vời rồi.


  • 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







#2888 quocmanh04tt

quocmanh04tt

    biết lệnh adcenter

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

Đã gửi 19 March 2017 - 11:33 PM

Không biết gì nói lời cảm ơn bác Quocmanh04tt!

Lần nào cũng được bác tư vấn và cho lời giải thật tuyệt.

Lần trước em hay được bác Doan Van Ha giúp và bác ấy cũng rất tuyệt. Nhiệt tình và tài giỏi. Em cũng đang mò mẫm từng bước một thôi.

Cũng nhân tiện đây, bác Quocmanh có thêm được cái bắt điểm nữa không ạ?

Nếu nó không dễ thì thôi ạ! Em dùng cái này cũng rất tuyệt vời rồi.

- Cái Osnap cứ dựa vào bài của KangKung dễ thôi mà! Cứ chép mấy cái hàm con phục vụ osnap vào trong lisp (Viết mấy hàm con này mới khó, chứ chép vào thì có gì mà dễ với khó...???)

- Tạm hiểu thế này: khi mình di chuột đến đâu thì thì có cái hàm con nó từ tìm các điểm (theo chế độ OSNAP đã bật), sau đó mình thay điểm trả về của thao tác di chuột bằng điểm OSNAP tìm được -> OK.


  • 1

#2889 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 07 June 2017 - 09:22 AM

 

Các bác cho em hỏi 1 xíu ạ!

Em muốn xuất tọa độ Mtext (nếu nó có các kiểu căn chỉnh) mà vẫn lấy dc tọa độ chuẩn của nó thì như nào nhỉ? Em dùng:
(vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint (vlax-ename->vla-object (car (entsel))))))
Nhưng nó ko đúng. Toàn bắt điểm góc trái trên.
(Thường thì MText khi phá khối (Explode) thì nó thành DText, nó phải cùng 1 điểm chèn phải ko ạ?)
Mong các bác chỉ giáo em với! Em cảm ơn.

  • 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







#2890 Danh Cong

Danh Cong

    biết lệnh wblock

  • Moderator
  • PipPipPipPipPipPip
  • 460 Bài viết
Điểm đánh giá: 100 (tàm tạm)

Đã gửi 07 June 2017 - 10:10 AM

Help chắc có thể giúp được gì cho anh :)

...............InsertionPoint

Variant (three-element array of doubles); read-write

A 3D WCS coordinate representing the insertion point. 

 

Remarks 

 

MText: Specifies the location for a corner of the text boundary. Use the AttachmentPoint property to specify which corner of the text boundary is to be positioned at this insertion point. 

 

Text: This property is read-only except for text whose Alignment property is set to acAlignmentLeft, acAlignmentAligned, or acAlignmentFit. To position text whose justification is other than left, aligned, or fit, use the TextAlignmentPoint property. 


  • 1

              *** Vô lo - Vô nghĩ - Vô sầu hận ***
*** Chẳng thương - Chẳng giận - Chẳng đau lòng ***


#2891 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 07 June 2017 - 10:34 AM

Help chắc giúp được gì cho anh :)

 

...............InsertionPoint

 

Variant (three-element array of doubles); read-write

A 3D WCS coordinate representing the insertion point. 

 

Remarks 

 

MText: Specifies the location for a corner of the text boundary. Use the AttachmentPoint property to specify which corner of the text boundary is to be positioned at this insertion point. 

 

Text: This property is read-only except for text whose Alignment property is set to acAlignmentLeft, acAlignmentAligned, or acAlignmentFit. To position text whose justification is other than left, aligned, or fit, use the TextAlignmentPoint property. 

Cảm ơn Danh Công!

Vừa nói hỏi Ketxu thì được biết: Điểm chèn MText khi phá vỡ (Explode) thành DText sẽ khác nhau.  Phải rút kinh nghiệm vấn đề này.

P/s: Thì nào mình xuất các kiểu vẫn chỉ là 1 vị trí. ^^


  • 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







#2892 cuongtk2

cuongtk2

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 35 (tàm tạm)

Đã gửi 07 June 2017 - 11:51 AM

Cái này như quocmanh nói là gốc tọa độ block gốc là không trùng với 0. nên lisp tính toán sai. Em ít khi bị dính trường hợp này nên ko để ý. Mà có khi e còn không biết tạo cái block khác gốc tọa độ này ntn. ^_^
 
Cách sửa nếu chui vào BEDIT thì tất cả block đã chèn sẽ bị nhẩy sai hết. Vì vậy chỉ có cách là nổ block cũ và tạo 1 block mới với tọa độ chuẩn 0.. Sau đó thì lisp mới chèn ngược lại các block đã có trong bản vẽ. Đó là cách đơn giản nhất mà e nghĩ được.
 
Hi vọng ngóng được cách thay đổi tọa độ gốc trong block qua lisp của mọi người mà ko phải làm cách trên.
 
^_^

Nếu tạo block mà không pick point thì mặc định tạo block có điểm chèn là 0,0,0. Khi dùng pick point thì đỉnh sẽ so sánh với điểm pick vì điểm này sẽ là gốc tọa độ của block.
  • 0

#2893 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 07 June 2017 - 05:40 PM

Chào các bác!

Em mày mò và vọc được 1 lisp của Lee_Mac về việc đồng bộ hóa bán kính đường tròn trong nhóm đường tròn được lựa chọn.

Tuy nhiên, với số lượng ít thì chương trình có thể chạy được (em Test thử với 170 đường tròn thì OK) nhưng khi con số lớn hơn 1 chút (VD: 300 đường tròn) thì Cad đơ và thoát. Rất mong được các bác chỉ giáo để gỡ rối ạ!

Em cảm ơn!

(defun c:radlink (/ idx lst sel)
  (foreach rtr (cdar (vlr-reactors :vlr-object-reactor))
    (if	(= "radlink" (vlr-data rtr))
      (vlr-remove rtr)
    )
  )
  
  (if (setq sel (ssget "_:L" '((0 . "CIRCLE"))))
    (progn
      (repeat (setq idx (sslength sel))
	(setq lst (cons	(vlax-ename->vla-object
			  (ssname sel (setq idx (1- idx)))
			)
			lst
		  )
	)
      )
      (radlink-callback
	(car lst)
	(vlr-object-reactor
	  lst
	  "radlink"
	  '((:vlr-modified . radlink-callback))
	)
	nil
      )
    )
  )
  (princ)
)
(defun radlink-updateradius (obj rad)
    (if	(and (vlax-read-enabled-p obj)
	     (not (equal (vla-get-radius obj) rad 1e-8))
	     (vlax-write-enabled-p obj)
	)
      (vla-put-radius obj rad)
    )
  )
(defun radlink-callback	(own rtr arg / rad)
  
  (if (and (vlax-read-enabled-p own) (setq rad (vla-get-radius own)))
    (foreach obj (vlr-owners rtr) (radlink-updateradius obj rad))
  )
)

  • 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







#2894 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 11 July 2017 - 04:14 PM

Chào các bác!

Em có nghiên cứu cách tạo ra File và lưu dưới dạng UTF-8 nhưng khi tạo ra rồi, dùng lisp mở nó ra và ghi Text vào đó, khi mở lên nó lại dạng ANSI. Em muốn nó phải là UTF-8.

Thêm chút nữa, nếu em không dùng write-line nữa mà (vlax-invoke stm 'write .....) thì có cách nào để xuống dòng không ạ? Các Text cứ nối với nhau.

P/s: Em đã làm được rồi nhé! (Nhưng là Unicode)

 

(defun C:00 (/ FSO I LT1 STM TXT)
  (setq i 0)
  (setq lt1 "")
  (while (< i 10)
    (setq lt1 (strcat lt1 (rtos (1+ i) 2 0) "\r\n"))
    (setq i (1+ i))
  )
  (setq txt
         (getfiled
           "Export to KML"
           ""
           "KML"
           1
         )
  )
  (WriteUnicode txt lt1 "w")
  (princ)
)
 
 
(defun WriteUnicode (path text mode / fso stream file result)
  (setq mode (if (member mode '("a" "A"))
               "a"
               "w"
             )
  )
  (vl-catch-all-apply
    '(lambda (/ format)
       (setq fso (vlax-create-object "Scripting.FileSystemObject"))
       (cond
         ((or (null (findfile path)) (eq "w" mode))
          (setq stream
                 (vlax-invoke
                   fso 'CreateTextFile path -1
                   ;; 0 (false) = don't overwrite , -1 (true) = overwrite
                   -1
                   ;; 0 (false) = ascii, -1 (true) = unicode 
)
          )
          (setq file (vlax-invoke fso 'GetFile path))
         )
         ((setq file (vlax-invoke fso 'GetFile path))
          (setq stream
                 (vlax-invoke
                   file
                   'OpenAsTextStream
                   2
                   ;; 1 = read, 2 = write, 8 = append
                   -1
                   ;; 0 = ascii, -1 = unicode, -2 system default
                 )
          )
         )
       )
       (vlax-invoke stream 'Write text)
       (vlax-invoke stream 'Close)
       (setq result (vlax-get file 'Size))
     )
  )
 
  (if file
    (vlax-release-object file)
  )
  (if stream
    (vlax-release-object stream)
  )
  (if fso
    (vlax-release-object fso)
  )
  result
)

  • 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







#2895 cuongtk2

cuongtk2

    biết lệnh scale

  • Members
  • PipPipPip
  • 140 Bài viết
Điểm đánh giá: 35 (tàm tạm)

Đã gửi 12 July 2017 - 05:32 PM

1.Bạn xuất ra dạng unicode làm gì khi lisp không hỗ trợ unicode tiếng Việt?
2.Nếu bạn mở file bằng notepad thì sẽ thấy có các dòng.
3.String không có các dòng mà chỉ có các ký tự xuống dòng "\n"
  • 0

#2896 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 13 July 2017 - 07:04 AM

1.Bạn xuất ra dạng unicode làm gì khi lisp không hỗ trợ unicode tiếng Việt?
2.Nếu bạn mở file bằng notepad thì sẽ thấy có các dòng.
3.String không có các dòng mà chỉ có các ký tự xuống dòng "\n"

Cảm ơn bác!

Em đã làm được rồi bác à!


  • 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