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

Tháng 3 6, 2017

INSUNITS từ 6 qua 4

Tháng 3 6, 2017

INSUNITS từ 6 qua 4

Cám ơn bác :)

Tháng 3 18, 2017

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.com/file/c7bxd0xwwi35agh/NOI+SUY+DIEM+DO+CAO.LSP

Tháng 3 18, 2017

Xem và nghiên cứu bài này: http://www.cadviet.com/forum/topic/68466-da-xong-lisp-su-dung-osnap-khi-dang-dung-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.

Tháng 3 18, 2017

Xem và nghiên cứu bài này: http://www.cadviet.com/forum/topic/68466-da-xong-lisp-su-dung-osnap-khi-dang-dung-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!

Tháng 3 19, 2017

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))

Tháng 3 19, 2017

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.

Tháng 3 19, 2017

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.

Tháng 6 7, 2017

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.

Tháng 6 7, 2017

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.

Tháng 6 7, 2017

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í. ^^

Tháng 6 7, 2017

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.

Tháng 6 7, 2017

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))
  )
)

Tháng 7 11, 2017

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

)

Tháng 7 12, 2017

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"

Tháng 7 13, 2017

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 à!

Tháng 8 4, 2017

Nghĩ mãi chưa ra nên đưa lên đây nhờ mọi người.

Tôi có 1 list, ví dụ là:

(a b 0 0 c d e 0 0 0 f g 0 h 0 0 i j)

Làm sao để nhóm nó thành các list con, ví dụ trong trường hợp này là:

((b 0 0 c) (e 0 0 0 f) (g 0 h) (h 0 0 i))

Giải thích:

Nhóm list mẹ thành các list con thỏa mãn 2 điều kiện:

- Các phần từ bằng 0 nếu liên tiếp nhau thì sẽ được nhóm vào 1 list con.

- Bổ sung phần tử đầu và phần tử cuối là 2 phần tử tương ứng nằm kề với nhóm đó trong list mẹ, vào list con tương ứng.

Tháng 8 5, 2017

Làm dùm bác, hơi lỉnh kỉnh nhưng xài tạm.

<code>

(defun test()
(setq l '(a b 0 0 c d e 0 0 0 f g 0 h 0 0 i j))
(setq l1 (cons 1 (append l (list 1))))

(setq l1 (reverse (cdr (reverse (cdr (vl-remove-if '(lambda(x) (if (and (setq vt (vl-position x l1)) (/= 0 vt) (/= vt (length l1)))
                                                          (and (/= 0 (nth (1- vt) l1)) (/= 0 (nth (1+ vt) l1)) ))) l1))))))
(setq i 0
           l2 nil
           lc nil)
(repeat (length l1)
   (cond ((and (= 0 (nth i l1)) (/= 0 (nth (1+ i) l1)))
                   (setq l2 (append l2 (list (nth i l1) (nth (1+ i) l1)))
                               lc (append lc (list l2))
                           l2 nil))
               ((and (/= 0 (nth i l1)) (/= 0 (nth (1+ i) l1))))
               (t   (setq l2 (append l2 (list (nth i l1)))))
               )
   (setq i (1+ i))
)
lc
)

</code>

Tháng 8 5, 2017

Khó hiểu ^^
Chắc bác í lắm việc

Em viết kiểu bi bô cũng chạy mà bác :D

;;;Nhom list
(defun NHOM (lst / lst1 lst2 kq)
(setq lst2 lst
	  lst (TRIM_FRONT lst))
(while (> (length lst) 1)
	(setq lst1 (First_Group lst)
	  kq (cons lst1 kq)
	  lst (TRIM_FRONT (trim_n lst (length lst1)))
	)
	(if (= (car lst) 0) 
		(setq lst (cons (car (trim_n (reverse lst2) (length lst))) lst))
	)
)
(reverse kq)
)
;;;Ham TRIM_FRONT:
(defun TRIM_FRONT (lst)
(while (and (> (length lst) 1) (/= (car lst) 0) (/= (cadr lst) 0))
	(setq lst (cdr lst))
)
lst
)
;;;Ham First_Group:
(defun First_Group (lst / lst1 lst2)
(setq lst1 (list (car lst))
	  lst2 (cdr lst))
(while 
	(= (car lst2) 0)
	(setq lst1 (append lst1 (list 0))
		  lst2 (cdr lst2)
	)
)
(if lst2 (setq lst1 (append lst1 (list (car lst2)))))
lst1
)
;;;Ham cat n phan tu dau cua lst
(defun trim_n (lst n)
(repeat n
	(setq lst (cdr lst))
)
)

Tháng 8 5, 2017

Nghĩ mãi chưa ra nên đưa lên đây nhờ mọi người.

Tôi có 1 list, ví dụ là:

(a b 0 0 c d e 0 0 0 f g 0 h 0 0 i j)

Làm sao để nhóm nó thành các list con, ví dụ trong trường hợp này là:

((b 0 0 c) (e 0 0 0 f) (g 0 h) (h 0 0 i))

....

Xin góp thêm đoạn code nữa :

(defun Kq (lst / lst-member Len L1 res)
(while (setq lst-member (member 0 lst))
     (setq Len (length lst-member)) 
     (while (= 0 (car lst-member)) 
   (setq L1 (append L1 (list (car lst-member))))
   (setq lst-member (cdr lst-member))
     )
(if lst-member (setq L1 (append L1 (list (car lst-member)))))
 
(if (< Len (length lst)) (setq L1 (append (list (nth (- (length lst) len 1) lst)) L1 )))
        (setq res (append res (list L1)) L1 nil)
   (setq lst lst-member)
 )
  Res
)

Tháng 10 3, 2017

Cho hỏi cách gọi hộp thoại plot bằng lisp các bác? Cám ơn.

Tháng 10 3, 2017

Dùng cặp bài trùng này:

(initdia)

(command "_plot")

Tháng 11 7, 2017

Hỏi về thuật toán:

Trên dwg tôi có rất nhiều (hàng trăm ngàn) tam giác 3D dạng Polyline 3D closed, không cắt nhau.

Bất cứ 1 point nào trên dwg hoặc là không thuộc tam giác nào, hoặc là chỉ thuộc duy nhất 1 tam giác. Nếu point nằm trên 1 cạnh/đỉnh thì thuộc nhiều tam giác.

Nếu pịck 1 point bất kỳ, làm sao chọn được 1 tam giác bao quanh point đó?

Thuật toán phải quan tâm tốc độ xử lý nhé!

Hoi_CV.dwg

Tháng 11 7, 2017

Nếu bạn chỉ quan tâm kết quả (để đi tiếp giải quyết vấn đề tiếp theo) thôi thi có hàm:

dos_isinsidecurve

Verifies a point lies inside of a closed, planar curve.

Trong DOS_LIB đó bạn.

Tháng 11 7, 2017

Ngay bây giờ, DuongTrungHuy cho biết:

Nếu bạn chỉ quan tâm kết quả (để đi tiếp giải quyết vấn đề tiếp theo) thôi thi có hàm:

dos_isinsidecurve

Verifies a point lies inside of a closed, planar curve.

Trong DOS_LIB đó bạn.

Cám ơn bạn (like)! Mình biết DOS_LIB nhưng không ưa dùng. Với lại vì không đọc được code nên không biết liệu tốc độ xử lý có tốt không.

Mình đang quan tâm tới thuật toán, như đã nói ở trên.

Đăng nhập

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

Các bài được khuyến nghị

Doan Van Ha 3.202

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Danh Cong 422

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thanhduan2407 272

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

quocmanh04tt 635

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thanhduan2407 272

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

quocmanh04tt 635

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thanhduan2407 272

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

quocmanh04tt 635

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thanhduan2407 272

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Danh Cong 422

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thanhduan2407 272

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cuongtk2 356

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thanhduan2407 272

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thanhduan2407 272

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cuongtk2 356

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thanhduan2407 272

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3.202

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tot77 508

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hiepttr 538

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912