Lisp vẽ tiếp tuyến nhiều cung tròn trong đường PLine

[Vương Ân 0]

Chào các anh chị trong diễn đàn

Anh chị nào có lisp vẽ tiếp tuyến cho nhiều cung tròn trong đường Pline có thể cho xin với ạ

Em đang thiết kế kè đá hộc quanh tuyến Hồ nước

Nhưng gặp phải tuyến hồ có chứa nhiều cung tròn,việc làm thủ công mất rất thời gian ạ.

[hiepttr 538]

Đang rảnh nên xào xáo được cho bạn cái này.

Đề bài sơ sai nên nếu sản phẩm không như ý thì cũng đừng kêu quá to nhé :D :D :D

;lisp ve tiep tuyen cho cung trong LWPolyline
(defun c:VTT( / ANG ANG1 BULGE DIST DXF10_LST DXF42_LST ENT I INFO LEN LST_VA OLD PT1 PT2 PT_D R TT)
(setq lst_va '("osmode" "cmdecho" "AUNITS"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0 3))
(prompt "\nChon tuyen PL!")
(setq ent (ssget "+.:E:S" '((0 . "LWPOLYLINE"))))
(if ent
	(progn
		(setq info (entget(ssname ent 0))
			  dxf10_lst (vl-remove-if-not '(lambda(x) (= (car x) 10)) info)
			  dxf42_lst (vl-remove-if-not '(lambda(x) (= (car x) 42)) info)
			  i 0
			  len (length dxf42_lst)
			  )
		(while (< i (1- len))
			(cond
				((not (equal (setq bulge (cdr (nth i dxf42_lst))) 0))
					(setq pt1 (cdr (nth i dxf10_lst))
						  pt2 (if (< i (1- len)) (cdr (nth (1+ i) dxf10_lst)) (cdr (nth 0 dxf10_lst)))
						  dist (distance pt1 pt2)
						  ang (* 4 (atan bulge))
						  R (/ (/ dist 2.) (cos (setq ang1 (- (* 0.5 pi) (* ang 0.5)))))
						  TT (* R (/ (sin (* ang 0.5)) (cos (* ang 0.5))))
						  pt_D (polar pt1 (- (angle pt1 pt2) (- (* pi 0.5) ang1)) TT)
						  )
						  (MakeLine pt1 pt_D nil nil nil 2 nil)
						  (MakeLine pt2 pt_D nil nil nil 2 nil)
						  )
			)	;cond
			(setq i (1+ i))
		)	;while
	)
	(princ "\n*** Khong chon duoc PL nao! ***")
)
;;xong tra ve:
(mapcar 'setvar lst_va old)
(princ)
)
;=================================
(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))))
);end

 

[ndtnv 481]

dxf trả kq ở world, dùng trans nên vẽ sai nếu UCS không phải world

[hiepttr 538]

Thank @ndtnv !
Nhưng tại thời điểm bác Rep bài này thì em đã phát hiện & edit rồi mà
Hình như bác down từ trước đó thì phải ^^