Gán cao độ trong VB.Net

[taonv89 1]

Code gán cao độ của VBA:

Sub gancaododf()
Dim objs(0 To 1) As AcadEntity
Dim Entry As AcadObject
Dim x As Double

For i = 1 To 1

    ThisDrawing.Utility.GetEntity Entry, point, "Chon mot Pline "
Set objs(i) = Entry
   UserForm1.Show
  objs(i).Elevation = UserForm1.txtcaodo.Text

Next

End Sub

--------------------->Nhờ các bác pro chuyển sang VB.NET hộ em với !

Rất mong được sự hồi âm của các bác !Thank Pro !

 

 

[taonv89 1]

Úp ...................

[cancer_xd 49]

http://www.youtube.com/watch?v=fljKF9UJYsU. Tham khảo video này đi bạn

[truongtkd1.heco 0]

mình sưu tầm được 2 list tính diện tích bằng pick điểm, mỗi lít có ưu nhược điểm riêng
Ưu điểm: + list 1: - tính diện tích theo tỷ lệ chọn ( tính đơn vị là mét thì nhập 100)
                           - phần tính diện tích có hatch để dễ kiểm tra, sau khi kết thúc lệnh thi tự mất
                              ( trừ khi  lệnh bị lỗi )
                            - chọn text đã có thay kết quả vào
 
               + list 2: - tính diện tích theo tỷ lệ mặc định la 1/1 ( đơn vị là mét)
                            - chọn text đã có thay kết quả vào và đổi mầu text
Nhờ giúp: sửa list 1 để khi thay kết quả vào text thì text tự đổi mầu.
 
list1:
(defun c:NN()
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale : "))
    (setq ntl (/ 100 tl))
    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
  (print)
  (print)
  (setq pt1 (getpoint "\nPick internal point : "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 100 ))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (getvar "AREA"))
    (setq dtl (+ dtcon dtl))
    (print)
    (print)
    (setq pt1 (getpoint "\nPick internal point : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw")
  (setq dtl (/ dtl tl2))
  (print dtl)
  (setq elst (entget (car (entsel "Thay cho so: "))))
  (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
  (entmod elst)
  (print)
  (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
  (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun
 
 
 
 
list2:
(defun c:qq ( / tmp)
(setq tong 0.00)
(while (setq   a (getpoint "\nKich mot diem trong khu vuc: "))
(command "boundary" a "")
(command "area" "o" (entlast) )
(command "erase" (entlast) "")
(setq temp (getvar "area"))
(setq tong (+ tong temp))
)
(princ (strcat "\nDien tich la: " (rtos (/ tong 1.0) 2 2) " m2"))
(setvar "CMDECHO" 0)
(princ)
;Thay doi noi dung text
(setq C_text (rtos (/ tong 1.0) 2 2))    ;Bien can thay vao text
      (setq O-Text (entsel (strcat "\nChon Text ghi khoi luong [s..."C_text"]:")))
(if (null O-Text)
  (progn (princ))
  (progn           ;    
      (setq    Text (car O-Text)
          N-Text (cons 1 C_text))
      (setq N-Text1 (subst N-Text (assoc 1 (entget Text)) (entget Text)))
      (entmod N-Text1)
;Danh dau thay doi
    (setq mau 6)
    (setq N-Mau (cdr (car N-Text1)))
  (if (= 62 (car (assoc 62 (entget N-Mau)))); Begin IF-a
     (progn; Begin Progn-a
      (setq Color (cons 62 mau))
      (setq N-mau1 (subst Color (assoc 62 (entget N-Mau)) (entget N-Mau)))
      (entmod N-mau1)
      (entupd Text)
      (princ)    
      ) ; Close Progn-a
      (progn; Begin Progn-b
    (setq Color (cons (cons 62 mau) (cdr (member (assoc 8 (entget N-Mau)) (entget N-Mau)))))
    (setq Color1 (Reverse (member (assoc 8 (entget N-Mau)) (Reverse (entget N-Mau)))))
    (setq N-Mau1 (append Color1 Color))
    (entmod N-Mau1)
    (entupd Text)
    (princ)
      ); Close Progn-b
   ); Close IF-a
);Close Progn
  );Close IF
    (princ)
  )
(defun C:ct (/ M)
(setvar "CMDECHO" 1)
  (setq pt1 (getpoint "\nChon diem 1 ben phai:"))
  (setq pt2 (getpoint "\nChon diem 2 ben phai:"))
  (setq xt (- (car pt2) (car pt1)))
  (setq yt (- (cadr pt2) (cadr pt1)))
  (setq kct (sqrt (+ (* xt xt) (* yt yt))))
  (setq pt3 (getpoint "\nChon diem 1 ben trai:"))
  (setq pt4 (getpoint "\nChon diem 2 ben trai:"))
  (setq xp (- (car pt3) (car pt4)))
  (setq yp (- (cadr pt3) (cadr pt4)))
  (setq kcp (sqrt (+ (* xp xp) (* yp yp))))
  (setq kc (+ kct kcp))
  (setq kcte (rtos kc 2 2))
;Thay doi noi dung text
(setq C_text kcte)    ;Bien can thay vao text
      (setq O-Text (entsel (strcat "\nChon Text trong co [Lcd..."C_text"]:")))
(if (null O-Text)
  (progn (princ))
  (progn           ;    
      (setq Text (car O-Text)
          N-Text (cons 1 C_text))
      (setq N-Text1 (subst N-Text (assoc 1 (entget Text)) (entget Text)))
      (entmod N-Text1)
;Danh dau thay doi
    (setq mau 6)
    (setq N-Mau (cdr (car N-Text1)))
  (if (= 62 (car (assoc 62 (entget N-Mau)))); Begin IF-a
     (progn; Begin Progn-a
      (setq Color (cons 62 mau))
      (setq N-mau1 (subst Color (assoc 62 (entget N-Mau)) (entget N-Mau)))
      (entmod N-mau1)
      (entupd Text)
      (princ)    
      ) ; Close Progn-a
      (progn; Begin Progn-b
    (setq Color (cons (cons 62 mau) (cdr (member (assoc 8 (entget N-Mau)) (entget N-Mau)))))
    (setq Color1 (Reverse (member (assoc 8 (entget N-Mau)) (Reverse (entget N-Mau)))))
    (setq N-Mau1 (append Color1 Color))
    (entmod N-Mau1)
    (entupd Text)
    (princ)
      ); Close Progn-b
   ); Close IF-a
);Close Progn
  );Close IF
    (princ)
  )

[truongtkd1.heco 0]

lam sao gui duoc bai theo chu de moi