EASE模型调整的LISP命令代码

noiswan

建模的时候，在绘制3DFACE时，很难去要求每个面的顺序，费时费力。可在AUTOCAD内对建立好的模型进行调整，我用的是AUTOLISP来编写命令（可以将代码粘贴到记事本内，保存后把后缀名改为lsp，然后再autocad内用appload导入就可以用了）。基于的就是前篇的规则。调整的步骤    a：先删除非3DFACE面，用的命令CHEF（在autocad内appload加载后，在命令拦内直接输chef就可以了，以下命令同），lisp代码如下——
(defun c:chef()
  (setq allface(ssget "x"))
  (setq nn(sslength allface))
  (setq noface (ssadd))
  (setq k 0 nface 0 zeroface 0)
  (setq sabcd 3)
  (repeat nn
    (progn
    (setq oface(ssname allface k))
    (setq loface(entget oface))
    (setq nameface(cdr(assoc 0 loface)))
   
    (if (= nameface "3DFACE")
      ;(progn
(setq nface(+ 1 nface))
      (ssadd oface noface)
      )
    (setq k (+ k 1))
    ))
  
  (princ"图中有")(princ nn)(princ"个物体。")
  (princ"\n其中有")(princ nface)(princ"面个。")
  (princ"\n其他类型物体有")(princ (- nn nface))(princ"个。")
  (if (/= 0 (sslength noface))
    (progn
   (initget "Yes No")
   (setq kword(getkword "\n是否要删除非3DFACE的物体Yes/[No]？:"))
   (if (= nil kword)(setq kword "no"))
   (setq akword(strcase kword))
   (if(= akword "YES")(progn
        (command "erase" noface "")
(princ "\n能被删除非3DFACE的物体已被删除。\n请再次使用该命令检查是否删除干净。")  
))
   ))
  (princ)
  )
b：融点，因为3DFACE的捕捉是有一定精度的，捕捉得到的点可能与被捕捉点并不重合，这点如果你打开dxf文件就可以看到。所以必须将应该在一起但由于捕捉精度不够导致实际不在一起的点融在一起，用的命令是rppoint，lisp代码如下——
(defun c:rppoint()
  (setq allface(ssget "x"))
  (setq rpointlist '())
  (setq firstface(ssname allface 0))
  (setq first_data(entget firstface))
  (setq firstp(cdr(assoc 10 first_data)))
  (setq rpointlist(cons firstp rpointlist))
  
  (setq n 0 k 0 kk 0 rn 0)
  (repeat (sslength allface)
    (setq oneface(ssname allface n))
    (setq face_data(entget oneface))
    (repeat 4
      (setq p(cdr(assoc (+ 10 k) face_data)))
      (setq kk 0)(setq spn 0)
      (repeat (length rpointlist)
(setq basep(nth kk rpointlist))
(setq pbasepdistance(distance p basep))
(if(and(<= 0 pbasepdistance)(> 5 pbasepdistance))
   (progn
     ;(princ "\nT")
     ;(princ p)(princ "distance")(princ basep)(princ "=")(princ pbasepdistance)
     ;(princ "\n")(princ rpointlist)
     (setq p basep)
     (setq rp(cons (+ 10 k) p))
     (setq face_data(subst rp (assoc (+ 10 k) face_data) face_data))
     (entmod face_data)
     (if(and(< 0 pbasepdistance)(> 5 pbasepdistance))
       (progn
       (princ "\n刚融合了一个点，现共融合了")(princ (setq rn(+ rn 1)))(princ "个点！"))
       )
     (setq spn(+ spn 1))
     ;(princ "\n")(princ rpointlist)(princ "\n")
     )
   ;(progn
     ;(princ "\nF")
     ;(princ p)(princ "distance")(princ basep)(princ "=")(princ pbasepdistance)
     ;(princ "\n")(princ rpointlist)
     
     ;(princ "\n")(princ rpointlist)(princ "\n")
     ;)
   )
(setq kk(+ 1 kk))
)
      (if (= spn 0)(setq rpointlist(cons p rpointlist)))
      (setq k(+ k 1))
      )
    (setq k 0)
    (princ "\n正在融第")(princ n)(princ "个面，请耐心等待")
    (setq n(+ n 1))
    )
  (princ "\n恭喜你！点融合完毕！")
  )

noiswan

c：最后的一步就是显错误的面了，这个主要是显示有漏洞或者某一面的顶点在另一面的线上。命令SHOWNRFACE，lisp代码如下——
(defun c:shnrface()
    (setvar "cmdecho" 0)
    (setq allface(ssget "x"))
    (setq n 0  allfacelist '() selectfacelist '())
    (subsface)
    (setq selectface allface)
  
    (command "layer" "new" "nrface" "c" 10 "nrface" "" "" "")
    (command "layer" "set" "nrface" "")
   
    (repeat (sslength allface)
      (setq oneface(ssname allface n))
      (setq entitydata(entget oneface))
      (setq p1(cdr(assoc 10 entitydata)))
      (setq p2(cdr(assoc 11 entitydata)))
      (setq p3(cdr(assoc 12 entitydata)))
      (setq p4(cdr(assoc 13 entitydata)))
      (setq allfacelist(cons (list p1 p2 p3 p4 p1) allfacelist))
      (setq n (+ n 1))
      )
   
  
    (setq n 0  nrn 0)
    (repeat (setq sfn(sslength selectface))
      
      (setq face_data(entget (ssname selectface n)))
      (setq a(cdr(assoc 10 face_data)))
      (setq b(cdr(assoc 11 face_data)))
      (setq c(cdr(assoc 12 face_data)))
      (setq d(cdr(assoc 13 face_data)))
      (setq selectfacelist(list a b c d a))
      (setq lineabvalue(sub_checkedge a b))
      (setq linebcvalue(sub_checkedge b c))
      (setq linecdvalue(sub_checkedge c d))
      (setq linedavalue(sub_checkedge d a))
      ;(princ "\n总共有[")(princ sfn)
      ;(princ "]个面要检查，现正检测第[")(princ (+ 1 n))(princ "]个面...  还有[")
      ;(princ (- sfn (+ 1 n)))(princ "]个面未检查！")
      
      (if (= 0 (* lineabvalue linebcvalue linecdvalue linedavalue))
(progn
   (setq face_data(subst '(8 . "nrface")(assoc 10 face_data) face_data))
   (entmod face_data)
   (setq nrn(+ nrn 1))
   )
)
      (if (and (zerop (rem n 10))(< n sfn))
(progn
(princ "\n进展:")(princ (rtos (* 100 (/ (+ 0.0 n) sfn)) 2 0))(princ "%")
(princ "    现错误的面有[")(princ nrn)(princ "]个!")
(princ " 占检查面数的")(princ (rtos (* 100 (/ (+ nrn 1.0) sfn)) 2 0))(princ "%")
)
)
      
      (setq n (+ n 1))
      )
  (princ "\n")
  (princ "\n检测完毕!!!\n------------------------------------------------------\n模型中有")
  (princ (sslength allface))(princ"个面。共检查了")(princ (- n 1))
  (princ "个面。 其中，有错误的面")(princ nrn)
  (princ "个。\n______________________________________________________")
  (princ"\n[提示1：红色(图层名:nrface)的面为错误的面]\n[提示2：有孤立端点或边的面就为错误的面]\n[提示3：命令CHNFACE或CHFACE可进行后续检查]\n")
  (princ)
  )
;(defun sub_checkvertex(l1 l2))
(defun sub_checkedge(l1 l2)
  (setq k 0 outputvalue 0)
  (setq noonefacelist1(cdr(member selectfacelist allfacelist)))
  (setq noonefacelist2(cdr(member selectfacelist (reverse allfacelist))))
  (setq noonefacelist(append noonefacelist1 noonefacelist2))
  (repeat (length noonefacelist)
    (setq kk 0)
    (setq onefacelist(nth k noonefacelist))
    (repeat 4
      (setq l3(nth kk onefacelist))
      (setq l4(nth (+ 1 kk) onefacelist))
      (if (or (and(equal l1 l3)(equal l2 l4)) (and(equal l1 l4)(equal l2 l3)))
(setq outputvalue(+ 1 outputvalue))
)
      (setq kk(+ kk 1))
      )
    (setq k(+ k 1))
    )
  (if(equal l1 l2)(setq outputvalue 1)(setq outputvalue outputvalue))
  )
(defun subsface()
  (setq scsn 0)
  (setq allreflector(ssadd))
  (repeat (sslength allface)
    (setq oent(ssname allface scsn))
    (setq loent(entget oent))
    (setq layername(cdr(assoc 8 loent)))
    (if (/= layername "twofold")
      (ssadd oent allreflector)
      )
    (setq scsn (+ scsn 1))
    )
  (setq allface allreflector)
  )
d：手动改面，如果模型建得不好的话，这部分工作是非常艰巨的。c中命令执行后，错误的面就用红色来表示。要修改这些面。主要有两个方面，点没对齐或者点在线上；还有一种就是有洞，需要自己再加一个面。
e：反复前述过程，直到最后不出现错误面。当然，之后还可以自行调整面的方向，但这一步骤在EASE里面很容易实现。即便如此，我还是把调整面统一顺序的命令ADFACE的LISP代码贴如下——
(defun c:adface()
  ;构造一个已调面选择集，最初元素是指定的基面
  (setq baseface(car(entsel "\n请指定一个方向正确的基面：")))
  (setq allrightface(ssadd baseface))
  (princ "\n请选择需要调整的区域[现使用是默认设置，模型全体！！]：")
  (setq unknowface(ssget "x"))
  (subunface)
  (setq maxk(sslength unknowface))
  (setq unknowface(ssdel baseface unknowface))
  (setq k 0)(setq kk 0)
  (while (or(/= 0 (sslength unknowface))(> k maxk))
    (setq facename1 (ssname allrightface k))
    (setq face1_data(entget facename1))
    (repeat (sslength unknowface)
      (setq facename2(ssname unknowface kk))
      (setq face2_data(entget facename2))
      
      (sub_findonenearface)
      (if (< 0 nearlinenumber)
(progn
   (setq allrightface(ssadd facename2 allrightface))
   (setq unknowface(ssdel facename2 unknowface))
   )
(setq kk(+ kk 1))
)
      (if (= 0 twodirectionindex)(progn(sub_transface)(princ "transfer one")))
      
      )
    (setq kk 0)
    (setq k(+ k 1))
    (princ "\n请耐心等待，现在完成了")(princ k)(princ "个面的判断，必须的进行了调整！")
    )
  (princ "调面完毕！")
  )
  ;subcommand to find one face which near the selection one
  (defun sub_findonenearface()
    (setq face1(list(cdr(assoc 10 face1_data))(cdr(assoc 11 face1_data))(cdr(assoc 12 face1_data))(cdr(assoc 13 face1_data))(cdr(assoc 10 face1_data))))
    (setq face2(list(cdr(assoc 10 face2_data))(cdr(assoc 11 face2_data))(cdr(assoc 12 face2_data))(cdr(assoc 13 face2_data))(cdr(assoc 10 face2_data))))
    (setq n 0)(setq nn 0)(setq nearlinenumber 0)  (setq twodirectionindex 1)
    (while (< n 4)
      (setq a(nth n face1))
      (setq b(nth (+ 1 n) face1))
      (while (< nn 4)
(setq c (nth nn face2))
(setq d (nth (+ 1 nn) face2))
(sub_point_judgeforsamepoint)
(if (< 0 nearlinenumber)(setq nn 4 n 4)(setq nn(+ nn 1)))
)
      (setq nn 0)
      (setq n (+ n 1))
      )
    )
;subcommand to judge the two face is near
(defun sub_point_judgeforsamepoint()
  (if
    (or(and (equal a c)(equal b d)(not(equal a b))(not(equal c d)))
      (and (equal a d)(equal b c)(not(equal a b))(not(equal c d))))
    (setq nearlinenumber(+ nearlinenumber 1))
    )
  (if(and (equal a c)(equal b d))(setq twodirectionindex 0)(setq twodirectionindex 1))
  )

(defun sub_transface()
  (setq ta (append '(10)(cdr(assoc 13 face2_data))))
  (setq tb (append '(11)(cdr(assoc 12 face2_data))))
  (setq tc (append '(12)(cdr(assoc 11 face2_data))))
  (setq td (append '(13)(cdr(assoc 10 face2_data))))
  (setq face2_data(subst ta (assoc 10 face2_data) face2_data))
  (setq face2_data(subst tb (assoc 11 face2_data) face2_data))
  (setq face2_data(subst tc (assoc 12 face2_data) face2_data))
  (setq face2_data(subst td (assoc 13 face2_data) face2_data))
  (entmod face2_data)
  )
(defun subunface()
  (setq scsn 0)
  (setq allreflector(ssadd))
  (repeat (sslength unknowface)
    (setq oent(ssname unknowface scsn))
    (setq loent(entget oent))
    (setq layername(cdr(assoc 8 loent)))
    (if (/= layername "twofold")
      (ssadd oent allreflector)
      )
    (setq scsn (+ scsn 1))
    )
  (setq unknowface allreflector)
  )

isfahan

这位是高人啊。。。。我虽然不会用LISP，也钦佩得很。。。

起点音响

我看不懂!哈哈~~~~

dosunluck

只能无限景仰了！！！呵呵，目前没到那个程度。

陈雷兵

呵呵，楼主，我正在慢慢的研究，好深奥啊。

tae0113

CAD高手呀...真的很难啊..哈哈哈.看不懂..

小罗马

太深奥了、难以明白，只能无限的仰望楼主您了！佩服！！

DJQINPENG

什么哦 一群 英文的   我什么也看不懂

hainavip

看不懂那些英文哦!!!!!!!!!!