断线生成外轮廓

世井

目前断线缺口大于4MM小于4MM都会出现错误，4组相同的图也会出错误，哪位大师看看哪里需要修改一下，


(defun c:tt ( / ss obj p1 P9 ss1 n en pt1 pt2 SS2 ssaa s0 iidx SS3 idx ent1)
  (setvar "CMDECHO" 0)
  (command "_undo" "be")
  (setq ss (ssget))
  (SETQ obj (baoweihe SS))
  (setq p1 (car obj));左下角点
  (setq p9 (cadr obj));右上角点
  (command "_copyclip" "non" p1 ss "");复制一个隐藏
  (SETVAR 'PEDITACCEPT 1) ;转化为多段线
  (COMMAND "_.pedit" "m" ss "" "j" 0 "")
(setq ss1 (ssget "w" p9 p1))
  (repeat (setq n (sslength ss1))
    (setq en  (ssname ss1 (setq n (1- n)))
          pt1 (vlax-curve-getstartpoint en)
          pt2 (vlax-curve-getendpoint en)
    )
    (command "lengthen" "de" 2 "non" (list en pt1) "non" (list en pt2) "")
  )
  (setvar "QAFLAGS" 1)
  (command "explode" ss1 "")
  (setvar "QAFLAGS" 0)
  (setq ss2 (ssget "p"))
  (COMMAND "_.pedit" "m" ss2 "" "j" 0 "")
  (setq ssaa (ssget "w" p9 p1 '((0 . "*POLYLINE,*LWPOLYLINE"))))
      (setq s0 (ss->lst ssaa))  
  (mapcar '(lambda (x) (vla-Offset (Vlax-Ename->Vla-Object x) 15)) s0)
  (repeat  (setq iidx (sslength ssaa)) (entdel (ssname ssaa (setq iidx (1- iidx)))) )
  (setq SS3 (ssget "C" p9 p1 '((0 . "*POLYLINE,*LWPOLYLINE"))))            
            (LM:outline SS3)
  ;(set ent1 (entlast))   
           (repeat  (setq idx (sslength SS3))
                    (entdel (ssname SS3 (setq idx (1- idx)))) ) ;删除原来
  ;(vla-Offset (Vlax-Ename->Vla-Object ent1) -5)
  ;(entdel ent1)
  (command "_pasteclip" "non" p1)
  (command "_undo" "e")
  (princ))  
(defun ss->lst(ss);选择集转图元名列表
(vl-remove-if(function listp)(mapcar (function cadr) (ssnamex SS))))
(defun baoweihe (sel / idx llp ls1 ls2 obj urp) ;算出包围框
    (repeat (setq idx (sslength sel))
      (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
      (if
    (and
      (vlax-method-applicable-p obj 'getboundingbox)
      (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))    )
     (setq ls1 (cons (vlax-safearray->list llp) ls1)
           ls2 (cons (vlax-safearray->list urp) ls2)     )      )    )
    (if (and ls1 ls2)
      (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))    ))
(defun LM:outline ( sel / app are box cmd dis enl ent lst obj rtn tmp );创建外轮廓
    (if (setq box (LM:ssboundingbox sel))
        (progn
            (setq app (vlax-get-acad-object)
                  dis (/ (apply 'distance box) 20.0)
                  lst (mapcar '(lambda ( a o ) (mapcar o a (list dis dis))) box '(- +))
                  are (apply '* (apply 'mapcar (cons '- (reverse lst))))
                  dis (* dis 1.5)
                  ent
                (entmakex
                    (append
                       '(   (000 . "LWPOLYLINE")
                            (100 . "AcDbEntity")
                            (100 . "AcDbPolyline")
                            (090 . 4)
                            (070 . 1)
                        )
                        (mapcar '(lambda ( x ) (cons 10 (mapcar '(lambda ( y ) ((eval y) lst)) x)))
                           '(   (caar   cadar)
                                (caadr  cadar)
                                (caadr cadadr)
                                (caar  cadadr)
                            )   )) ))
            (apply 'vlax-invoke
                (vl-list* app 'zoomwindow
                    (mapcar '(lambda ( a o ) (mapcar o a (list dis dis 0.0))) box '(- +))) )
            (setq cmd (getvar 'cmdecho)
                  enl (entlast)
                  rtn (ssadd)            )
            (while (setq tmp (entnext enl)) (setq enl tmp))
            (setvar 'cmdecho 0)
            (command  "_.-boundary" "_a" "_b" "_n" sel ent "" "_i" "_y" "_o" "_p" "" "_non"
                (trans (mapcar '- (car box) (list (/ dis 3.0) (/ dis 3.0))) 0 1) ""  )
            (while (< 0 (getvar 'cmdactive)) (command ""))
            (entdel ent)
            (while (setq enl (entnext enl))
                (if (and (vlax-property-available-p (setq obj (vlax-ename->vla-object enl)) 'area)
                         (equal (vla-get-area obj) are 1e-4) )
                    (entdel enl)
                    (ssadd  enl rtn)
                ) )
            (vla-zoomprevious app)
            (setvar 'cmdecho cmd)
            rtn
        )    ))
(defun LM:ssboundingbox ( s / a b i m n o )
    (repeat (setq i (sslength s))
        (if            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b)))) )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)            )        )    )
    (if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))    ))

loveu515

判断一下你的多段线的方向都是一个方向吗？顺时针 ？逆时针？还是都有？

xyp1964

图形文件没问题

世井

xyp1964 发表于 2025-2-23 07:10
图形文件没问题

院长，那是创建外轮廓函数有问题 还是哪里问题么

tigcat

用cad2014试了下,都能正确生成.

世井

tigcat 发表于 2025-2-23 15:15
用cad2014试了下,都能正确生成.

也是哦，2007就有问题了，2014没问题 ，为什么生成外轮廓的线我用 ENTLAST 取不到，大师教教我如果断口大于4MM或者小于4MM,都不行，我该怎么弄，大师教教我

自贡黄明儒

世井 发表于 2025-2-23 20:16
也是哦，2007就有问题了，2014没问题 ，为什么生成外轮廓的线我用 ENTLAST 取不到，大师教教我[face118.g ...

高版本pedit可以设置误差，不过这个误好像是像素，像素多少为4MM值得摸索