局部放大.LSP

自贡黄明儒

;;;对于一个设计人员来讲,作图局部放大可能是常有的事,可是如下的程序写得并不好,希望大家改进一下.
;;;燕秀工具箱中有一个局部放大,可惜为了一个放大程序要进行安装也太麻烦了.
;;;局部放大===========================================
;;;全部变量JBHD-A(标记字母),JBHD-SC(放大倍数)
(DEFUN HH:JBFD ( / CIR_R CLAY CP DATA DATA_A DATA_B DATA_C DATA_D DATA_G DIMCE DIMT HD IN_P JBHD-STRD JBHD-STRIN LAST1 LASTP LASTT MODE OSMO PD SCA_TT STRD STRD1 STRD2 X)
  (SETVAR "CMDECHO" 0)
  (SETVAR "MENUECHO" 0)  
  (COMMAND "_.UNDO" "_GROUP")
  (setq dimce (getvar "dimcen"))  
  (setvar "dimcen" 0)
  (SETQ CLAY (GETVAR "CLAYER"))
  (SETQ OSMO (GETVAR "OSMODE"))
  (SETQ MODE (GETVAR "ORTHOMODE"))
  (SETQ dimt (GETVAR "dimtofl"))
  (SETVAR "OSMODE" 0)
  (SETVAR "ORTHOMODE" 0)
  (IF (NULL (TBLSEARCH "LAYER" "DIM"))
    (COMMAND "LAYER" "M" "DIM" "C" "256" "" "" "" "" "")
  )
  (SETVAR "CLAYER" "DIM")
  (INITGET 1)
  (SETQ CP (GETPOINT "\n局部放大中心点: "))
  (PROMPT "\n放大范围: ")
  (COMMAND "_.CIRCLE" CP PAUSE)
  (SETQ LAST1 (ENTLAST));圆
  (setq lastt (cons last1 (list (GETVAR "LASTPOINT"))));(圆.圆心)
  (SETQ CIR_R (CDR (ASSOC 40 (ENTGET LAST1))))
  (SETQ DATA_G (MAPCAR
   'ANGTOF
   '("0" "15"
    "30" "45"
    "60" "75"
    "90" "105"
    "120" "135"
    "150" "165"
    "180" "195"
    "210" "225"
    "240" "255"
    "270" "285"
    "300" "315"
    "330" "345"
    "0"
   )
        )         ; MAPCAR
  )           ; SETQ
  (SETQ DATA_A (MAPCAR
   '(LAMBDA (X)
      (POLAR CP X CIR_R)
    )
   DATA_G
        )
  )
  (SETQ DATA (SSGET "CP" DATA_A '((-4 . "<NOT") (0 . "TEXT")
       (-4 . "NOT>")
       (-4 . "<NOT")
       (0 . "MTEXT")
       (-4 . "NOT>")
       (-4 . "<NOT")
       (0 . "DIMENSION")
       (-4 . "NOT>")
       (-4 . "<NOT")
       (0 . "HATCH")
       (-4 . "NOT>")
      )
      )          ; SSGET
  )
  (SETQ DATA (SSDEL LAST1 DATA))       ;去除圆
  (if (numberp JBHD-A) (setq JBHD-A (1+ JBHD-A)) (setq JBHD-A 65))  
  (SETQ JBHD-STRD (chr JBHD-A))
  (setq JBHD-strin (STRCAT "\n放大标记字母<" JBHD-STRD ">: "))
  (SETQ STRD1 (GETSTRING JBHD-strin))  
  (if (= STRD1 "") (SETQ STRD1 JBHD-STRD))
  (SETQ STRD2 (STRCAT STRD1 " 放大"))
  (SETQ HD (* 1.5 (GETVAR "DIMTXT") (GETVAR "DIMSCALE")))
  (COMMAND "_.DIMTOH" "ON")
  (command "_.dimtofl" "off")
  (COMMAND "_.dimdiameter" lastt "M" STRD1 pause) ;
  (setvar "dimcen" dimce)
  (PROMPT "\n放大图形放置中心点: ")        
  (COMMAND "_.COPY" LAST1 "" CP PAUSE)
  (SETQ LASTP (GETVAR "LASTPOINT")
LAST1 (ENTLAST)
  )
  (COMMAND "_.COPY" DATA "" CP LASTP)
  (SETQ CIR_R (/ CIR_R (COS (ANGTOF "7.5"))))
  (SETQ CP LASTP)
  (SETQ DATA_B (MAPCAR
   '(LAMBDA (X)
      (POLAR CP X (+ CIR_R 1))
    )
   DATA_G
        )
  )
  (SETQ DATA_C DATA_B)
  (SETQ DATA_D DATA_B)        
  (COMMAND "_.TRIM" LAST1 "" "F")
  (WHILE (CAR DATA_B)
    (SETQ IN_P (CAR DATA_B))
    (COMMAND IN_P)
    (SETQ DATA_B (CDR DATA_B))
  )           ; WHILE
  (COMMAND "" "")
  (COMMAND "_.TRIM" LAST1 "" "F")
  (WHILE (CAR DATA_C)
    (SETQ IN_P (CAR DATA_C))
    (COMMAND IN_P)
    (SETQ DATA_C (CDR DATA_C))
  )           ; WHILE
  (COMMAND "" "")        
  (SETVAR "ATTMODE" 1)
  (INITGET 6)
  (SETQ JBHD-SC (GETREAL "\n放大倍率<2.5>: "))
  (if (not (numberp JBHD-SC)) (setq JBHD-SC 2.5))
  (if (>= JBHD-SC 10)
    (if (= "0" (substr (rtos JBHD-SC 2 2) 4 1))
      (setq sca_tt 0)
      (setq sca_tt 1)
    )
    (if (= "0" (substr (rtos JBHD-SC 2 2) 3 1))
      (setq sca_tt 0)
      (setq sca_tt 1)
    )
  )
  (COMMAND "_.SCALE" "CP")
  (WHILE (CAR DATA_D)
    (SETQ IN_P (CAR DATA_D))
    (COMMAND IN_P)
    (SETQ DATA_D (CDR DATA_D))
  )           ; WHILE
  (COMMAND "" "" LASTP JBHD-SC)
  (COMMAND "ATTDIA" 0)

  (SETQ STRD (STRCAT STRD2 " " (RTOS JBHD-SC 2 sca_tt) ":1"))
  (INITGET 33)
  (SETVAR "ORTHOMODE" 1)
  (SETQ PD (GETPOINT CP "\n标记字母放置点: "))
  (COMMAND "_.TEXT" "_J" "_M" PD HD 0 STRD)
  (COMMAND "ATTDIA" 1)
  (COMMAND "_.UNDO" "_E")
  (SETVAR "CLAYER" CLAY)
  (SETVAR "ORTHOMODE" MODE)
  (SETVAR "OSMODE" OSMO)
  (setvar "dimtofl" dimt)  
  (gc)
  (PRINC "\n本程序根据叶旭坤程序改编,可是对于相交的块无能为力,达不到专业水平,版主呀,只能靠你了!!!")
)
;;; DEFUN
(defun C:fd()
  (setvar "modemacro" "自贡运机集团")
  (lt:error-init (list nil 0 nil))  
  (HH:JBFD)
  (lt:error-restore)
  (gc)        ;释放内存
  (princ "\n We must do the best with what God gave us!")
  (princ)
)
;;;局部放大===========================================

yutianweidi

(defun c:RS ( )               ;Real Scale,用于画剖视图缩放图元时,维持标注尺寸不变
  (princ "图元缩放,尺寸不变")
  (PROMPT "\n指示缩放区域:")
  (SETVAR "OSMODE" 0)(SETVAR "ORTHOMODE" 0)
  (setq scale (ssget ))
  (SETQ ENTGRP scale)
  (SETQ COUNT 0)                                         
  (REPEAT (SSLENGTH ENTGRP)
    (SETQ ENTNAME (SSNAME ENTGRP COUNT))
    (SETQ ENT (ENTGET ENTNAME))
    (IF (AND (= (CDR (ASSOC 0 ENT)) "DIMENSION")        
             (/= (cdr (ASSOC 1 ENT)) ""))     
       (PROGN (PRINC "\n对象中不能有修改过的尺寸!") (EXIT)))
       (IF (and(= (CDR (ASSOC 0 ENT)) "DIMENSION")                ;AlignedDimension
            (= (cdr (nth 19 ent)) "AcDbAlignedDimension"))      
          (PROGN
              (setq P1 (assoc 13 ENT))
              (setq P2 (assoc 14 ENT))
              (setq P1x (nth 1 P1))  
              (setq P1y (nth 2 P1))                  
              (setq P2x (nth 1 P2))
              (setq P2y (nth 2 P2))
              (setq DX (ABS(- P1x P2x)))           
              (setq DY (ABS(- P1y P2y)))            
              (setq SS (assoc 10 ENT))
              (setq TT (assoc 11 ENT))
              (setq SSx (nth 1 SS))  
              (setq TTx (nth 1 TT))
              (setq SSy (nth 2 SS))  
              (setq TTy (nth 2 TT))   
              (IF (= SSx TTx)                    
                 (setq V Dy))
              (IF (and(/= SSx TTx)(= SSy TTy))
                 (setq V Dx))                                      ;取得数值V1
              (IF (and(/= SSx TTx)(/= SSy TTy))
                 (setq V (distance (cdr p1) (cdr p2))))              
              (SETQ W (rtos V 2 2))
              (SETQ ENT (SUBST (CONS 1 W) (ASSOC 1 ENT) ENT))       ;MODIFY
              (ENTMOD ENT)                                          ;UPDATE
          )
      )
    (IF (and(= (CDR (ASSOC 0 ENT)) "DIMENSION")                    ;RadialDimension
            (= (cdr (nth 19 ent)) "AcDbRadialDimension"))
          (PROGN
              (setq P1 (assoc 10 ENT))
              (setq P2 (assoc 15 ENT))
              (setq V (distance (cdr p1) (cdr p2)))                ;取得数值V1            
              (SETQ W (strcat "R" (rtos V 2 2)))
              (SETQ ENT (SUBST (CONS 1 W) (ASSOC 1 ENT) ENT))       ;MODIFY
              (ENTMOD ENT)                                          ;UPDATE
          )
      )
  (SETQ COUNT (1+ COUNT))
  )
  (setq base (getpoint "\n /Base point:"))(princ "Done")
  (SETQ factor (getint "\n /Scale factor:"))
  (command "_scale" scale "" base factor)
  (SETQ OLDLAYER (GETVAR "CLAYER"))
  (COMMAND "-LAYER" "S" "MARK" "")
  (setq txtSTRING (strcat "SCALE " (RTOS factor 2 0) ":1"))               
  (COMMAND "_.TEXT" "J" "C" base (* 2.5 (GETVAR "DIMSCALE")) "" (strcase txtSTRING ))
  (COMMAND "-LAYER" "S" OLDLAYER "")  
  (PRINC "\n OK! ")
  (PRINC)
)

xhq1954425

谢谢分享！下载试试。

yoyoho

感谢楼主分享,下载学习了!

hpy

程序不能运行，缺少函数 lt:error-init，lt:error-restore。

qcw911

辛苦了
谢谢分享

自贡黄明儒

回复 hpy 的帖子

错误处理见,可以在本论坛上找,现在改版后我也不知哪里去了,在新年贺什么什么的......里面有许多好程序
你可以不用错误处理,上面那个程序就可.

jh1005

回复 自贡黄明儒 的帖子

是caoyin版主的函数，

出错处理的点滴经验：
http://bbs.mjtd.com/forum.php?mo ... &fromuid=335231

mico_ye

回复 自贡黄明儒 的帖子

自贡黄明儒,谢谢你在转载中还保留原作者的信息。现再赠你一程序原码－－－序号球

>>>请记住此命令名为：Ball
空格横向对齐  >>> 左键指定位置 <<<  右键竖向对齐:

希望能共同进步！

Michael527

“放大标记字母”后出错是怎么回事？