龙龙仔 发表于 2003-9-10 17:02:00

;;其待你的程序!
;;手又痒起来!
;;照你的思路写的!
;;先贴出我的程序!
;;中秋节我放4天假,要星期一才能看到你的程序了!
;;看来一点也不麻烦!
;;只是不太稳定!
;;BY 龙龙仔(LUCAS)
(arxload "ACETUTIL.ARX" NIL)
(defun C:BOUND (/ BLK_BOUND PT1 ENT)
(prompt "\n请选取实体<退出>:")
(if (setq SS (ssget))
    (progn
      (setq BLK_BOUND (ACET-GEOM-SS-EXTENTS SS t))
      (command "_.RECTANG"
             (car BLK_BOUND)
             (setq PT1 (cadr BLK_BOUND))
      )
      (setq ENT (entlast))
      (command "_.OFFSET" 5 ENT (polar PT1 0 1.0) "")
      (setq BLK_BOUND (ACET-GEOM-SS-EXTENTS (ssget "L") t))
      (command "_.ZOOM" "W" (car BLK_BOUND) (cadr BLK_BOUND))
      (command "_.ERASE" ENT "")
      (setq ENT (entlast))
      (command "_.BOUNDARY" "A" "O" "P" "" (polar PT1 0 3.5) "")
      ;;(command "_.BOUNDARY" (polar PT1 0 3.5) "")
      (command "_.ERASE" ENT (entlast) "")
      ;;(command "_.EXPLODE" (entlast))
      ;;(setq SS (ssget "P"))
      ;;(command "_.PEDIT" SS "" "P" SS "" "")
      (command "_.ZOOM" "P")
    )
)
(princ)
)

runkeji 发表于 2003-9-10 18:09:00

多参与吗

lyy 发表于 2003-9-11 01:24:00

;;边界轮廓线
(vl-load-com)
(defun c:outline(/ viewpt maxmin os cor qa ss blk pt1 pt2 dis l_pt ent n m)
(defun viewpt(/ a b c d x)
    (setq b (getvar "viewsize") c (car (getvar "screensize")) d (cadr (getvar "screensize"))
          a (* b (/ c d)) x (setq x (getvar "viewctr")) x (trans x 1 2) c (list (- (car x)(/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)
          d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) c (trans c 2 1) d (trans d 2 1)
    )
    (list c d)
)
(defun maxmin(lst / x n a b c d)
    (setq x (car lst) a (car x) b (cadr x) c (car x) d (cadr x) n 1)
    (repeat (max (- (length lst) 1) 0)
      (setq x (nth n lst) a (min a (car x)) b (min b (cadr x)) c (max c (car x)) d (max d (cadr x)))
      (setq n (1+ n))
    )
    (list (list a b) (list c d))
)
(prompt "\n请选择要生成边界轮廓线的所有对象:")
(if (setq ss (ssget '((0 . "line,arc,circle,lwpolyline"))))
    (progn
      (command "_.undo" "_be")
      (setq os (getvar "osmode")
            cor (getvar "cecolor")
            qa (getvar "qaflags")
      )
      (setvar "osmode" 0)
      (setvar "cmdecho" 0)
      (entmake '((0 . "BLOCK") (2 . "*U1") (70 . 1) (10 0 0 0)))
      (setq n -1)
      (repeat (sslength ss)
      (entmake (entget (ssname ss (setq n (1+ n)))))
      )
      (entmake (list (cons 0 "INSERT") (cons 2 (entmake '((0 . "ENDBLK")))) (cons 10 '(0 0 0))))
      (setq blk (entlast))
      (vla-getboundingbox (vlax-ename->vla-object blk) 'pt1 'pt2)
      (setq pt1 (vlax-safearray->list pt1)
            pt2 (vlax-safearray->list pt2)
            dis (/ (distance pt1 pt2) 20)
            pt1 (polar pt1 (angle pt2 pt1) dis)
            pt2 (polar pt2 (angle pt1 pt2) dis)
      )
      (setq l_pt (maxmin (append (viewpt) (list pt1 pt2))))
      (command "_.zoom" "_w" (car l_pt) (cadr l_pt))
      (setvar "cecolor" "188")
      (command "_.rectang" pt1 pt2)
      (setq ent (entlast))
      (command "_.boundary" "_a" "_o" "_r" "_i" "_y" "_b" "_n" ent blk "" "" (polar pt1 (angle pt1 pt2) (/ dis 2)) "")
      (entdel blk)
      (if (equal (entlast) ent)
      (progn
          (entdel ent)
          (prompt "\n没有边界轮廓线!")
      )
      (progn
          (entdel ent)
          (command "_.erase" (ssget "c" pt1 pt1 '((0 . "region") (62 . 188))) "")
          (setq m 0)
          (if (setq ss (ssget "x" '((0 . "region") (62 . 188))))
            (progn
            (command "_.union" ss "")
            (entmod (subst (cons 62 1) (cons 62 188) (entget (setq ent (entlast)))))
            (command "_.explode" ent)
            (setq ss (ssget "_p"))
            (if (= (cdr (assoc 0 (entget (ssname ss 0)))) "REGION")
                (progn
                  (setvar "qaflags" 1)
                  (command "_.explode" ss "")
                  (setq ss (ssget "_p"))
                )
            )
            (setq n -1)
            (while (setq ent (ssname ss (setq n (1+ n))))
                (if (entget ent)
                  (progn
                  (command "_.pedit" ent "_y" "_j" ss "" "")
                  (setq m (1+ m))
                  )
                )
            )
            )
          )
          (if (setq ss (ssget "x" '((0 . "lwpolyline") (62 . 188))))
            (progn
            (setq n -1)
            (repeat (sslength ss)
                (entmod (subst (cons 62 1) (cons 62 188) (entget (ssname ss (setq n (1+ n))))))
            )
            (setq m (+ m (sslength ss)))
            )
          )
          (if (= m 0)
            (prompt "\n没有边界轮廓线!")
            (prompt (strcat "\n生成" (itoa m) "条边界轮廓线!"))
          )
      )
      )
      (setvar "osmode" os)
      (setvar "cecolor" cor)
      (setvar "qaflags" qa)
      (command "_.undo" "_e")
    )
)
(princ)
)
(prompt "\n***边界轮廓线yad_outline***YAD建筑")
(princ)

mccad 发表于 2003-9-11 06:33:00

龙大哥的程序没有考虑内容有封闭区域的情况,所以用默认的使用多段线在内容有封闭区域时是不会成功的。应使用面域。
林大哥的程序只对过滤器中的几种对象有效,可能对于椭圆来说变成多段线的工程会大点。

runkeji 发表于 2003-9-11 10:54:00

(defun outline()
(setq aa (ssget "x"))
(command "_.region" aa "")
(setq set1 (ssget "x"))
(setq n (sslength set1))
(while (/= n 1)
(progn
(setq a 0)
(setq tu_1 (ssname set1 a))
(setq tu_2 (ssname set1 (1+ a)))
(command "_.union" tu_1 tu_2 "")
(setq set1 (ssget "x"))
(setq n (sslength set1))
)
)
)

meflying 发表于 2003-9-11 11:12:00

union不是只能是两个对象,而是可以多个对象的。所以不用那么麻烦,。。。

lyy 发表于 2003-9-11 16:03:00

其实对insert spline ellipse等对象也是可以的,只是最后转成pline线的时候还需要
很多的代码来支持,有心人请帮着写写吧!
龙大哥的程序缺少屏幕缩放判断模块,屏幕跳来跳去不舒服。

BDYCAD 发表于 2003-9-18 10:06:00

怎么還沒有可以對insert spline ellipse等对象的啊? 這個程序很好的嘛.不知哪位師傅有.可以貼上來給大家分享分享嘛.謝謝啦.

aeo000000 发表于 2003-9-18 19:55:00

lyy很有陈斑主的风格嘛!

其实只要可能性考虑的全一点就可以.

lyy 发表于 2003-9-19 15:36:00

请参考“边界轮廓线程序”一帖!
页: 1 [2] 3
查看完整版本: [讨论]征求轮廓线的lisp思路