汇报汇报学习情况，画梁

叶曲冰寒

2. (defun c:tt()
   
3.   
   
4.   (setq st 1)
   
5.   (setq pt1 (getpoint))
   
6.   (setq pt2 pt1)
   
7.   (setq newline1 (hel_Line pt1 pt2))
   
8.   (setq newline  (hel_Line pt1 pt2))
   
9.   (setq newline2 (hel_Line pt1 pt2))
   
10.   (vlax-put-property newline 'Color 1)
    
11.   (vlax-put-property newline1 'Color 2)
    
12.   (vlax-put-property newline2 'Color 2)
    
13.   (vlax-put-property newline 'LineType "dash")
    
14.   (while st
    
15.     (setq get (grread 1))
    
16.     (if (= (hel_n1h get) 5)
    
17.       (progn
    
18.   (setq pt2 (hel_n2h get))
    
19.         (setq rad (+ (angle pt1 pt2) (/ pi 2)))
    
20.         (setq pt11 (polar pt1 rad -100))
    
21.         (setq pt12 (polar pt2 rad -100))
    
22.         (setq pt21 (polar pt1 rad 100))
    
23.         (setq pt22 (polar pt2 rad 100))
    
24.   (vlax-put-property newline 'EndPoint (vlax-3d-point pt2))
    
25.   (Vlax-Put-Property newline1 'EndPoint (Vlax-3d-Point pt12) )
    
26.   (Vlax-Put-Property newline1 'StartPoint (Vlax-3d-Point pt11) )
    
27.   (Vlax-Put-Property newline2 'EndPoint (Vlax-3d-Point pt22) )
    
28.   (Vlax-Put-Property newline2 'StartPoint (Vlax-3d-Point pt21) )
    
29.       )
    
30.       (setq st nil)
    
31.     )
    
32.   )
    
33. 
    
34. )
    
35. 
    

(defun c:tt()<br />   <br />   (setq st 1)<br />   (setq pt1 (getpoint))<br />   (setq pt2 pt1)<br />   (setq newline1 (hel_Line pt1 pt2))<br />   (setq newline  (hel_Line pt1 pt2))<br />   (setq newline2 (hel_Line pt1 pt2))<br />   (vlax-put-property newline 'Color 1)<br />   (vlax-put-property newline1 'Color 2)<br />   (vlax-put-property newline2 'Color 2)<br />   (vlax-put-property newline 'LineType "dash")<br />   (while st<br />     (setq get (grread 1))<br />     (if (= (hel_n1h get) 5)<br />       (progn<br />   (setq pt2 (hel_n2h get))<br />         (setq rad (+ (angle pt1 pt2) (/ pi 2)))<br />         (setq pt11 (polar pt1 rad -100))<br />         (setq pt12 (polar pt2 rad -100))<br />         (setq pt21 (polar pt1 rad 100))<br />         (setq pt22 (polar pt2 rad 100))<br />   (vlax-put-property newline 'EndPoint (vlax-3d-point pt2))<br />   (Vlax-Put-Property newline1 'EndPoint (Vlax-3d-Point pt12) )<br />   (Vlax-Put-Property newline1 'StartPoint (Vlax-3d-Point pt11) )<br />   (Vlax-Put-Property newline2 'EndPoint (Vlax-3d-Point pt22) )<br />   (Vlax-Put-Property newline2 'StartPoint (Vlax-3d-Point pt21) )<br />       )<br />       (setq st nil)<br />     )<br />   )<br /> <br /> )<br /> <br />

该贴已经同步到 叶曲冰寒的微博

hao3ren

缺少hel_Line

cnks

支持一下源码！

叶曲冰寒

hao3ren 发表于 2014-6-12 18:42
缺少hel_Line

;;;由两点画一条直线
(defun hel_Line(spt ept)
  (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ModelSpace) 'AddLine (Vlax-3d-Point spt) (Vlax-3d-Point ept))
)

叶曲冰寒

cnks 发表于 2014-6-12 19:33
支持一下源码！

长老好！

richine001

不错,不错,

xyp1964

瞎叫好：缺少hel_n1h及hel_n2h
hel_n1h ＝ car
hel_n2h = cadr

e2002

实际工作中不会这样画梁的哦

xyp1964

;; 凑个热闹

2. (defun c:tt (/ pt1 l0 l1 l2 st gr pt2 rad pt11 pt12 pt21 pt22)
   
3.   (defun line (p1 p2); 两点画直线
   
4.     (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
   
5.     (entlast)
   
6.   )
   
7.   (setq pt1 (getpoint)
   
8.         l0  (line pt1 pt1)
   
9.         l1  (line pt1 pt1)
   
10.         l2  (line pt1 pt1)
    
11.         st  t
    
12.   )
    
13.   (xyp-SubUpd l0 62 1)
    
14.   (xyp-SubUpd l0 6 "center")
    
15.   (xyp-SubUpd l1 62 2)
    
16.   (xyp-SubUpd l2 62 2)
    
17.   (while st
    
18.     (setq gr (grread 1))
    
19.     (if (= (car gr) 5)
    
20.       (progn
    
21.         (setq pt2 (cadr gr)
    
22.               rad  (+ (angle pt1 pt2) (* pi 0.5))
    
23.               pt11 (polar pt1 rad -100)
    
24.               pt12 (polar pt2 rad -100)
    
25.               pt21 (polar pt1 rad 100)
    
26.               pt22 (polar pt2 rad 100)
    
27.         )
    
28.         (xyp-SubUpd l0 11 pt2)
    
29.         (xyp-SubUpd l1 '(10 11) (list pt11 pt12))
    
30.         (xyp-SubUpd l2 '(10 11) (list pt21 pt22))
    
31.       )
    
32.       (setq st nil)
    
33.     )
    
34.   )
    
35.   (princ)
    
36. )

(defun c:tt (/ pt1 l0 l1 l2 st gr pt2 rad pt11 pt12 pt21 pt22)<br />   (defun line (p1 p2); 两点画直线<br />     (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))<br />     (entlast)<br />   )<br />   (setq pt1 (getpoint)<br />         l0  (line pt1 pt1)<br />         l1  (line pt1 pt1)<br />         l2  (line pt1 pt1)<br />         st  t<br />   )<br />   (xyp-SubUpd l0 62 1)<br />   (xyp-SubUpd l0 6 "center")<br />   (xyp-SubUpd l1 62 2)<br />   (xyp-SubUpd l2 62 2)<br />   (while st<br />     (setq gr (grread 1))<br />     (if (= (car gr) 5)<br />       (progn<br />         (setq pt2 (cadr gr)<br />               rad  (+ (angle pt1 pt2) (* pi 0.5))<br />               pt11 (polar pt1 rad -100)<br />               pt12 (polar pt2 rad -100)<br />               pt21 (polar pt1 rad 100)<br />               pt22 (polar pt2 rad 100)<br />         )<br />         (xyp-SubUpd l0 11 pt2)<br />         (xyp-SubUpd l1 '(10 11) (list pt11 pt12))<br />         (xyp-SubUpd l2 '(10 11) (list pt21 pt22))<br />       )<br />       (setq st nil)<br />     )<br />   )<br />   (princ)<br /> )

叶曲冰寒

xyp1964 发表于 2014-6-12 22:01
;; 凑个热闹

大神也来捧场
我想问一下，我这样处理在画的时候没有对象捕捉，请问如何才能像CAD命令一样有对象捕捉？