邹锋 发表于 2014-9-28 17:59:48

画胶圈






下面有几个函数，在这很难找到
发上来给大家用用


;;取实体名,两点,做镜像返回镜像后实体
(defun Mirror(name pt pt1 / eobj vlapt1 vlapt2)
;(mapcar '(lambda (x y) (set x (vlax-ename->vla-object y))) '(obj1 obj2 obj3) (LIST en1 en2 en3));批量转换名字
(setq eobj (vlax-ename->vla-object name)
        vlapt1 (vlax-3D-point pt);;转换为VLA点
        vlapt2 (vlax-3D-point pt1)
        )
;(vla-put-Layer eobj "cool");设置它为COOL图层
(vlax-vla-object->ename (vla-Mirror eobj vlapt1 vlapt2))
)


;;对点表与凸度合成的表生成PLINE线
(defun mkpline(lst /lx newlst);;
;(setq lst '((-13.0 8.5) -0.414214 (-3.0 18.5) (3.0 18.5)))
(setq newlst (list(cons 70 1)
                      (cons 90 1)
                      '(100 . "AcDbPolyline")
                      '(100 . "AcDbEntity")
                      '(0 . "LWPOLYLINE")
                      )
        )
(setq i 0)
(repeat (length lst)
    (setq lx (car lst))
    (cond ((= (type lx) 'list)
           (setq newlst (cons (cons 10 lx) newlst))
           (setq i (1+ i))
           )
          ((= (type lx) 'real)          
           (setq newlst (cons (cons 42 lx) newlst))
           )
          )
    (setq lst (cdr lst))
    )
(setq newlst (reverse newlst))
(setq newlst (subst (cons 90 i) (cons 90 1) newlst))
(entmake newlst)
)



;;选择一封闭实体生成填充
;;来源在明经葵花宝典函数帮助找到，本人优化
(defun mkhatch (en / enobj hatchobj mspace outerloop)
(vl-load-com)
(setq        mspace
       (vla-get-modelspace
           (vla-get-activedocument (vlax-get-acad-object))
       )
)
(setq enobj (vlax-ename->vla-object en))
(setq        hatchobj (vla-addhatchmspace 0"ansi37" :VLAX-false))
(setq        outerloop (vlax-make-safearray vlax-vbobject '(0 . 0)))
(vlax-safearray-fill outerloop (list enobj));;;可添加更多实体作为边界
(vla-appendouterloop hatchobj outerloop)
(vla-put-patternscale hatchobj 0.1);设置它的比例
;(vla-put-layer hatchobj "cool");;设置它的图层
(vlax-vla-object->ename hatchobj);;返回图元名
)

邹锋 发表于 2014-9-28 18:01:30

我所学的都来自明经，我发的全是源码做为回报 。本人在此不发VLX 不发，FAS,

ysq101 发表于 2014-9-28 19:09:04

楼主很脸熟啊。。
也混燕秀吧

lucas_3333 发表于 2014-9-28 20:59:55

参数化设计的思路很好！很好的范例，作为机械行业，很希望有这个样的参数化画同步轮，齿轮的 范例（论坛有一个画链轮的对话框版本不错）

maiko 发表于 2014-9-29 09:10:38

mkhatch感觉这个函数没有发挥很大作用.对象只能图元

ynhh 发表于 2014-9-29 09:22:33

本人在此不发VLX 不发，FAS
楼主此言
甚是豪情

cnks 发表于 2014-9-29 12:05:56

发源码就要支持！

自贡黄明儒 发表于 2014-9-29 12:56:31

这个胶圈太专业，一般我们不用。
但是源码就得支持，看楼主思路。

邹锋 发表于 2014-9-29 18:59:15

自贡黄明儒 发表于 2014-9-29 12:56 static/image/common/back.gif
这个胶圈太专业，一般我们不用。
但是源码就得支持，看楼主思路。

密封圈呀，油压那也要，机器上一般都有

xianaihua 发表于 2014-9-29 22:50:29

建议将绝对路径改为相对路径，这样就没必要将程序复制到cad安装目录下！(setqappdir
   (vl-string-translate
   "\\"
   "/"
   (strcat (vl-filename-directory (findfile "cooljq.LSP"))
       "/"
   )
   )
)
          ;设置hasco运水参数
(setq hpl (read_cool_file (strcat appdir "Hasco_Z98.TXT")))
(setq L1 (car hpl))
(setq cl1 (cadr hpl))


(setq Papl (read_cool_file (strcat appdir "ParKer.TXT")))
(setq L2 (car Papl))
(setq cl2 (cadr Papl))

(setq Dpl (read_cool_file (strcat appdir "DME_DR.TXT")))
(setq L3 (car Dpl))
(setq cl3 (cadr Dpl))

;;;;;;;;;;;;;;;;;;;;;;;;
(setq dcl_id (load_dialog (strcat appdir "cooljq.DCL")))
(if (not (new_dialog "cooljq" dcl_id))
    (progn (alert "不能装入对话框") (exit))
)
(setqtmplst1'(D1 D2 D3 D4 D5 D6)
tmplst2(LIST "dd1" "dd2" "dd3" "dd4" "dd5" "dd6")
)
;;;方便以下简写代码
(show_sld "img1" (strcat appdir "jiaoquan.sld"))
页: [1]
查看完整版本: 画胶圈