wjl1014 发表于 2012-12-5 18:32:47

发一些基本的用法。

1、利用pline线绘制箭头
Sub Example_AddLightWeightPolyline()
Dim plineObj As AcadLWPolyline
Dim points(0 To5) As Double
points(0) =0: points(1) = 0 points(2) = 100: points(3) =0
points(4) = 120: points(5) = 0
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
Call plineObj.SetWidth(0, 1, 1)　　Call plineObj.SetWidth(1, 4, 0)　 End Sub

wjl1014 发表于 2012-12-5 18:53:33

2、绘制已知线段的对称线。
Dim FstPnt As Variant
Dim SndPnt As Variant
dim pt1(0 to 2)as double
dim pt2(0 to2)as double

FstPnt = ThisDrawing.Utility.GetPoint(, "选取矩形第一角点：")
SndPnt = ThisDrawing.Utility.GetCorner(FstPnt, "选取矩形对角点：")
'画对角线
Dim plineObj1 As AcadLine
    Set plineObj1 = ThisDrawing.ModelSpace.AddLine(FstPnt, SndPnt)
pt1(0) = FstPnt(0): pt1(1) = SndPnt(1): pt1(2) = 0
pt2(0) = SndPnt(0): pt2(1) = FstPnt(1): pt2(2) = 0
Dim plineObj2 As AcadLine
    Set plineObj2 = ThisDrawing.ModelSpace.AddLine(pt1, pt2)

wjl1014 发表于 2012-12-5 18:58:49

3、在图上拾取斜线段的两个端点，求以此斜线段为对角线的矩形的左下角点。
Dim FstPnt As Variant
Dim SndPnt As Variant
dim pt(0 to 1)as double
FstPnt = ThisDrawing.Utility.GetPoint(, "选取矩形第一角点：")
SndPnt = ThisDrawing.Utility.GetCorner(FstPnt, "选取矩形对角点：")
If FstPnt(0) > SndPnt(0) Then
pt(0) = SndPnt(0)
Else
pt(0) = FstPnt(0)
End If

If FstPnt(1) > SndPnt(1) Then
pt(1) = SndPnt(1)
Else
pt(1) = FstPnt(1)
End If

end sub

yaokui25 发表于 2012-12-8 22:46:09

嘿嘿~继续，关注中

jialezi168 发表于 2012-12-9 21:39:50

学习学习了，谢谢分享









http://www.69sodu.com/img1.jpg
69sodu.com 大周皇族

zz0147 发表于 2012-12-10 19:11:40

学习一下。。。

wjl1014 发表于 2013-1-1 18:55:26

本帖最后由 wjl1014 于 2013-1-1 18:55 编辑

选择最后绘制的图形，并进行填充：
(setq la (entlast))
(command "_bhatch" "p" "ANSI31" "50" "0" "s" la "" "")

wjl1014 发表于 2013-1-29 12:06:34

本帖最后由 wjl1014 于 2013-1-29 12:07 编辑

利用entmake制作箭头：


(defun C:tt (/ pt1 pt2 pt3ang)
(setvar "CMDECHO" 0)
(setvar "TEXTEVAL" 1)
(setq pt1 (getpoint "\n指定起点->"))
(setq pt2 (getpoint pt1 "\n指定终点->"))
(setq ang (angle pt1 pt2))
(setq dis (distance pt1 pt2))
(setq pt3 (polar pt1ang (* 0.8 dis)))

(setq x1 (car pt1))
(setq y1 (cadr pt1))
(setq x2 (car pt2))
(setq y2 (cadr pt2))
(setq x3 (car pt3))
(setq y3 (cadr pt3))
(setq width1 (/ dis 50))
(setq width2 (/ dis 10))

(entmake
    (list
      '(0 . "lwpolyLINE")

    '(100 . "AcDbEntity")
    '(67 . 0)
    '(410 . "Model")
    '(100
      .
      "AcDbPolyline"
   )
    '(90 . 3)
    '(70 . 0)
    '(38 . 0.0)
    '(39 . 0.0)
    (cons 10 (list x1 y1))
    (cons 40width1)
    (cons 41 width1)
    '(42 . 0.0)
      
    (cons 10 (list x3 y3))
    (cons 40 width2)
'(41 . 0.0)
    '(42 . 0.0)
    (cons 10 (list x2 y2))
    '(40 . 0.0)
    '(41 . 0.0)
    '(42 . 0.0)
    '(210 0.0 0.0 1.0)
)
)

(setvar "CMDECHO" 1)
)

页: [1]
查看完整版本: 发一些基本的用法。