[原创]：一个局部放大程序

chenronglin · 发表于 2004-8-3 00:05:29

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;;希望能起抛砖引玉的作用，能有人把放大(fd)的那一块给写下去。

(vl-load-com)
;;;(alert "\n局部放大jbfd,小金鱼2004.2.18")
(defun c:jbfd (/ *error* mSpace cir i NEXT_PT
READTYP READVAL basept line text tzz
txtlen l2 l2end cen pt text_x
ptt l2_x fh fh1 ss1
MakeUnNameBlock
)
(defun *error* (msg / ent count)
(cond
((or (= msg "函数被取消") (= msg "function cancelled"))
(command "_.ERASE" ss1 "")
)
((= msg "ActiveX 服务器返回错误: 未知名称: Center") ;处理输入d
(alert (strcat "唉,我无法处理"d"错误,"
"\n如果你知道请通知我。"
"\nE_mail:cag25@sohu.com"
"\nQQ:297240086"
)
)
)
(T
(alert (strcat msg
"\n\n对不起,有错误产生,请通知我。"
"\nE_mail:cag25@sohu.com"
"\nQQ:297240086"
)
)
)
)
)
(setq mSpace (vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(setq ss1 (ssadd))
(defun MakeUnNameBlock (ss pt / count entlist ent blk)
(entmake (list '(0 . "BLOCK")
'(2 . "*U")
'(70 . 1)
(cons 10 pt)
)
)
(setq count 0)
(repeat (sslength ss)
(setq entlist (entget (setq ent (ssname ss count))))
(setq count (1+ count))
(entmake entlist)
)
(setq count 0)
(repeat (sslength ss)
(setq ent (ssname ss count))
(setq count (1+ count))
(entdel ent)
)
(setq blk (entmake '((0 . "ENDBLK"))))
(if T
(entmake (list (cons 0 "INSERT")
(cons 2 blk)
(cons 10 pt)
)
)
)
)
(defun Tzz (Text / textent ang sinrot cosrot t1 t2 p0 p1 p2 p3 p4)
(setq textent (entget (vlax-vla-object->ename Text)))
(setq p0 (cdr (assoc 10 textent))
ang (cdr (assoc 50 textent))
sinrot (sin ang)
cosrot (cos ang)
t1 (car (textbox textent))
t2 (cadr (textbox textent))
p1 (list
(+ (car p0)
(- (* (car t1) cosrot) (* (cadr t1) sinrot))
)
(+ (cadr p0)
(+ (* (car t1) sinrot) (* (cadr t1) cosrot))
)
)
p2 (list
(+ (car p0)
(- (* (car t2) cosrot) (* (cadr t1) sinrot))
)
(+ (cadr p0)
(+ (* (car t2) sinrot) (* (cadr t1) cosrot))
)
)
)
(distance p1 p2)
)
(defun fd (/ minpt maxpt ss2)
(vla-getboundingbox cir 'minpt 'maxpt)
(setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt)
)
(setq ss2 (ssget "C" maxpt minpt))
(command "copy" ss2 "" cen)
(princ "\n指定放大图位置:")
(if (not (command pause))
(MakeUnNameBlock ss1 cen)
)
)
(setvar "cmdecho" 0)
(initget 1)
(setq p1 (getpoint "\n指定放大中心点:"))
(command "circle" p1)
(princ
(strcat "\n指定放大半径 <" (rtos (getvar "CIRCLERAD")) ">:")
)
(command pause)
(setq cir (vlax-ename->vla-object (entlast)))
(vla-put-color cir (getvar "dimclrd"))
(vla-update cir)
(ssadd (entlast) ss1)
(setq cen (vlax-safearray->list
(vlax-variant-value (vla-get-center cir))
)
)
(setq pt (car cen))
(princ "\n指定视图符号放置位置 <右键或回车修改视图符号>:")
(setq i T)
(while i
(Setq NEXT_PT (GrRead T 4 0)
READTYP (car NEXT_PT)
READVAL (cadr NEXT_PT)
)
(cond
((= READTYP 5) ;移动
(setq NEXT_PT (cadr NEXT_PT))
(setq next_pt (trans next_pt 1 0))
(setq basept (vlax-curve-getclosestpointto cir NEXT_PT))
(if (not line)
(progn
(if (not fh)
(setq fh "A")
)
(setq text (vla-addtext
mspace
fh
(vlax-3d-point next_pt)
(getvar "dimtxt")
)
)
(vla-put-color text (getvar "dimclrt"))
(vla-put-stylename text (getvar "dimtxsty"))
(vla-update text)
(ssadd (entlast) ss1)
(setq line (vla-addline
mspace
(vlax-3d-point basept)
(vlax-3d-point next_pt)
)
)
(vla-put-color line (getvar "dimclrd"))
(ssadd (entlast) ss1)
(setq txtlen (tzz text))
(setq l2end (list (+ (car next_pt) txtlen) (cadr next_pt) 0))
(setq l2 (vla-addline
mspace
(vlax-3d-point next_pt)
(vlax-3d-point l2end)
)
)
(vla-put-color l2 (getvar "dimclrd"))
(ssadd (entlast) ss1)
)
(progn
(vla-put-startpoint line (vlax-3d-point basept))
(vla-put-endpoint line (vlax-3d-point next_pt))
(vla-update line)
(setq ptt (car next_pt))
(if (> ptt pt)
(progn
(setq text_x (+ (car next_pt) (getvar "dimgap")))
(setq l2_x (+ (car next_pt) txtlen (getvar "dimgap")))
)
(progn
(setq text_x (- (car next_pt) (getvar "dimgap") txtlen))
(setq l2_x text_x)
)
)
(vla-put-insertionpoint
text
(vlax-3d-point
(list text_x (+ (cadr next_pt) (getvar "dimgap")) 0)
)
)
(vla-update text)
(vla-put-startpoint l2 (vlax-3d-point next_pt))
(setq l2end (list l2_x (cadr next_pt) 0))
(vla-put-endpoint l2 (vlax-3d-point l2end))
(vla-update l2)
)
)
)
((= READTYP 3) ;左键击
;;; (MakeUnNameBlock ss1 cen)
(setq i nil)
)
((or (= 25 readtyp) (= 13 READVAL)) ;回车或右键
(setq fh1 fh)
(setq fh (getstring (strcat
"\n输入新视图符号 <"
fh
">:"
)
)
)
(if (= fh "")
(setq fh fh1)
)
(vla-put-textstring text fh)
(vla-update text)
(setq txtlen (tzz text))
(princ "\n指定视图符号放置位置 <右键或回车修改视图符号>:")
)
)
)
(fd)
(princ)
)

(vl-load-com) 
;;;(alert "\n局部放大jbfd,小金鱼2004.2.18") 
(defun c:jbfd (/ *error*  mSpace   cir    i     NEXT_PT 
        READTYP READVAL  basept   line    text     tzz 
        txtlen l2  l2end   cen    pt     text_x 
        ptt l2_x  fh   fh1    ss1 
        MakeUnNameBlock 
       ) 
 
  (defun *error* (msg / ent count) 
    (cond 
      ((or (= msg "函数被取消") (= msg "function cancelled")) 
       (command "_.ERASE" ss1 "") 
      ) 
      ((= msg "ActiveX 服务器返回错误: 未知名称: Center") ;处理输入d 
       (alert (strcat "唉,我无法处理"d"错误," 
        "\n如果你知道请通知我。" 
        "\nE_mail:cag25@sohu.com" 
        "\nQQ:297240086" 
       ) 
       ) 
      ) 
      (T 
       (alert (strcat msg 
        "\n\n对不起,有错误产生,请通知我。" 
        "\nE_mail:cag25@sohu.com" 
        "\nQQ:297240086" 
       ) 
       ) 
      ) 
    ) 
  ) 
 
  (setq mSpace (vla-get-ModelSpace 
   (vla-get-ActiveDocument (vlax-get-acad-object)) 
        ) 
  ) 
  (setq ss1 (ssadd)) 
 
  (defun MakeUnNameBlock (ss pt / count entlist ent blk) 
    (entmake (list '(0 . "BLOCK") 
     '(2 . "*U") 
     '(70 . 1) 
     (cons 10 pt) 
      ) 
    ) 
    (setq count 0) 
    (repeat (sslength ss) 
      (setq entlist (entget (setq ent (ssname ss count)))) 
      (setq count (1+ count)) 
      (entmake entlist) 
    ) 
    (setq count 0) 
    (repeat (sslength ss) 
      (setq ent (ssname ss count)) 
      (setq count (1+ count)) 
      (entdel ent) 
    ) 
    (setq blk (entmake '((0 . "ENDBLK")))) 
    (if T 
      (entmake (list (cons 0 "INSERT") 
       (cons 2 blk) 
       (cons 10 pt) 
        ) 
      ) 
    ) 
  ) 
 
  (defun Tzz (Text / textent ang sinrot cosrot t1 t2 p0 p1 p2 p3 p4) 
    (setq textent (entget (vlax-vla-object->ename Text))) 
    (setq p0  (cdr (assoc 10 textent)) 
   ang  (cdr (assoc 50 textent)) 
   sinrot (sin ang) 
   cosrot (cos ang) 
   t1  (car (textbox textent)) 
   t2  (cadr (textbox textent)) 
   p1  (list 
     (+ (car p0) 
        (- (* (car t1) cosrot) (* (cadr t1) sinrot)) 
     ) 
     (+ (cadr p0) 
        (+ (* (car t1) sinrot) (* (cadr t1) cosrot)) 
     ) 
   ) 
   p2  (list 
     (+ (car p0) 
        (- (* (car t2) cosrot) (* (cadr t1) sinrot)) 
     ) 
     (+ (cadr p0) 
        (+ (* (car t2) sinrot) (* (cadr t1) cosrot)) 
     ) 
   ) 
    ) 
    (distance p1 p2) 
  ) 
 
  (defun fd (/ minpt maxpt ss2) 
    (vla-getboundingbox cir 'minpt 'maxpt) 
    (setq minpt (vlax-safearray->list minpt) 
   maxpt (vlax-safearray->list maxpt) 
    ) 
    (setq ss2 (ssget "C" maxpt minpt)) 
    (command "copy" ss2 "" cen) 
    (princ "\n指定放大图位置:") 
    (if (not (command pause)) 
      (MakeUnNameBlock ss1 cen) 
    ) 
  ) 
   
  (setvar "cmdecho" 0) 
  (initget 1) 
  (setq p1 (getpoint "\n指定放大中心点:")) 
  (command "circle" p1) 
  (princ 
    (strcat "\n指定放大半径 <" (rtos (getvar "CIRCLERAD")) ">:") 
  ) 
  (command pause) 
  (setq cir (vlax-ename->vla-object (entlast))) 
  (vla-put-color cir (getvar "dimclrd")) 
  (vla-update cir) 
  (ssadd (entlast) ss1) 
  (setq cen (vlax-safearray->list 
       (vlax-variant-value (vla-get-center cir)) 
     ) 
  ) 
  (setq pt (car cen)) 
  (princ "\n指定视图符号放置位置 <右键或回车修改视图符号>:") 
  (setq i T) 
  (while i 
    (Setq NEXT_PT (GrRead T 4 0) 
   READTYP (car NEXT_PT) 
   READVAL (cadr NEXT_PT) 
    ) 
    (cond 
      ((= READTYP 5)   ;移动 
       (setq NEXT_PT (cadr NEXT_PT)) 
       (setq next_pt (trans next_pt 1 0)) 
       (setq basept (vlax-curve-getclosestpointto cir NEXT_PT)) 
       (if (not line) 
  (progn 
    (if (not fh) 
      (setq fh "A") 
    ) 
    (setq text (vla-addtext 
   mspace 
   fh 
   (vlax-3d-point next_pt) 
   (getvar "dimtxt") 
        ) 
    ) 
    (vla-put-color text (getvar "dimclrt")) 
    (vla-put-stylename text (getvar "dimtxsty")) 
    (vla-update text) 
    (ssadd (entlast) ss1) 
    (setq line (vla-addline 
   mspace 
   (vlax-3d-point basept) 
   (vlax-3d-point next_pt) 
        ) 
    ) 
    (vla-put-color line (getvar "dimclrd")) 
    (ssadd (entlast) ss1) 
    (setq txtlen (tzz text)) 
    (setq l2end (list (+ (car next_pt) txtlen) (cadr next_pt) 0)) 
    (setq l2 (vla-addline 
        mspace 
        (vlax-3d-point next_pt) 
        (vlax-3d-point l2end) 
      ) 
    ) 
    (vla-put-color l2 (getvar "dimclrd")) 
    (ssadd (entlast) ss1) 
  ) 
  (progn 
    (vla-put-startpoint line (vlax-3d-point basept)) 
    (vla-put-endpoint line (vlax-3d-point next_pt)) 
    (vla-update line) 
    (setq ptt (car next_pt)) 
    (if (> ptt pt) 
      (progn 
        (setq text_x (+ (car next_pt) (getvar "dimgap"))) 
        (setq l2_x (+ (car next_pt) txtlen (getvar "dimgap"))) 
      ) 
      (progn 
        (setq text_x (- (car next_pt) (getvar "dimgap") txtlen)) 
        (setq l2_x text_x) 
      ) 
    ) 
    (vla-put-insertionpoint 
      text 
      (vlax-3d-point 
        (list text_x (+ (cadr next_pt) (getvar "dimgap")) 0) 
      ) 
    ) 
    (vla-update text) 
    (vla-put-startpoint l2 (vlax-3d-point next_pt)) 
    (setq l2end (list l2_x (cadr next_pt) 0)) 
    (vla-put-endpoint l2 (vlax-3d-point l2end)) 
    (vla-update l2) 
  ) 
       ) 
      ) 
      ((= READTYP 3)   ;左键击 
;;;       (MakeUnNameBlock ss1 cen) 
       (setq i nil) 
      ) 
      ((or (= 25 readtyp) (= 13 READVAL)) ;回车或右键 
       (setq fh1 fh) 
       (setq fh (getstring (strcat 
        "\n输入新视图符号 <" 
        fh 
        ">:" 
      ) 
  ) 
       ) 
       (if (= fh "") 
  (setq fh fh1) 
       ) 
       (vla-put-textstring text fh) 
       (vla-update text) 
       (setq txtlen (tzz text)) 
       (princ "\n指定视图符号放置位置 <右键或回车修改视图符号>:") 
      ) 
    ) 
  ) 
  (fd) 
  (princ) 
)

aeo · 发表于 2004-11-10 23:41:27

过点时间，我来写一个放大的（建筑,根据理正里的层和实体)
要处理的东西:
1.文字原来大小
2.dim ,保持原值
3.柱子空心，里面trim干净
4.能标出轴号最好.
5.各种标记性的，比如标高等，能保持原大小.

还有什么？大家说说。
或者，几个人，每人写一部分?

lsjjm · 发表于 2004-8-3 09:35:42

不用那么繁琐吧? 参考论坛有关贴子...

它山之石 · 发表于 2004-8-5 15:38:50

没看懂，你的程序是什么功能

aidraft · 发表于 2004-8-7 18:06:12

[php]
(prompt "\nDETAIL - (c)1998 AUTO-CODE MECHANICAL - *FREEWARE*")
;;
;; FREEWARE Program - you are free to make copies of this and supply it
;; to others as is. Author and company make no
;; warrenty on the fitness of this program for anything
;; other than using as an example when learning
;; AutoLISP.
;;
;; Adapted from the CADENCE January 1999 article by Bill Kramer
;;
;; Detail enlargement macro set.
;;-----------------------------------------------
;; The Main Program
;;-----------------------------------------------
(defun C:DETAIL ( / P1 EN EL PTS SS1)
 (cond
;;Set up AutoCAD system variables
((DETAIL_0)
 (prompt "\nError in DETAIL_0"))
;;
;;Operator input of detail center
;;and radius.
((DETAIL_1) ;;set up EL, P1, RD
 (prompt "\nError in DETAIL_1"))
;;
;;Operator input of detail graphic location
;;and scale for detail display.
;;Copy detail area, remove non-detail objects
;;like dimensions and text, and scale as
;;input by the operator.
((DETAIL_2) ;;set up P2, SS1, EN, ENT, SCL
 (prompt "\nError in DETAIL_2"))
;;
;;Do the trimming of the detail display.
((DETAIL_3)
 (prompt "\nError in DETAIL_3"))
;;
;;Create the text tag and draw connecting
;;line between original area and detail
;;area.
((DETAIL_4) ;;Output text tag
 (prompt "\nError in DETAIL_4"))
('T (prompt "\nDetail finished okay."))
 )
 ;;
 ;;Reset system variables
 (mapcar '(lambda (X)
 (setvar (car X) (cadr X))) SYSVAR_LIST)
 (prompt "\nUse TRIM to complete if needed.")
 (princ)
)
;;-----------------------------------------------
;; Listing 2: Set up system variables
;;-----------------------------------------------
(defun DETAIL_0 ()
(setq SYSVAR_LIST (mapcar '(lambda (X)
 (list X (getvar X)))
 '("CMDECHO"
 "OSMODE"
 "ORTHOMODE"
 "HIGHLIGHT"
 )))
(setvar "CMDECHO" 0)
(setvar "OSMODE" 0)
(setvar "ORTHOMODE" 0)
(setvar "HIGHLIGHT" 0)
(if (zerop (getvar "TILEMODE")) ;;make sure we are mspace
 (if (= (getvar "CVPORT") 1) (progn ;;we are in paper space!
 (alert "You must be in Model Space for this routine to function!")
 (exit) ;;hard abort!
 ))
)
(if (zerop (getvar "WORLDUCS"))
 (command "_UCS" "_W"))
nil
)
;;-----------------------------------------------
;; Listing 3: Establish area to detail
;;-----------------------------------------------
(defun DETAIL_1 ()
(setq P1 (getpoint "\nDetail center: "))
(if P1 (progn
 (prompt "\nShow detail area: ")
 (command "_CIRCLE" P1 pause)
 (setq EN (entlast)
 EL (entget EN)
 RD (if (= (cdr (assoc 0 EL)) "CIRCLE")
 (cdr (assoc 40 (entget EN)))
 nil)
 )
 (if RD (progn
 (entdel EN)
 (command "_POLYGON" 15 P1 "I" RD)
 (setq EN (entlast)
 EL (entget EN)
 )
 nil ;return nil
 )
 1 ;return error level 1.
 ) ;;level 1 is RD not set
)
2 ;;return error level 2.
) ;level 2 is P1 not set
)
;;-----------------------------------------------
;; Listing 4: Copy objects to new location
;;-----------------------------------------------
(defun DETAIL_2 ()
(while (setq TMP (assoc 10 EL))
 (setq EL (cdr (member TMP EL))
 PTS (cons (cdr TMP) PTS)
 )
)
(entdel EN)
(setq SS1 (ssget "CP" PTS)
 P2 (getpoint P1 "\nPut detail at: ")
 CNT (if SS1 (sslength SS1) 0)
)
(if P2 (progn
 (repeat CNT
 (if (member
 (cdr (assoc 0
 (entget
 (ssname
 SS1
 (setq CNT (1- CNT))))))
 '("TEXT" "DIMENSION"
 "MTEXT" "INSERT"
 )
 )
 (ssdel (ssname SS1 CNT) SS1)
 )
 )
 (command "_CIRCLE" P1 RD
 "_CIRCLE" P2 RD)
 (setq EN (entlast)
 ENT EN)
 (command "_COPY" SS1 "" P1 P2)
 (setq SS1 (ssadd EN))
 (while (setq ENT (entnext ENT))
 (ssadd ENT SS1)
 )
 (setq SCL (getreal "\nScale factor (2): "))
 (if (null SCL) (setq SCL 2.0))
 (if (/= SCL 1.0)
 (command "_SCALE" SS1 "" P2 SCL)
 )
 nil ;;return nil result, all okay.
)
1 ;;return error code 1
) ;;error code, P2 not input.
)
;;-----------------------------------------------
;; Listing 5: Trim the objects copied
;;-----------------------------------------------
(defun DETAIL_3 ()
(setq TTT 0) ;;change counter
(while (setq ENT (ssname SS1 0))
 (ssdel ENT SS1)
 (if (not (equal ENT EN)) (progn
 (setq EL (entget ENT)
 PT (DETAIL_3A EL)
 )
 (if (and PT
 (> (distance P2 PT)
 (+ 0.2 (* RD SCL))))
 (progn
 (setq TTT (1+ TTT))
 (command "_TRIM" EN ""
 (list ENT PT) "")
 ))
 ))
 (DETAIL_3B) ;;loop again check
)
nil
)
;;-----------------------------------------------
;; Listing 6: Find point on object for trim
;;-----------------------------------------------
(defun DETAIL_3A (EL / TY)
(setq TY (cdr (assoc 0 EL)))
(cond
 ((= TY "LINE")
 (if (> (distance (cdr (assoc 10 EL)) P2)
 (distance (cdr (assoc 11 EL)) P2))
 (cdr (assoc 10 EL))
 (cdr (assoc 11 EL))
 )
 )
 ((= TY "ARC")
 (setq PC (cdr (assoc 10 EL))
 PR (cdr (assoc 40 EL))
 PA (cdr (assoc 50 EL))
 PB (cdr (assoc 51 EL))
 )
 (if (> (distance (polar PC PA PR) P2)
 (distance (polar PC PB PR) P2))
 (polar PC PA PR)
 (polar PC PB PR)
 )
 )
 ((= TY "CIRCLE")
 (setq PC (cdr (assoc 10 EL))
 PR (cdr (assoc 40 EL))
 )
 (cond
 ((> (distance P2
 (polar PC 0.0 PR))
 (* RD SCL))
 (polar PC 0.0 PR))
 ((> (distance P2
 (polar PC PI PR))
 (* RD SCL))
 (polar PC PI PR))
 ((> (distance P2
 (polar PC (* 0.5 PI) PR))
 (* RD SCL))
 (polar PC (* 0.5 PI) PR))
 (t (polar PC (* 1.5 PI) PR))
 )
 )
 ((= TY "LWPOLYLINE")
 (setq PR nil)
 (while (and (null PR)
 (setq PA (assoc 10 EL)))
 (setq EL (cdr (member PA EL))
 PA (cdr PA)
 )
 (if (> (distance P2 PA) (* RD SCL))
 (setq PR PA)))
 )
 ((= TY "SPLINE")
 (setq PR nil)
 (while (and (null PR)
 (setq PA (assoc 11 EL))
 EL (cdr (member PA EL))
 PA (cdr PA))
 (if (> (distance P2 PA) (* RD SCL))
 (setq PR PA)))
 )
 ((= TY "POLYLINE")
 (setq EL (entget
 (entnext
 (cdr (assoc -1 EL))))
 PR nil)
 (while (and (null PR)
 (= (cdr (assoc 0 EL))
 "VERTEX"))
 (setq PA (cdr (assoc 10 EL))
 EL (entget
 (entnext
 (cdr (assoc -1 EL))))
 )
 (if (> (distance P2 PA)
 (* RD SCL))
 (setq PR PA)
 )
 )
 )
 ;;add more objects here
) ;;end COND for PT assignment
)
;;-----------------------------------------------
;; Listing 7: Loop control options for user
;;-----------------------------------------------
(defun DETAIL_3B ()
(if (= (sslength SS1) 0)
 (if (> TTT 0) (progn
 (initget 0 "Yes No")
 (setq TTT (getkword (strcat
 "\nChanged "
 (itoa TTT)
 " objects, Loop again? <Yes>")))
 (if (or (null TTT) (= TTT "Yes"))
 (progn
 (setq SS1 (ssadd EN)
 ENT EN)
 (while (setq ENT (entnext ENT))
 (ssadd ENT SS1)
 )
 (setq TTT 0)
 ))
 ))
)
)
;;-----------------------------------------------
;; Listing 8: Finishing touches
;;-----------------------------------------------
(defun DETAIL_4 ()
(command "_TEXT"
 "_Justify" "_Center"
 (polar P2
 (* PI 1.5)
 (+ (* SCL RD)
 (* 2.5
 (getvar "TEXTSIZE"))))
)
(if (zerop (cdr (assoc 40
 (tblsearch
 "STYLE"
 (getvar "TEXTSTYLE")))))
 (command "") ;;text height output option
)
(command 0 ;;finish the TEXT command sequence.
 (strcat "Enlarged "
 (rtos SCL 2
 (Best_Prec SCL 0 4))
 "x")
)
;;
;; Construct line between detail circles.
;;
(command "_LINE" (polar P1 (angle P1 P2) RD)
 (polar P2 (angle P2 P1) (* RD SCL))
 "")
nil
)
;;-----------------------------------------------
;; Listing 9: Utility Routine from toolbox
;;-----------------------------------------------
;; Best_Prec - Given a number (NUM) and the
;; minimum and maximum precision, this function
;; returns the precision in the range that will
;; best fit the number.
;;
(defun Best_Prec (Num Mn Mx)
(while (and (<= Mn Mx)
 (/= Num (atof (rtos Num 2 Mn))))
 (setq Mn (1+ Mn))
)
Mn
)
[/php]

它山之石 · 发表于 2004-8-9 15:43:39

应该增加一步“UNDO”功能，
另外应该给出矩形还是圆形的选择。

ljs026 · 发表于 2004-8-19 08:41:39

謝謝大大的分享
請問4樓樓主，你的程序，放大出來後，放大圓底下的Enlarged 2x 註解文字怎不會跟著圖紙比例變另？文字好小哦，請教教小弟如何更改，另外可以拿掉Changed 2 objects, Loop again? <Yes>這個選項嗎？小弟覺得有些麻煩說，如果小弟有個PHA的圖層，那麼放大出來的這個圓可以直接變成PHA層嗎？(圓裡面的物件層不變哦！只是放大的這個圓)

swaywood · 发表于 2004-11-10 22:22:12

放大后文字没有了

zh_6531394 · 发表于 2004-11-13 12:07:14

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

过点时间，我来写一个放大的（建筑,根据理正里的层和实体)
要处理的东西:
1.文字原来大小
2.dim ,保持原值
3.柱子空心，里面trim干净
4.能标出轴号最好.
5.各种标记性的，比如标高等，能保持原大小.

还有什么？大家说说。
或者，几个人，每人写一部分?

太好了,楼上的一看就知是行家最知我们的急苦,期待中

m24ck635 · 发表于 2004-11-13 20:57:41

高手啊，我佩服

设计者 · 发表于 2004-11-13 21:07:11

最初由 aeo 发布
[B]过点时间，我来写一个放大的（建筑,根据理正里的层和实体)
要处理的东西:
1.文字原来大小
2.dim ,保持原值
3.柱子空心，里面trim干净
4.能标出轴号最好.
5.各种标记性的，比如标高等，能保持原大小.

... [/B]

急切盼望这个好东东，这样画大样不知省多少时间哦！！！！

它山之石 · 发表于 2004-12-1 13:28:17

我们做结构倒不需要那么复杂。大多是在出变更的时候，需要从图中取出一部分，也不用放大。

urljit · 发表于 2004-12-14 13:19:11

楼上:咱们是同行了!你说的我也认同.

zhuquanmao · 发表于 2004-12-15 20:58:36

什么时候才能搞出来啊都这么长时间了呵呵

sdwy19691229 · 发表于 2004-12-15 22:00:01

我觉得思路是好的，可能方法太繁琐。

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

[原创]：一个局部放大程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子