画胶圈

邹锋

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


;;取实体名,两点,做镜像返回镜像后实体
(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-addhatch  mspace 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);;返回图元名
)

邹锋

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

ysq101

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

lucas_3333

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

maiko

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

ynhh

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

cnks

发源码就要支持！

自贡黄明儒

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

邹锋

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

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

xianaihua

建议将绝对路径改为相对路径，这样就没必要将程序复制到cad安装目录下！

2. (setq  appdir
   
3.    (vl-string-translate
   
4.      "\"
   
5.      "/"
   
6.      (strcat (vl-filename-directory (findfile "cooljq.LSP"))
   
7.        "/"
   
8.      )
   
9.    )
   
10.   )
    
11.           ;设置hasco运水参数
    
12.   (setq hpl (read_cool_file (strcat appdir "Hasco_Z98.TXT")))
    
13.   (setq L1 (car hpl))
    
14.   (setq cl1 (cadr hpl))
    
15. 
    
16. 
    
17.   (setq Papl (read_cool_file (strcat appdir "ParKer.TXT")))
    
18.   (setq L2 (car Papl))
    
19.   (setq cl2 (cadr Papl))
    
20. 
    
21.   (setq Dpl (read_cool_file (strcat appdir "DME_DR.TXT")))
    
22.   (setq L3 (car Dpl))
    
23.   (setq cl3 (cadr Dpl))
    
24. 
    
25. ;;;;;;;;;;;;;;;;;;;;;;;;
    
26.   (setq dcl_id (load_dialog (strcat appdir "cooljq.DCL")))
    
27.   (if (not (new_dialog "cooljq" dcl_id))
    
28.     (progn (alert "不能装入对话框") (exit))
    
29.   )
    
30.   (setq  tmplst1  '(D1 D2 D3 D4 D5 D6)
    
31.   tmplst2  (LIST "dd1" "dd2" "dd3" "dd4" "dd5" "dd6")
    
32.   )
    
33. ;;;方便以下简写代码
    
34.   (show_sld "img1" (strcat appdir "jiaoquan.sld"))

(setq  appdir<br />    (vl-string-translate<br />      "\"<br />      "/"<br />      (strcat (vl-filename-directory (findfile "cooljq.LSP"))<br />        "/"<br />      )<br />    )<br />   )<br />           ;设置hasco运水参数<br />   (setq hpl (read_cool_file (strcat appdir "Hasco_Z98.TXT")))<br />   (setq L1 (car hpl))<br />   (setq cl1 (cadr hpl))<br /> <br /> <br />   (setq Papl (read_cool_file (strcat appdir "ParKer.TXT")))<br />   (setq L2 (car Papl))<br />   (setq cl2 (cadr Papl))<br /> <br />   (setq Dpl (read_cool_file (strcat appdir "DME_DR.TXT")))<br />   (setq L3 (car Dpl))<br />   (setq cl3 (cadr Dpl))<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;<br />   (setq dcl_id (load_dialog (strcat appdir "cooljq.DCL")))<br />   (if (not (new_dialog "cooljq" dcl_id))<br />     (progn (alert "不能装入对话框") (exit))<br />   )<br />   (setq  tmplst1  '(D1 D2 D3 D4 D5 D6)<br />   tmplst2  (LIST "dd1" "dd2" "dd3" "dd4" "dd5" "dd6")<br />   )<br /> ;;;方便以下简写代码<br />   (show_sld "img1" (strcat appdir "jiaoquan.sld"))