[求助]请高人编个井字线连接部分剪断的程序

yansu · 发表于 2008-12-1 08:52:00

求助请高人编个井字线连接部分剪断的程序

QQ28104323 · 发表于 2008-12-1 22:17:00

近来也在寻找这个功能。。。

帮楼主顶一下。。。我什么继续关注的。。。。

QQ28104323 · 发表于 2008-12-2 21:01:00

继续关注

Andyhon · 发表于 2008-12-3 08:36:00

这儿有个参考的案例
http://www.autocad.com.tw/asp/ShowRecord.asp?WebName=AutoCAD&ID=18585

QQ28104323 · 发表于 2008-12-3 21:25:00

根据Andyhon提供的帮助网站，找到如下代码：
但经过附件DWG文件的测试。还是存在问题。。。希望高手帮忙改进改进。。。。
DWG测试文件:
[/CODE]
[CODE]
(defun sel2lst (sel / n l)
   (cond
      ((= (type sel) 'ENAME) (list sel))
      (T
      (repeat (setq n (sslength sel))
         (setq n (1- n)
               l (cons (ssname sel n) l)
   ))) )
)
   (defun mid_pt (a b)
      (mapcar
      (function (lambda (a b) (/ (+ a b) 2)))
      a
      b
      )
   )
   (defun dxf (code dat)
      (cdr (assoc code dat))
   )
   (defun dxg (code ent)
      (cdr (assoc code (entget ent)))
   )
   ;; General GET{ key(s) list(s) } function
   ;; Created (1995) by Vladimir Nesterovsky
   ;; e-mail me for any questions or comments
   ;;    at vnestr@netvision.net.il
   ;; YOU MAY USE THIS FUNCTION AS IT IS FOR ANY PURPOSE
   ;; AT YOUR OWN RISK IF YOU RETAIN THIS NOTICE COMPLETE
   ;; AND UNALTERED. NO WARRANTIES GIVEN WHATSOEVER.
(defun get (k l)    ;;;;; GET KEY(s) FROM LIST(s)
   (if (atom (caar l)) ;; l is ASSOC'able list
      (cond          ;; use this l!
         ((atom k)    ;; k is a key
         (cdr (Assoc k l))
         )
         ((and (cdr k) (atom (cdr k))) ;; '(0 . 8) -->> ("layer" . "Entity")
         (cons (get (car k) l) (cdr (assoc (cdr k) l)))
         )
         (T             ;; k is a list of something - get inside
         (mapcar (function (lambda (subk) (get subk l))) k)
         )
      )                ;; else - get inside list
      (mapcar  (function (lambda (subl) (get k subl))) l)
   )
)
;;; =========================================================================
(defun butt_A (ptsy)
(setq pa (car ptsy)
      pb (cadr ptsy)
      px1 (apply 'inters (append ptsy ptsH1 (list nil)))
      px2 (apply 'inters (append ptsy ptsH2 (list nil)))
)
(if (> (distance px1 pa) (distance px1 pb))
   (setq pd pa  pc pb)
   (setq pd pb  pc pa)
)
(if (> (distance px1 pd) (distance px2 pd))
   (setq ptx px2)
   (setq ptx px1)
)
(vl-cmdf "change" pc "" ptx)
ptx
)
;; 程狠翴
(defun NearPt (pt5 pts8 / dat dat2)
(setq dat
   (vl-sort
      (mapcar
      (function
         (Lambda (pt)
            (cons pt (distance pt pt5))
      ) )
      pts8
      )
      (function
      (lambda (d1 d2)
         (< (cdr d1) (cdr d2)) )
      )
   )
)
(setq dat2 (list (car dat) (cadr dat)))
(mapcar 'car dat2)
)
;;
;; For test only
;; 眤眔干矗ボ&岿粇矪瞶
;; ㄌ妓セ代刚惠猭匡
;;
(defun C:Butt ()
(SetVar "OsMode" 0)
(SetVar "Aperture" 1)
(SetVar "OrthoMode" 0)
(Setq OPx (GetVar "

ickBox")
      <90 (/ Pi 2)
)
(While (setq ss (ssget '((0 . "LINE"))))
   (cond
   ((/= (sslength ss) 4))
   (T
      (setq Ptss (mapcar 'cadr (dxf -1 (ssnamex ss)))
            pt5 (mid_pt
                  (apply 'mapcar (cons 'min ptss))
                  (apply 'mapcar (cons 'max ptss))
               )
            ptss (get '(10 11) (mapcar 'entget (sel2lst ss)))
            pts8 (apply 'append ptss)
            pts2 (NearPt pt5 pts8)
            pta (car  pts2)
            ptb (cadr pts2)
      )
      (setq ssH nil
            ssy nil
            idx  0
            iy  0
            iH  0
      )
      (while (setq ee (ssname ss idx))
      (setq pt1 (dxg 10 ee)
            pt2 (dxg 11 ee)
            idx (1+ idx)
      )
      (if (or
            (equal pt1 pta 1e-4)
            (equal pt2 pta 1e-4)
            (equal pt1 ptb 1e-4)
            (equal pt2 ptb 1e-4)
            )
         (progn
            (if (zerop iy)
            (setq ptsy1 (List pt1 pt2))
            (setq ptsy2 (List pt1 pt2))
            )
            (setq ssy (cons ee ssy)
                  iy  1
         ) )
         (progn
            (if (zerop iH)
            (setq ptsH1 (List pt1 pt2))
            (setq ptsH2 (List pt1 pt2))
            )
            (setq ssH (cons ee ssH)
                  iH  1
      ) ) ) )
      (SetVar "

ickBox" 0)
      (setq ptx1 (butt_A ptsy1)
            ptx2 (butt_A ptsy2)
            pt5 (Mid_pt ptx1 ptx2)
      )
      (vl-cmdf "Break" pt5 "f" ptx1 ptx2)
      (SetVar "

ickBox" OPx)
) ))
(princ)
)

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

[求助]请高人编个井字线连接部分剪断的程序

本帖子中包含更多资源