明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2093|回复: 0

[基础] (求助) 我写的局部放大

[复制链接]
发表于 2010-1-4 16:36 | 显示全部楼层 |阅读模式

帮我看看我的程序,视图符号动态帮我改下啊,

效果不好,

(defun c:DSS( / P1 ENT EN EL PTS SS1 nr xnr xmun mun mode cl cnl p2 p3 p5 p7 p4 p6)
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq P1 (getpoint"\n请选择放大中心:"))
  (setvar "clayer" "hid")
  (command "_CIRCLE" P1 PAUSE)
  (setq ENT (entlast) ;;entlast 中的对象仅包含了图元名 跟(car(entsel)效果一样
       EL (entget ENT)
       RD (cdr (assoc 40 (entget ENT)))               
  )
  (if RD (progn
            (command "_POLYGON" 20 P1 "I" RD)
            (setq EN (entlast)
                  EL (entget EN)
         )
            (entdel EN)
         )
  )
 (while (setq TMP (assoc 10 EL))
       (setq  EL (cdr (member TMP EL))
              PTS (cons (cdr TMP) PTS);;得到多边形的顶点列表
 )
 )
 (setq SS1 (ssget "cp" PTS)
       CL  (sslength SS1)
       CNL CL
 )
 (repeat CL
    (if (member
          (cdr(assoc 0
               (entget
                (ssname
                   SS1
                   (setq CL (1- CL))
  )
       )
          )
  )
       '("TEXT" "DIMENSION" "MTEXT" "INSERT" )     
       )
       (ssdel (ssname SS1 CL) SS1)
   )
)
 
  (prompt"\n请确定视图符号位置:")
            (setq p3 (grread 4 1 ))
  (setq MODE (car p3)
        P4   (cadr p3)
               p6  (polar(polar p4 0 20) (* pi 0.5)45)
                      angl 0
                      mun "A")
                (command"text" "tc" p6 40 0 mun)
                (setq engh (entlast))
                (setq TEST t)
         (while TEST
      (setq p3 (grread 4 1 ))
      (setq MODE (car p3)
            P7   (cadr p3))
             
              
     (redraw)
     (cond ((= MODE 3);_左键
        (setq TEST NIL))
       
        ((or (= 25 MODE) (= 13 MODE));_右键
        (setq endata (entget engh))
        (setq nr (assoc 1 endata))
        (setq xnr (strcase (getstring"\n改变视图符号:")))
        (setq xmun (cons 1 xnr))
        (setq endata (subst xmun nr endata))
        (entmod endata)
        )
        ((= MODE 5) ;_移动
                (command "move" engh""  p6 (polar(polar p7 angl 20) (* pi 0.5) 45))
                       (setq p6 (polar(polar p7 angl 20) (* pi 0.5) 45))
                              (setq angg (angle p1 p7)
                                     p5  (polar p1 angg RD))
                    (cond((and(> angg (* pi 0.5)) ( < angg pi )) (setq angl pi))
                                       ((and(> angg (* pi 1.5)) ( < angg (* pi 2) )) (setq angl 0))
                                       ((and(> angg 0) ( < angg (* pi 0.5) )) (setq angl 0))
                                       ((and(> angg pi) ( < angg (* pi 1.5) )) (setq angl pi))
                                  )  
                (grdraw  p7 p5 2)
                (grdraw  p7 (polar p7 angl 40) 2)
    
                 
                    )
                 )
               )
  (entmake (append'((0 . "lwpolyline"))
                   (mapcar '(lambda (x) (cons 10  x))(list p5 p7 (polar p7 ang1 40)))

             ))

   
 (setvar "clayer" "headlabel")
 (setq P2 (getpoint P1 "\n请指定局部放大图的位置: "))  
 (if(= CNL 0)(alert"指定区域内没有对象,不能创建视图!")(DSS1))
 (setvar "osmode" os)
 (setvar "cmdecho" 1)
)

;; 复制并放大对象子函数
(defun DSS1(/ EN1 ENT1 PT  sc)
  (setq angl 0)
  (setvar "clayer" "hid")
  (command"CIRCLE" P2 RD)
  (setq EN1 (entlast)
        ENT1 EN1)
  (setvar "clayer" "headlabel")
  (command "COPY" SS1 "" P1 P2)
  (setq SS1 (ssadd EN1))
  (while (setq ENT1 (entnext ENT1))
         (ssadd ENT1 SS1)
  )
 (command "trim" EN1 "" "f")
 (repeat 41
  (setq PT (polar P2 angl (* 1.1  RD))
        angl (+ angl (* 0.05 pi)))
  (command PT)
 )
 (command "" "")
 (command "_.erase" "")
 (setq sc (getreal"\n请输入放大倍数:"))
 (command "_.scale" SS1 (entlast)"" P2 SC)
 )

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-5-18 06:54 , Processed in 0.227006 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表