Nhờ viết list cho dân quy hoạch cấp thoát nước.

[binh06d1 3]

Em lam quy hoạch cấp thoát nước( phần mạng lưới). theo yêu cầu thiết kế cần đưa ra thông số L-D-i (L chiều dài, D đường kính và i độ dốc.). hiên giờ cách làm hơi thủ công là đo chiều dài line hoạc pline rồi gõ vào text thông số L. sau khi làm xong việc thống kê cũng mất khá nhiều thời gian vi phải làm thủ công là cộng chiều dàii các đoạn rất dễ nhầm lẫn hoặc thiếu sót. Để làm điều này nhanh hơn em nhờ anh em có kinh nghiệm viết list tạo ra một block attribute dạng L=CD-D=DK-i=DD(có mui tên hướng nước chảy càng tốt). thông số D và i thì phải nhập bằng tay vì liên quan đến tính toán thuỷ lực, nhưng chiều dài thì đo trên bản vẽ nên thông sô L sẽ tự động nhâp bằng line hoặc pline minh chọn. cấu trúc lệnh cơ bản như thế này:

- tên lẹnh: LDI > enter

- select line hoặc pline tuyến cống > enter:

kết quả ra block dang L=xxx(m) - D = DK - i = DD%. hướng block  song song với hướng line(pline) được chọn.

 sau khi làm xong hết tất cả các tuyến cống việc thống kê khôi lượng sẽ rất chính xác và còn xuất ra excel qua bước tạo bảng thống kê block attribute.

[huunhantvxdts 196]

Bạn nên đưa file mẫu lên mọi người mới giúp được

[Skywings 49]

Y/c của bạn khá giống chương trình mình đang viết nên mình "mần" lại một chút để bạn dùng. Chương trình viết bằng AutoCAD.NET (lấn sân một chút, sr mấy bác Lisper ^^).

Hướng dẫn: 

- dùng lệnh NETLOAD để nạp chương trình (AutoCAD 2010 -> 2012).

- gõ lệnh DMB, chọn các PLINE hoặc nhấn "T" để thiết lập các thông số.

- với thông số "Khoảng cách đến đường tim", giá trị dương ứng với vị trí block thông số nằm trên theo chiều PLINE, ngược lại với giá trị âm.

 

http://www.cadviet.com/upfiles/3/86115_skwg_dmb.rar

[binh06d1 3]

CẢM ƠN BẠN SKYWING. hiện mình dang sử dụng cad 2008 và đã sd quen với phiên bản này rồi, bạn có thề chuyển file đó để sử dụng cho cad 2008 được không. hiện mình vẫn chưa test được. thank bạn rất nhiều

[Skywings 49]

Phiên bản AutoLisp/VisualLisp, enjoy :)!

;; Written by Skywings 301213
(vl-load-com)
(princ "\n>>Skwg: Type DMB to start!")
(defun c:DMB (/ ANG DIST I INSPNT LWPSS N P0 P1 TXTH VERTEXS)
  ;; Initialize
  (if (null *ActiveDocument*)
    (setq *ActiveDocument*
	   (vla-get-ActiveDocument (vlax-get-Acad-object))
    )
  )
  (if (null *ModelSpace*)
    (setq *ModelSpace* (vla-get-ModelSpace *ActiveDocument*))
  )
  (if (null (tblsearch "LAYER" "Skwg-Info"))
    (vla-add (vla-get-Layers *ActiveDocument*) "Skwg-Info")
  )
  (if (null (tblsearch "BLOCK" "Skwg-BlkInfo"))
    (DefBlkInfo)
  )
  (if (null *SkwgSettingSav*)
    (setq *SkwgSettingSav* (list 10.0 2.0))
  )
  ;; Get input
  (while (null LwpSs)
    (setq LwpSs (ssget '((0 . "LWPOLYLINE"))))
  )
  (setq	Dist (getreal (strcat "Distance: <"
			      (rtos (car *SkwgSettingSav*) 2 1)
			      ">"
		      )
	     )
  )
  (if (null Dist)
    (setq Dist (car *SkwgSettingSav*))
    (setq *SkwgSettingSav*
	   (subst Dist
		  (car *SkwgSettingSav*)
		  *SkwgSettingSav*
	   )
    )
  )
  (initget 4)
  (setq	TxtH (getreal (strcat "Text height: <"
			      (rtos (cadr *SkwgSettingSav*) 2 1)
			      ">"
		      )
	     )
  )
  (if (null TxtH)
    (setq TxtH (cadr *SkwgSettingSav*))
    (setq *SkwgSettingSav*
	   (subst TxtH
		  (cadr *SkwgSettingSav*)
		  *SkwgSettingSav*
	   )
    )
  )
  ;; Process & Output
  (setq n 0)
  (repeat (sslength LwpSs)
    (setq vertexs (mapcar 'cdr
			  (vl-remove-if-not
			    '(lambda (vertex) (= (car vertex) 10))
			    (entget (ssname LwpSs n))
			  )
		  )
    )
    (setq i 0)
    (repeat (1- (length vertexs))
      (setq p0 (nth i vertexs)
	    p1 (nth (1+ i) vertexs)
      )
      (setq ang (angle p0 p1))
      (setq insPnt
	     (polar
	       (mapcar (function (lambda (a b) (/ (+ a b) 2))) p0 p1)
	       (+ (/ pi 2) ang)
	       Dist
	     )
      )
      (vla-SetWidth
	(utl:CreateLwp
	  (mapcar
	    (function (lambda (x) (polar insPnt ang (* TxtH x))))
	    (list -4 4 5)
	  )
	  "Skwg-Info"
	)
	1
	(/ TxtH 2.5)
	0
      )
      (utl:PutTag
	(utl:AddBlkRef insPnt "Skwg-BlkInfo" (/ TxtH 2) ang "Skwg-Info")
	(list "D100" (rtos (distance p0 p1) 2 2) "i%=0.01%")
      )
      (setq i (1+ i))
    )
    (setq n (1+ n))
  )
  (princ)
)

;; Define BlockAtt Skwg-BlkInfo
(defun DefBlkInfo (/ BLKDEF TXTOBJ)
  (setq
    BlkDef (vla-Add (vla-get-Blocks *ActiveDocument*)
		    (vlax-3d-point (list 0.0 0.0 0.0))
		    "Skwg-BlkInfo"
	   )
  )
  (setq	TxtObj (vla-AddText
		 BlkDef
		 "-"
		 (vlax-3d-point (list 0.0 1.0 0.0))
		 2
	       )
  )
  (utl:PutMulProps
    TxtObj
    (list 'Alignment 'TextAlignmentPoint 'Color)
    (list acAlignmentCenter
	  (vlax-3d-point (list 0.0 1.0 0.0))
	  150
    )
  )
  (foreach propVals (list (list	2
				acAttributeModePreset
				"PipeType"
				(vlax-3d-point (list -0.75 1.0 0.0))
				"TYPE"
				"D100"
				acAlignmentRight
				256
			  )
			  (list	2
				acAttributeModePreset
				"Length"
				(vlax-3d-point (list 0.75 1.0 0.0))
				"LENGTH"
				"0.0"
				acAlignmentLeft
				256
			  )
			  (list	2
				acAttributeModePreset
				"i%"
				(vlax-3d-point (list 0.0 -1.0 0.0))
				"I%"
				"i=0.00%"
				acAlignmentTopCenter
				51
			  )
		    )
    (utl:AddAtt BlkDef propVals)
  )
)
;;-----------;;
;; Utilities ;;
;;-----------;;

;; Put multiple properties
(defun utl:PutMulProps (obj props vals)
  (mapcar (function
	    (lambda (prop val) (vlax-put-property obj prop val))
	  )
	  props
	  vals
  )
)
;; Add Attribute
(defun utl:AddAtt (obj args / ATTDEF)
  (setq	AttDef (vla-AddAttribute
		 obj
		 (nth 0 args)		; height
		 (nth 1 args)		; mode
		 (nth 2 args)		; prompt
		 (nth 3 args)		; InsertionPoint
		 (nth 4 args)		; tag
		 (nth 5 args)		; value
	       )
  )
  (utl:PutMulProps
    AttDef
    (list 'Alignment 'Color 'LockPosition)
    (list (nth 6 args) (nth 7 args) T)
  )
  (if (/= (nth 6 args) acAlignmentLeft)
    (vla-put-TextAlignmentPoint AttDef (nth 3 args))
  )
  AttDef
)
;; Create lwpolyline
(defun utl:CreateLwp (lst-pnt layer / lwp)
  (setq	lwp (vla-AddLightWeightPolyline
	      *ModelSpace*
	      (utl:lst2vArray
		(apply 'append lst-pnt)
	      )
	    )
  )
  (vla-put-layer lwp layer)
  lwp
)
;; List to variant array
(defun utl:Lst2vArray (ptsList / arraySpace sArray)
  (setq	arraySpace
	 (vlax-make-safearray
	   vlax-vbdouble
	   (cons 0
		 (- (length ptsList) 1)
	   )
	 )
  )
  (setq sArray (vlax-safearray-fill arraySpace ptsList))
  (vlax-make-variant sArray)
)
;; Insert Block Reference
(defun utl:AddBlkRef (Pnt BlkName scl ro LayName / BlkRef)
  (setq	BlkRef (vla-InsertBlock
		 *ModelSpace*
		 (vlax-3d-point Pnt)
		 BlkName
		 scl
		 scl
		 scl
		 ro
	       )
  )
  (vlax-put-property BlkRef 'Layer LayName)
  BlkRef
)

;; Put Tag
(defun utl:PutTag (i textstring / atts tag sp:n)
  (if (and
	(= (vla-get-hasattributes i) :vlax-true)
	(safearray-value
	  (setq	atts
		 (vlax-variant-value
		   (vla-getattributes i)
		 )
	  )
	)
      )
    (progn
      (setq sp:n 0)
      (foreach tag (vlax-safearray->list atts)
	(vla-put-TextString tag (nth sp:n textstring))
	(setq sp:n (1+ sp:n))
      )
    )
    (vla-update i)
  )
)

[trungputin2003 0]

Bác Skying dân ở mô đó họ? dừ mới tìm ra bác ni hey. Đang có cái cái cần nhờ bácgiuwps cho 1 tay đây!

[trungputin2003 0]

Bác Skying ơi, em muốn xuất cho cả pline (gồm nhiều đoạn pline nối với nhau) thì làm thế nào? ở đây Bác đang làm cho từng đoạn (file cad em gửi kèm) nhờ Bác chỉnh cho cái. Cảm ơn Bác nhiều nha.