Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Jin Yong

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

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

thanhduan2407    227

Anh Tot77 ơi! Em hỏi ngoài lề 1 chút ạ!

Làm thế nào để biết phần tử trong 1 list ở vị trí thứ mấy trong list đó ạ.

Liệu có hàm nào không hay phải viết ạ?

Cảm ơn anh

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    2.680

Anh Tot77 ơi! Em hỏi ngoài lề 1 chút ạ!

Làm thế nào để biết phần tử trong 1 list ở vị trí thứ mấy trong list đó ạ.

Liệu có hàm nào không hay phải viết ạ?

Cảm ơn anh

vl-position

  • Vote tăng 1

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    2.680

Khi tạo image bác cứ zoom toàn màn hình lên thôi (dĩ nhiên khi đó trong bản vẽ chỉ có mỗi cái hình đó).

Còn trong lsp bác dùng hàm fill_image với màu trùng màu nền để lấp background cùng màu với image.

Chứ chẳng có công thức cố định nào cả đâu.

Vấn đề là làm sao để với bất kỳ hình nào thì trọng tâm của nó cũng trùng với trọng tâm của tile và đường bao của hình vừa khít với biên của tile.

Như ví dụ là rectang màu đỏ.

67029_test_1.png

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
nhoclangbat    382

- mấy a cho nhoc hỏi có cách nào khắc phục hạn chế của hatch đối với đa giác có 1 or vài góc gãy nhỏ, đối với hình như vậy nó ko hatch hết đc hình, vì nhoc tính diện tích = hatch mà nếu hatch ko hết thì ảnh hưởng đến sai số làm tròn diện tích, dùng lệnh bo thì ok nhưng hình nhoc tính đôi khi là đa giác trong đa giác và nhoc chỉ mún tính diện tích trừ đi diện tích con của đa giác nằm trong.

- thank mấy a trước ^^

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    501

Bác thử làm thế này xem sao.

1. Vẽ 1 rectang màu đỏ, zoom "e", stretch sao cho vừa bằng cái  rìa màn hình của bác. Khi đó nó là hình chữ nhật ngang (không phải đứng như hình của bác) vì bao giờ bề ngang màn hình cũng lớn hon bề cao.

2. Đánh mslide tạo file sld.

3. Khi làm bước 1 bác đo  bề ngang bề đứng của rectang rồi tìm tỷ lệ. Sau đó trong file dcl bác cho width và height bằng tỷ lệ đó.

4. Trong file lsp bác viết có đoạn như sau:

  (fill_image 0 0 width height 0)

  (slide_image 1 1 (1- width) (1- height) sldName)

 với width = dimx_tile và height = dimy_tile, sldName là tên file sld.

(fill_image 0 0 width height 0)

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    501

- mấy a cho nhoc hỏi có cách nào khắc phục hạn chế của hatch đối với đa giác có 1 or vài góc gãy nhỏ, đối với hình như vậy nó ko hatch hết đc hình, vì nhoc tính diện tích = hatch mà nếu hatch ko hết thì ảnh hưởng đến sai số làm tròn diện tích, dùng lệnh bo thì ok nhưng hình nhoc tính đôi khi là đa giác trong đa giác và nhoc chỉ mún tính diện tích trừ đi diện tích con của đa giác nằm trong.

- thank mấy a trước ^^

Nhoc đưa cái hình hay cái file lên mới hình dung ra dc.

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    501

Hatch theo kiểu Add Select Object sẽ không bị sót như kiểu Add Pick Points.

Hactch kiểu Add Pick Points cũng phụ thuộc vào khung nhìn, nhìn càng gần càng chính xác.

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
nhoclangbat    382

Hatch theo kiểu Add Select Object sẽ không bị sót như kiểu Add Pick Points.

Hactch kiểu Add Pick Points cũng phụ thuộc vào khung nhìn, nhìn càng gần càng chính xác.

- kiểu object thì làm sao để loại đc mấy đa giác nhỏ ở trong anh Tot77 nhỉ

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    501

Nói theo thứ tự là như vầy:

1. Zoom "o" cái đường bao.

2. Lệnh bo, chon dg bao, nhấp chọn island detection.

3. lệnh hatch, chon add select objects, chọn cả cái bo mới tạo + 2 cái lỗ bên trong.

  • Vote tăng 1

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    2.680

Cám ơn bạn Tot77 đã chia sẻ, nhưng nó không đúng.

Cám ơn mọi người đã đọc chủ đề "slide". Sau một thời gian nghiên cứu tôi đã tìm ra được quy luật rồi.

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
nhoclangbat    382

- Mấy anh cho nhoc hỏi với, nhoc đang chỉnh lại cái lsp xuất bảng tọa độ thửa đất nhưng gặp 1 số chỗ thắc mắc chưa hiểu ^^

- có cách nào tạo đk để kt 1 tử có thuộc danh sách cho trước không mấy a

- Vd: nhoc viết như vậy (if (= (member a (list 1 2 3 a d v 5)) nil) có đc ko nhỉ, ý nhoc  mún là nếu a ko thuộc danh sách đó = nil thì thoát lệnh lun hoặc thông báo cho người dùng pit, còn a thuộc danh sách đó thì đúng và làm các việc trong (progn .......).

- như nhoc viết nếu a thuộc danh sách đó hàm mem bẻ sẽ trả về danh sách (= (a d v 5) nil), nhoc pit là nhoc viết sai, nó chỉ đúng khi a thật sự ko thuộc danh sách đó.

- mấy a giúp nhoc với ^^

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    227

Nhoclangbat nghiên cứu Code này xem

;;HAM LAY RA CAC PHAN TU GIONG NHAU TU 2 DANH SACH (CON - TO) (LEN L1< LEN L2)
;;;;(LM:RemoveOnce '(2 4 6) '(1 2 3 4 5 7 6) )
(defun LM:RemoveOnce ( l1 l2 )
  (if l1
    (if (equal (car l1) l2)
      (LM:RemoveOnce (cdr l1) l2)
      (cons (car l1) (LM:RemoveOnce (cdr l1) l2))
    )
  )
)
  • Vote tăng 1

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
tien2005    97

@nhoclangbat diễn đạt lủng cũng quá. Để kiểm tra 1 phần tử có thuộc list hay không có nhiều cách, như của nhoc la 1 cách

(if (member 'a '(d s a 1 4))
  (progn; a thuoc list
    (alert "a thuoc list")
    ;......
    )
  (progn; a khong thuoc list
    (alert "a khong thuoc list")
    ;.....
    )
  )

hoặc dùng hàm (vl-position "a" '("r" "b" "a" "d" "e")). Tuỳ theo từng trường hợp mà dùng cho thích hợp

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
nhoclangbat    382

- mấy anh xem dùm lsp  nhoc sửa với, nhoc test mún nát cad lun rùi ^^ mà hình như vẫn lỗi gì đó khó hỉu lắm, cùng 1 hình 1 điểm khi chọn điểm đầu tiên, có lúc nó nhận đc điểm đó đúng trong list chạy ngon lành, có lúc lại không nhận đc @@, rùi chạy lại từ đầu thì lại đc @@, nhoc cũng thử kiểm tra tọa độ pick với list tọa độ thu đc từ lệnh bo, xem có sự sai lệch ko, nhưng test mấy lần điểm pick vẫn thuộc list mà nó lại chạy thẳng xuống vế  "ko thì" của if :(

- mấy hàm các anh gợi ý cho nhoc, nhoc vẫn chưa pit áp dụng thế nào ^^

(defun *error* (msg)
  (princ "error: ")
  (princ msg)
  (princ)
)
;;;;;;;;;;;============================================================
(defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	'(100 . "AcDbPolyline")
	(cons 90 (length listpoint))
	(cons 70 (if closed 1 0))))
	(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
	(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
	(entmakex Lst))
	;end;=================================
;;;;------------------------------------------
;;ham tao text 2
(defun mktext (point height string justify layer textstyle / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 textstyle)
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 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)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(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 Wdis (p1 p2 / dis ang point point1)
  (setq dis (distance p1 p2))
  (setq ang (angle p1 p2))
  (if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )
    (progn
      (setq ang (+ Ang Pi)) 
      (setq Point (polar p2 ang (/ dis 2.0)))
      (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))

    )
	(progn
    (setq Point (polar p1 ang (/ dis 2.0)))
    (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))
	)
  )
  (command "Text" "S" "vaptimn" "c" point1 (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 2))
)
;--------------------------------------------------------------------------
(defun pointpl (name t2 k / namem i bien t1 p1 diem)
	(setq namem name)
	(setq i 1)
	(while (<= i k)
	(progn
		(setq bien (assoc t2 namem))
		(setq t1 (member bien namem))
		(setq p1 (car t1))
		(setq namem (cdr t1))
		(setq diem (cdr p1))
		(setq i (+ 1 i))
	)
	)
	diem
);;;-----------------------------------------------------------------------------
(defun removed(part lst / lst1 lst2)
  (setq lst1 (reverse(cdr(member part(reverse lst))))
lst2 (cdr(member part lst)))
  (append lst1 lst2)
  )
;hàm tạo textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale 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 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil)))))
;;;;;;--------------------------------------------------------------------------------------------
(prompt "LSP XUAT BANG TOA DO CAC DINH THU DAT, LENH: DKK")
;;----------------------------------------------------------------------------------------------
(defun c:dkk (/ p tam i f k lst1 lst2 lst lst_new i kk m luuxy pt pt11 old  canh p01 p02 p03 p04 p05 p06 p07 p08 p09 p10 p11 p12 p13 p14 x x1 y y1 toado toado0 toado1 pyy pxx psh pgc t0 t1 t2 t3 t4 y tsh txx tyy tgc)
(setq old (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
;-----------------------------------------------------
(if (null (tblsearch "style" "vaptimn"))
		(emk_style "vaptimn" "vavon.ttf"))
	(if (null (tblsearch "style" "vhelveb"))
		(emk_style "vhelveb" "vhelven.TTF"))
	(if (null (tblsearch "layer" "sohieu_diem"))
		(_layer2 "sohieu_diem" 2))
    (if (null (tblsearch "layer" "canh"))
		(_layer2 "canh" 3))
	(if (null (tblsearch "layer" "bang_toado"))
		(_layer2 "bang_toado" 7))
	(if (null (tblsearch "layer" "Ranh_dat"))
		(_layer2 "Ranh_dat" 6))
	(if (not r1) (setq r1 500))
	(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
	(if (= TileBdHT nil)
		(setq TileBdHT r1))
;--------------------------------------------------------------------------
(setvar "osmode" 33)
(setq pt11 (removed 0.0 (getpoint "\nchon diem bat dau:")))
(setvar "osmode" 0)
(setq p (getpoint "\npick tam thua:"))
(command "-Boundary" p "")
(setq tam (entget (entlast)))
(setq kk (cdr (assoc 90 tam)))
(command ".erase" "last" "")
(setq m 1)
(setq lst nil)

(repeat kk
(setq f (pointpl tam 10 m))
(setq m (1+ m))
(if f (setq lst (cons f lst)))
)

;------------------------------------------==========================================---------------------------------
(if (= (type (member pt11 lst)) 'LIST)
;;====================-----------------------------======================================-----------------------
(progn
;--------------------====================================------------------------------------
(if (/= lst nil)
(progn
;------------------------===============================--------------------------------------
(setq bit (cond (bit) ("T")))
(initget "T N")
(setq	Tmp (strcat "\nBan muon chay Thuan hay Ngich chieu dong ho [T/N] <" bit ">: ")
	    bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "T")
(progn
(setq lst1 (member pt11 lst))
(setq lst2 (reverse (cdr (member pt11 (reverse lst)))))
(setq lst_new (append lst1 lst2))
)
(progn
(setq lst1 (member pt11 (reverse lst)))
(setq lst2 (reverse (cdr (member pt11 lst))))
(setq lst_new (append lst1 lst2))
)
)
;---------------------------------==============================-----------------------------------
(Makepline lst_new 1 "Ranh_dat" nil nil nil)
;----------------------------=========================================--------------------------
)
)
;--------------------------------------------------------------------------------------------------------
(setq luuxy (entget (entlast)))
(setvar "osmode" 0)
	(setq pt (getpoint "\n Diem dat bang toa do :"))
	(setq k (cdr (assoc 90 luuxy)))
	(if (/= pt nil)
		(progn
			(setq p01 pt)
			(setq p02 (mapcar '+ pt '(10.0  0.0 0.0)))
			(setq p03 (mapcar '+ pt '(22.5 -2.5 0.0)))
			(setq p04 (mapcar '+ pt '(35.0  0.0 0.0)))
			(setq p05 (mapcar '+ pt '(45.0  0.0 0.0)))
			(setq p06 (mapcar '+ pt '(0.0 -5.0 0.0)))
			(setq p07 (mapcar '+ pt '(10.0 -2.5 0.0)))
			(setq p08 (mapcar '+ pt '(35.0 -2.5 0.0)))
			(setq p09 (mapcar '+ pt '(45.0 -5.0 0.0)))
			(if (<= k 10)			
				(progn
					(setq p10 (mapcar '+ pt '(0.0 -40.0 0.0)))
					(setq p11 (mapcar '+ pt '(10.0 -40.0 0.0)))
					(setq p12 (mapcar '+ pt '(22.5 -40.0 0.0)))
					(setq p13 (mapcar '+ pt '(35.0 -40.0 0.0)))
					(setq p14 (mapcar '+ pt '(45.0 -40.0 0.0)))
				)
				(progn
					(setq ty (* -1 (+ 10.0 (* k 3))))
					(setq t0 (list 0.0 ty 0.0))
					(setq t1 (list 10.0 ty 0.0))
					(setq t2 (list 22.5 ty 0.0))
					(setq t3 (list 35.0 ty 0.0))
					(setq t4 (list 45.0 ty 0.0))
					(setq p10 (mapcar '+ pt t0))
					(setq p11 (mapcar '+ pt t1))
					(setq p12 (mapcar '+ pt t2))
					(setq p13 (mapcar '+ pt t3))
					(setq p14 (mapcar '+ pt t4))
				)
			)
			
			(makeline p01 p05 "bang_toado" nil nil nil)
			(makeline p01 p10 "bang_toado" nil nil nil)
			(makeline p02 p11 "bang_toado" nil nil nil)
			(makeline p03 p12 "bang_toado" nil nil nil)
			(makeline p04 p13 "bang_toado" nil nil nil)
			(makeline p05 p14 "bang_toado" nil nil nil)
			(makeline p07 p08 "bang_toado" nil nil nil)
			(makeline p06 p09 "bang_toado" nil nil nil)
			(makeline p10 p14 "bang_toado" nil nil nil)
;------------------------------------------------------------------------------------------------------------------
(mktext (mapcar '+ pt '(22.5 2.0 0.0)) 1.25 "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(5.0 -1.5 0.0)) 1.15 "Soá hieäu" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(5.0 -3.5 0.0)) 1.15 "ñieåm" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(22.5 -1.25 0.0)) 1.15 "Toïa ñoä" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(16.25 -3.75 0.0)) 1.15 "X(m)" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(28.75 -3.75 0.0)) 1.25 "Y(m)" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(40.0 -2.5 0.0)) 1.25 "Caïnh" "M" "bang_toado" "vhelveb")
;-------------------====================--------------------------------------------------------------------------
		)
	)
	(setq i 1)
	(while (<= i k)
		(progn
			(setq toado (pointpl luuxy 10 i))
			(setq x (rtos (car toado) 2 2))
			(setq y (rtos (cadr toado) 2 2))
			(setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
			(mktext (mapcar '+ toado doi) (/ TileBdHT 500) (itoa i) "L" "sohieu_diem" "vaptimn")
            (command "-layer" "s" "sohieu_diem" "")			
			(command ".donut" 0 (* 0.25 (/ TileBdHT 500)) toado "")			
			(setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
			(if (= i 1)
				(progn
					(setq toado1 toado)
					(setq x1 (rtos (car toado1) 2 2))
					(setq y1 (rtos (cadr toado1) 2 2))
				)
			)
			(if (>= i 2)
(progn
	(setq canh (distance toado0 toado))
	(mktext pgc 1.2 (rtos canh 2 2) "M" "bang_toado" "vaptimn")
	(setvar "clayer" "canh")
	(wdis toado0 toado)
)
			)
			(mktext psh 1.2 (itoa i) "M" "bang_toado" "vaptimn")
			(mktext pxx 1.2 y "M" "bang_toado" "vaptimn")
			(mktext pyy 1.2 x "M" "bang_toado" "vaptimn")
			
			(setq toado0 toado)
			(setq i (+ i 1))
		)
	)
	(setvar "clayer" "canh")
	(wdis toado toado1)
	(setq canh (distance toado toado1))
			(setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
	(mktext pgc 1.2 (rtos canh 2 2) "M" "bang_toado" "vaptimn")
	(mktext psh 1.2 "1" "M" "bang_toado" "vaptimn")
	(mktext pxx 1.2 y1 "M" "bang_toado" "vaptimn")
	(mktext pyy 1.2 x1 "M" "bang_toado" "vaptimn")
	
)
(alert "ban chua chon dung dinh thua dat\nban chay lai lenh tu dau hen thong cam ^^!!")
)
	(setvar "clayer" "0")
	(setvar "osmode" old)
    (setvar "cmdecho" 1)
	(princ "\n")
	(princ)
)

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    227

Pick hên xui vì khi pick bạn pick không trùng với đỉnh của Polyline được tạo ra.

Tham khảo

   (setq PVG (vlax-curve-getClosestPointTo ObjPline Pnt)
          Pd1 (vlax-curve-getpointAtParam ObjPline (fix (vlax-curve-getparamatPoint ObjPline PVG)))
          Pd2 (vlax-curve-getpointAtParam ObjPline (1+ (fix (vlax-curve-getparamatPoint ObjPline PVG))))
    )

Tức là xét điểm pick gần với đỉnh nào nhất của Polyline được tạo ra.

 

 

 

 

    (setq PVG (vlax-curve-getClosestPointTo ObjPline Pnt)
          Pd1 (vlax-curve-getpointAtParam ObjPline (fix (vlax-curve-getparamatPoint ObjPline PVG)))
          Pd2 (vlax-curve-getpointAtParam ObjPline (1+ (fix (vlax-curve-getparamatPoint ObjPline PVG))))
    )

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
nhoclangbat    382

- nhoc thử ko khử biến pick với lst pointpline để dò lại, nhoc thấy nó giống nhau mà a, lúc đó là nó trả về nil lun chưa chạy đc gì, nên nhoc mới gọi 2 biến đó lên xem, ngộ vậy đó ^^

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
nhoclangbat    382

- hi vậy mình áp dụng cái hàm vlax của anh vào lsp thế nào để điểm pick nhận đúng tọa độ điểm gần nhất của pline ma mình pick vậy anh ^^

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    227

Rõ ràng nhoclangbat pick trước điểm rồi mới pick trong vùng, khi đó Polyline mới dc tạo ra. Nhưng mà ko sao, ta tóm được nó hết. Có cần mình viết 1 đoạn code khi pick điểm trên pline thì nhận biết được nó là đỉnh thứ mấy ko? (pick gần đỉnh nào nhất thì lấy đỉnh đó, quên điểm pick đi)

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    227

(vl-load-com)
(defun c:DPL ();;;DINH POLYLINE
(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 "CMDECHO" 0)
(setvar "OSMODE" 1)
(setq loop T)
(setq ObjPline (car (entsel "\nChon Polyline: ")))
(while loop
(setq Pnt (getpoint "\nPick diem de biet dinh gan nhat la dinh thu may cua Polyline: "))
(cond
(T
(if Pnt
(progn
(setq PVG (vlax-curve-getClosestPointTo ObjPline Pnt)
  Pd1 (vlax-curve-getpointAtParam ObjPline (fix (vlax-curve-getparamatPoint ObjPline PVG T)))
  Pd2 (vlax-curve-getpointAtParam ObjPline (1+ (fix (vlax-curve-getparamatPoint ObjPline PVG T))))
)
(setq D1 (distance PVG Pd1))
(setq D2 (distance PVG Pd2))
(if (>= D1 D2)
(setq Dinh (fix (vlax-curve-getparamatPoint ObjPline PVG)))
(setq Dinh (1+ (fix (vlax-curve-getparamatPoint ObjPline PVG))))
)
(Alert (strcat "\nDinh ban vua pick la dinh thu : " (rtos Dinh 2 0) " cua Polyline"))
)
(setq loop nil)
)
)
)
)
(setvar "OSMODE" Olmode)
(princ)
)
  • Vote tăng 1

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
ketxu    2.653

@Nhoclangbat : không khử 2 biến pt11 và lst trong khai báo thủ tục, sau đó chayj với 1 thửa chỉ có 3 đỉnh thôi cho dễ test

- Khi nhận thông báo lỗi nil thì chạy thử tiếp đoạn này để lấy khoảng cách từ điểm pt11 đến các đỉnh trong boundary. Từ đây chắc nhoc sẽ biết lý do tại sao member trả về nil.

 

(mapcar '(lambda(x)(distance x pt11)) lst)
 
  • Vote tăng 1

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×