各位大哥，帮我编个五金模板穿丝孔的程式，有难度哦

psufngah

好像是正数或负数，就可以向内或向外。封闭的和不封闭的刚好相反

psufngah

;;;穿线孔程序
(defun c:lah(/ i nent ssent ssentset varclayer varcmdecho varosmode elayer nlayer)
  (setq varosmode (getvar "OSMODE") varclayer (getvar "CLAYER"))
  (setvar "OSMODE" 0)
  (setvar "CMDECHO" 0)
  (command "undo" "be")
  (princ "\n选择要画穿线孔的图元")
  (setq ssentset (ssget '((-4 . "<OR")(0 . "CIRCLE")(0 . "LWPOLYLINE")(-4 . "OR>"))))
  (if (/= ssentset nil)
    (progn
      (setq i 0 nent (sslength ssentset))
      (repeat nent
        (setq ssent (entget (ssname ssentset i)))
        (if (= "LWPOLYLINE" (cdr (assoc 0 ssent)));;;判断是否为多义线
;;;        (if (= 1 (cdr (assoc 70 ssent)))
          (L212A ssent);;;是否为闭合多义线
          
        (if (= "CIRCLE" (cdr (assoc 0 ssent)))(L212C ssent));;;;判断是否为圆形
      )
      (setq i (1+ i))
    )
   )
)
  (setvar "OSMODE" varosmode)
  (setvar "CLAYER" varclayer)
  (command "undo" "e")
  (princ "\n----OK----")
  (princ)
  )

(defun L212A(ssent / tempssent strlayer j1 j2 listpt numpt xmin xmax ymin ymax)
  (setq strlayer (cdr (assoc 8 ssent)))
  (if (= "0" strlayer)(progn(alert "请将选中的图元变成模板图层!")(exit)))
  (setq nlayer (strcat strlayer "DIM"))
  (setvar "CLAYER" nlayer)
  (setq j1 0 j2 0 numpt (cdr (assoc 90 ssent)))          ;numPt 顶点个数
  (setq tempssent (member (assoc 10 ssent) ssent))  ;取得顶点表
  (setq listpt '())
  (while (< j1 numpt)  ;第12个表是多义线的第一个顶点
    (setq listpt (append listpt (list (trans (cdr (nth (* j1 4) tempssent)) 0 1))))
    (setq j1 (1+ j1))
  )
  (setq xmin (car (nth 0 listpt)) xmax (car (nth 0 listpt)) ymin (cadr (nth 0 listpt)) ymax (cadr (nth 0 listpt)))
  (while (< j2 numpt) ;求最大和最小x,y坐标
    (if        (> xmin (car (nth j2 listpt)))(setq xmin (car (nth j2 listpt))))
    (if        (< xmax (car (nth j2 listpt)))(setq xmax (car (nth j2 listpt))))
    (if        (> ymin (cadr (nth j2 listpt)))(setq ymin (cadr (nth j2 listpt))))
    (if        (< ymax (cadr (nth j2 listpt)))(setq ymax (cadr (nth j2 listpt))))
    (setq j2 (1+ j2))
  )
  (L212B ssent listpt 1)
  )


(defun L212B(ssent listpt flag / cxkpt cxkpt2 dist endpt crr ispt j3 j4 k1 len m m1 numlen numpt
             hb nlayer crr startpt tmplist1 tmplist2 ispt1 rad)
  (setq j3 0 numpt (length listpt) numlen '())
;;取得多义线直线边的序号与长度
  (while (< j3 numpt)
    (if        (= 0 (cdr (nth (+ 5 (* 4 j3)) ssent)))
      (progn
        (setq startpt (nth j3 listpt));;起始点
        (setq endpt (nth (rem (1+ j3) numpt) listpt));;;结束点
        (setq dist (distance startpt endpt));;;起始至结束点的距离
        (setq numlen (append numlen (list (list j3 dist))));;加入表
      )
    )
    (setq j3 (1+ j3))
  )
;;;按长度排序
  (if (/= (setq len (length numlen)) 0)
    (progn
      (setq j4 0)
      (while (< j4 len)
        (setq tmplist1 (nth j4 numlen))
        (setq k1 0)
        (while (< k1 len)
          (setq tmplist2 (nth k1 numlen))
          (if (> (cadr tmplist1) (cadr tmplist2))
            (progn
              (setq numlen (subst '() tmplist1 numlen))
              (setq numlen (subst tmplist1 tmplist2 numlen))
              (setq numlen (subst tmplist2 '() numlen))
              (setq tmplist1 (nth j4 numlen))
            )
          )
          (setq k1 (1+ k1))
        )
        (setq j4 (1+ j4))
      )
    )
  )

  (if (/= numlen nil)
    (progn
      (setq m 0 ispt 0)
      (while (and (< m (length numlen))(= ispt 0))
        (setq ispt (L212D m numlen))
        (setq m (1+ m))
      )
      (if (= ispt 1)(progn
                      (cxk 3 "w3" cxkpt nlayer )
;;;                      (command "CIRCLE" cxkpt 1.5)
                      ))
      (if (= ispt 0)
        (progn
        (setq m1 0 ispt1 0)
        (while (and (< m1 (length numlen))(= ispt1 0))
        (setq ispt1 (L212E m1 numlen))
        (setq m1 (1+ m1))
      )
        (if (/= ispt1 0)
          (if (= rad 1)
            (progn
              (cxk 2 "w2" cxkpt2 nlayer )
              )
              (command "CIRCLE" cxkpt2 rad)
            )
          )
        )
    )
      )
    )
)

(defun L212C(ssent / strlayer pt pt1 radius nlayer);;;;穿线孔图层设定及圆孔的穿线孔
  (setq strlayer (cdr (assoc 8 ssent)))
  (if (= "0" strlayer)(progn(alert "请将选中的图元变成模板图层!")(exit)))
  (setq nlayer (strcat strlayer "DIM"))
  (setvar "CLAYER" nlayer)
  (setq radius (cdr (assoc 40 ssent)))
  (setq pt (cdr (assoc 10 ssent)))
  (setq pt (trans pt 0 1))
  (setq pt1 (polar pt (* 0.25 pi) (- radius 5)))
  (if(>= radius 10)(progn (setq hb "w3")
                      (setq crr 3)
                      (cxk crr hb pt1 nlayer ))
                   (progn (setq hb "w2")
                      (setq crr 2)
                      (cxk crr hb pt1 nlayer ))
  )
  )

(defun L212D(m numlen / ang1 ang2 crad        d1 d2 endpt entarea ept j5 j6 j7 k2 k3 lrad midpt mpt nflag pt1        pt2 pt3
              ptarea ptno spt startpt tmppt x23max x23min y23max y23min)
  (setq ptno (car (nth m numlen)))
;;求边中点
  (setq startpt (nth ptno listpt))
  (setq endpt (nth (rem (1+ ptno) numpt) listpt))
  (setq        midpt (list (/ (+ (car startpt) (car endpt)) 2.0)(/ (+ (cadr startpt) (cadr endpt)) 2.0)))
  ;求边的角度       
  (setq lrad (angle startpt endpt));;;弧度除以派值*180等于角度
;;求表中顶点围成的面积
  (setq j5 0)
  (command "AREA")
  (while (< j5 numpt)(command (nth j5 listpt))(setq j5 (1+ j5)))
  (command "")
  (setq entarea (getvar "AREA"))
;;参考点
  (setq crad (+ lrad (* pi 0.5)));;;与长边垂直角度
  (setq tmppt (polar midpt crad 0.1))
;求加入tmpPt后的面积
  (setq j6 0)
  (command "AREA")
  (while (<= j6 ptno)(command (nth j6 listpt))(setq j6 (1+ j6)))
  (command tmppt)
  (while (< j6 numpt)(command (nth j6 listpt))(setq j6 (1+ j6)))
  (command "")
  (setq ptarea (getvar "AREA"))
;cRad 长边中点与穿线孔的角度
  (if (> ptarea entarea)(setq crad (+ crad pi)));;;确定穿线孔是向外还是向内，如果向外则修正到向内
;确定坐标并画出穿线孔
  (if (= flag 0)
    (progn
      (setq crad (+ crad pi))
      (setq cxkpt (polar midpt crad 3));;设置穿线孔的中心点为中线向内偏3MM
      (setq nflag 1)
      nflag
    )
    (progn
      (setq cxkpt (polar midpt crad 4));;设置穿线孔的中心点为中线向内偏4MM
      (setq j7 0)
      (setq k2 0)
      (while (< j7 (length listpt))
        (if(/=(inters cxkpt (list (car cxkpt) (- ymin 0.5)) (nth j7 listpt) (nth (rem (1+ j7) (length listpt)) listpt)) nil)
          (setq k2 (1+ k2)))
        (setq j7 (1+ j7))
      );;;求交点
      (if (= (rem k2 2) 1)
        (progn
          (setq nflag 1)
          (setq k3 0)
          (while (< k3 numpt)
            (setq spt (nth k3 listpt))
            (setq ept (nth (rem (1+ k3) numpt) listpt))
            (setq ang1 (angle spt ept))
            (setq ang2 (+ (* 0.5 pi) ang1))
            (setq pt1 (polar cxkpt ang2 0.1))
            (setq mpt (inters spt ept cxkpt pt1 nil))
            (setq d2 (distance cxkpt mpt))
            (if        (< d2 2.999)
;;;由于有误差,故用2.999代替3
              (progn
                (setq d1 (sqrt (- (* 5 5) (* d2 d2)));;以实数形式返回平方根
                )
                (setq pt2 (polar mpt ang1 d1))
                (setq
                  pt3 (polar mpt (+ ang1 pi) d1)
                )
                (setq
                  y23min (min (cadr pt2)
                              (cadr pt3)
                         )
                )
                (setq x23min
                       (min (car pt2) (car pt3))
                )
                (setq
                  y23max (max (cadr pt2)
                              (cadr pt3)
                         )
                )
                (setq x23max
                       (max (car pt2) (car pt3))
                )
                (if
                  (not
                    (or
                      (and (> (car ept) x23max)
                           (> (cadr ept)y23max)
                           (> (car spt) x23max)
                           (> (cadr spt)y23max))
                      (and (< (car ept) x23min)
                           (< (cadr ept)y23min)
                           (< (car spt) x23min)
                           (< (cadr spt)y23min))
                      (and (< (car ept) x23min)
                           (> (cadr ept)y23max)
                           (< (car spt) x23min)
                           (> (cadr spt)y23max))
                      (and (> (car ept) x23max)
                           (< (cadr ept)y23min)
                           (> (car spt) x23max)
                           (< (cadr spt)y23min))
                    )
                  )
                   (setq nflag 0)
                );;;end if
              );;;end progn
            );;;end if 2.999
            (setq k3 (1+ k3))
          );;end while
        );;;end progn
        (setq nflag 0)
      );;;end if
      nflag
    )
  )
)

(defun L212E(m1 numlen / ang1 ang2 crad        d1 d2 endpt entarea ept j5 j6 j7 j8 k2 k3 lrad midpt mpt nflag pt1 pt2 pt3
               ptarea ptno spt startpt tmppt tmplen dddd cxkarea cxkpt1 dddd5 cxkptmp)
  (setq ptno (car (nth m1 numlen)))
;;求边中点
  (setq startpt (nth ptno listpt))
  (setq endpt (nth (rem (1+ ptno) numpt) listpt))
  (setq        midpt (list (/ (+ (car startpt) (car endpt)) 2.0)(/ (+ (cadr startpt) (cadr endpt)) 2.0)))
  ;求边的角度       
  (setq lrad (angle startpt endpt));;;弧度除以派值*180等于角度
;;;求表中顶点围成的面积
  (setq j5 0)
  (command "AREA")
  (while (< j5 numpt)(command (nth j5 listpt))(setq j5 (1+ j5)))
  (command "")
  (setq entarea (getvar "AREA"))
;;参考点
  (setq crad (+ lrad (* pi 0.5)));;;与长边垂直角度
  (setq tmppt (polar midpt crad 0.1))
;;求加入tmpPt后的面积
  (setq j6 0)
  (command "AREA")
  (while (<= j6 ptno)(command (nth j6 listpt))(setq j6 (1+ j6)))
  (command tmppt)
  (while (< j6 numpt)(command (nth j6 listpt))(setq j6 (1+ j6)))
  (command "")
  (setq ptarea (getvar "AREA"))
;;cRad 长边中点与穿线孔的角度
  (if (> ptarea entarea)(setq crad (+ crad pi)));;;确定穿线孔是向外还是向内，如果向外则修正到向内
;;确定坐标并画出穿线孔
      (setq cxkptmp (polar midpt crad 2.5));;设置穿线孔的中心点为中线向内偏2.5MM,临时点
      (setq j7 0)
      (setq k2 0)
      (while (< j7 (length listpt))
        (if(/=(inters cxkptmp (list (car cxkptmp) (- ymin 0.5)) (nth j7 listpt) (nth (rem (1+ j7) (length listpt)) listpt)) nil)
          (setq k2 (1+ k2)))
        (setq j7 (1+ j7))
      );;;求交点
   (if (= (rem k2 2) 1)
        (progn
          (setq k3 0)
          (setq tmplen'())
          (while (< k3 numpt)
            (setq spt (nth k3 listpt))
            (setq ept (nth (rem (1+ k3) numpt) listpt))
            (setq ang1 (angle spt ept))
            (setq ang2 (+ (* 0.5 pi) ang1))
            (setq pt1 (polar cxkptmp ang2 0.1))
            (setq mpt (inters spt ept cxkptmp pt1 nil))
            (setq d2 (distance cxkptmp mpt))
            (setq tmplen (append tmplen (list d2)))
            (setq k3 (1+ k3))
          );;end while
(if        (<= (car(vl-sort tmplen '<)) 2.999)
              (progn
              (setq dddd(+(car(vl-sort tmplen '<)) 2.5))
              (if (and (< dddd 7)(>= dddd 4))
                (progn
                  (setq cxkpt2 (polar midpt crad (/ dddd 2)));;设置穿线孔的中心点为中线向内偏居中
                  (setq rad 1.0))
                (progn
                (setq cxkpt2 (polar midpt crad (/ dddd 2)))
                (setq rad 0.25))
                )
              )
;;;  (progn(setq rad 1)(setq cxkpt2 cxkptmp))
            );;;end if
        );;;end progn
    (progn
            (setq k3 0)
            (setq tmplen'())
            (while (< k3 numpt)
            (setq spt (nth k3 listpt))
            (setq ept (nth (rem (1+ k3) numpt) listpt))
            (setq ang1 (angle spt ept))
            (setq ang2 (+ (* 0.5 pi) ang1))
            (setq pt1 (polar cxkptmp ang2 0.1))
            (setq mpt (inters spt ept cxkptmp pt1 nil))
            (setq d2 (distance cxkptmp mpt))
            (setq tmplen (append tmplen (list d2)))
            (setq k3 (1+ k3))
          );;end while
  (if (<= (car(vl-sort tmplen '<)) 2)
      (setq dddd5 (+(car(vl-sort tmplen '<)) 2.5))
      (setq cxkpt1 (polar midpt crad dddd5)))
   (setq j8 0)
  (command "AREA")
  (while (<= j8 ptno)(command (nth j8 listpt))(setq j8 (1+ j8)))
  (command cxkpt1)
  (while (< j8 numpt)(command (nth j8 listpt))(setq j8 (1+ j8)))
  (command "")
  (setq cxkarea (getvar "AREA"))
(if (>= cxkarea entarea)
              (progn
              (setq dddd (- 2.5(car(vl-sort tmplen '<))))
                (setq cxkpt2 (polar midpt crad (/ dddd 2)))
                (setq rad 0.25))
              (progn
              (setq dddd (+ 2.5(car(vl-sort tmplen '<))))
                (setq cxkpt2 (polar midpt crad (/ dddd 2)))
                (setq rad 0.25))
      );;;end if
  )
)
  (setq nflag 1)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;插入穿线孔属性块子程序;;;;;;;;;;

(defun cxk(crr hb pt nlayer  /  pt1 name ssentity)
(setvar "osmode" 0)
(setq pt1 (polar pt (/ pi 4)(* crr 1.3))) ;;;属性块文字放置坐标
(setq name (strcat "CHK_"nlayer"_" hb));;;CHK_sbdim_w 属性块名称格式
      (if(not(tblsearch "block" name));;搜索同名块，如果没有则新建
         (progn
          (setq ssentity (ssadd));;;建空选集
          (setvar "clayer" nlayer)
          (command "circle" pt "d" crr) (ssadd (entlast) ssentity)
          (setvar "clayer" "mark")
          (command "attdef" "I" "" "ZU" "类型注解" "" pt1 0.0002 0) (ssadd (entlast) ssentity)
          (command "attdef" "" "CH" "内径" "" pt1 0.0002 0) (ssadd (entlast) ssentity)
          (command "attdef" "I" "" "DH" "代号" "" pt1 1.5 0) (ssadd (entlast) ssentity);;;可见的代号
          (setvar "clayer" nlayer)(command "block" name pt ssentity "")
          (command "insert" name pt 1 1 0 "穿线孔" crr  hb)
          )
        (command "insert" name pt 1 1 0 "穿线孔" crr  hb)
        )
  )
;;;  (if (/= (tblsearch "block" name) nil);;;;搜索同名块，如果有则调用此块
;;;    (progn
;;;        (command "insert" name pt 1 1 0 "穿线孔" crr  hb))))

psufngah

有点小问题，做成块就不行，单画孔可以，对于2MM以下方孔，不准。

sicky111

psufngah 发表于 2013-5-4 17:15
好像是正数或负数，就可以向内或向外。封闭的和不封闭的刚好相反

是正负数，但是输入正数就像多段线里面偏，输入负数才像外面偏，与我想要的正好相反。

sicky111

psufngah 发表于 2013-5-4 17:21
;;;穿线孔程序
(defun c:lah(/ i nent ssent ssentset varclayer varcmdecho varosmode elayer nlayer)
  ...

谢谢兄弟帮忙，但是我试了一下程式出错，ERROR ==> 参数类型错误: stringp nil  OSMODE: 0 +++

sicky111

补充一下，是用一楼附件中的图纸测试的，框选时出现如上错误指示，只能单个选，而且穿丝孔的位置不太理想，对于比较小的多边形，穿丝孔会画到孔外面，还有一些较大的多边形，穿丝孔画不出来，出现这个错误提示：ERROR ==> 参数类型错误: stringp nil  OSMODE: 0 +++

sicky111

知道了，谢谢G版的回复。

690994

支持同行折腾，
如果不是同行很难做出适用你的程式，而且搞这功能很耗时间，
建议你自己搞，才能适用自己。
最好不要用偏移的方法，因为经常有不能偏移的图形，
容易导致整个程式失败。

psufngah

最近比较忙，这个也没时间去完善，上面的参数类型错误，是因为我画的穿线孔为属性块，你把这个注释掉，把我注释掉的command换回来，就可以画得出来了，有些图形还不是很完善。判断条件还不行。我自己也在用这个，等有空了再来整。

kaibing

;;;穿线孔程序
(defun c:lah

这个程式有问题,有的时候会把孔画到外面.