叶曲冰寒 发表于 2014-6-12 16:54:56

汇报汇报学习情况，画梁

本帖最后由 叶曲冰寒 于 2014-6-12 17:03 编辑

(defun c:tt()

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

)

http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 叶曲冰寒的微博

hao3ren 发表于 2014-6-12 18:42:48

缺少hel_Line

cnks 发表于 2014-6-12 19:33:52

支持一下源码！

叶曲冰寒 发表于 2014-6-12 20:33:59

hao3ren 发表于 2014-6-12 18:42 static/image/common/back.gif
缺少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))
)

叶曲冰寒 发表于 2014-6-12 20:34:55

cnks 发表于 2014-6-12 19:33 static/image/common/back.gif
支持一下源码！

长老好！

richine001 发表于 2014-6-12 21:19:50

不错,不错,

xyp1964 发表于 2014-6-12 21:35:49

本帖最后由 xyp1964 于 2014-6-12 21:58 编辑

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

e2002 发表于 2014-6-12 21:48:53

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

xyp1964 发表于 2014-6-12 22:01:34

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

叶曲冰寒 发表于 2014-6-13 07:37:12

xyp1964 发表于 2014-6-12 22:01 static/image/common/back.gif
;; 凑个热闹

大神也来捧场
我想问一下，我这样处理在画的时候没有对象捕捉，请问如何才能像CAD命令一样有对象捕捉？
页: [1] 2
查看完整版本: 汇报汇报学习情况，画梁