创建椭圆然后填充的VLISP代码

newer · 发表于 2016-9-4 09:32:28

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

下面代码根据参数先创建一个椭圆，然后填充它。

(defun c:hatchtest ( / cen hat maj mni rat spc )
(if
(and
(setq cen (getpoint "\nSpecify ellipse center: "))
(setq maj (getpoint cen "\nSpecify major axis endpoint: "))
(setq mni (getpoint cen "\nSpecify minor axis length: "))
)
(progn
(if (< 1.0 (setq rat (/ (distance cen mni) (distance cen maj))))
(mapcar 'set
'( mni maj rat )
(list maj mni (/ 1.0 rat))
)
)
(vla-appendouterloop
(setq hat
(vla-addhatch
(setq spc
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
achatchpatterntypepredefined
"SOLID"
:vlax-true
achatchobject
)
)
(vlax-make-variant
(vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0))
(list
(vla-addellipse spc
(vlax-3D-point (trans cen 1 0))
(vlax-3D-point (trans (mapcar '- maj cen) 1 0))
rat
)
)
)
)
)
(vla-evaluate hat)
)
)
(princ)
)

(defun c:hatchtest ( / cen hat maj mni rat spc ) 
    (if 
        (and 
            (setq cen (getpoint     "\nSpecify ellipse center: ")) 
            (setq maj (getpoint cen "\nSpecify major axis endpoint: ")) 
            (setq mni (getpoint cen "\nSpecify minor axis length: ")) 
        ) 
        (progn 
            (if (< 1.0 (setq rat (/ (distance cen mni) (distance cen maj)))) 
                (mapcar 'set 
                   '( mni maj rat ) 
                    (list maj mni (/ 1.0 rat)) 
                ) 
            ) 
            (vla-appendouterloop 
                (setq hat 
                    (vla-addhatch 
                        (setq spc 
                            (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) 
                                (if (= 1 (getvar 'cvport)) 
                                    'paperspace 
                                    'modelspace 
                                ) 
                            ) 
                        ) 
                        achatchpatterntypepredefined 
                        "SOLID" 
                        :vlax-true 
                        achatchobject 
                    ) 
                ) 
                (vlax-make-variant 
                    (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) 
                        (list 
                            (vla-addellipse spc 
                                (vlax-3D-point (trans cen 1 0)) 
                                (vlax-3D-point (trans (mapcar '- maj cen) 1 0)) 
                                rat 
                            ) 
                        ) 
                    ) 
                ) 
            ) 
            (vla-evaluate hat) 
        ) 
    ) 
    (princ) 
)

[it618postdisplay>0]

(vl-load-com) (princ)

[/it618postdisplay]

lucas3 · 发表于 2016-9-4 10:44:52

N版这么早啊，周末不休息啊

ynhh · 发表于 2016-9-4 13:07:44

谢谢版主
的分享

819534890 · 发表于 2016-9-4 17:49:26

回复学习学习

tzfcn · 发表于 2016-9-4 17:56:54

好的，我回复了

q3_2006 · 发表于 2016-9-4 18:22:11

明经瘫痪..晓东感觉热闹了不少呀...

yoyoho · 发表于 2016-9-4 18:42:10

q3_2006 发表于 2016-9-4 18:22
明经瘫痪..晓东感觉热闹了不少呀...

真的好像是这样喔!

llsheng_73 · 发表于 2016-9-4 18:48:04

留个记号，用得着的时候再来学习。。。

lisp_beginner · 发表于 2016-9-4 18:53:52

q3_2006 发表于 2016-9-4 18:22
明经瘫痪..晓东感觉热闹了不少呀...

晓东和明经的是一拨人还是两拨人？

zjh2785 · 发表于 2016-9-4 23:16:40

谢谢分享！

q3_2006 · 发表于 2016-9-5 07:42:52

lisp_beginner 发表于 2016-9-4 18:53
晓东和明经的是一拨人还是两拨人？

不清楚...

HLCAD · 发表于 2016-9-5 07:48:18

非常感谢版主的程序！！！

yanchao316 · 发表于 2016-12-28 12:52:25

啥也不说了，感谢楼主分享哇！

shenfjliu · 发表于 2016-12-29 21:44:05

在学习学习

qyming1996 · 发表于 2017-6-14 11:53:56

回复学习学习

账号		自动登录	找回密码
密码			立即注册

[每日一码] 创建椭圆然后填充的VLISP代码

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评