[分享]不同图框自动更改全局比例--转载

用了AutoCAD Mechanical一段时间,觉得增强标注不错,在论坛上没找到相关程序,于是自己用Lisp写了一个.
支持dli,dra,dal,ddi,dor,dan等常用标注命令.在不同比例的图框中自动切换全局比例.
图框名为GB_A*,可以在程序中修改.比例根据块比例得到.

选图框自动根据图框比例修改图框内全部标注全局比例
增加对文字高度,线型比例,填充线比例支持.

不知道为什么无法上传 附件。一个是lsp 两个GIF。

我觉得这个程序非常好，共享给大家一起来完善。目前标注，和文字都是支持的。但是引线不支持 版主不能完善一下。
https://drive.google.com/file/d/0B4Wtg7ObicFFOFJ3UEdaQWZtTTg/view?usp=sharing
https://drive.google.com/file/d/0B4Wtg7ObicFFalNjN3kzR1BhZms/view?usp=sharing
https://drive.google.com/file/d/0B4Wtg7ObicFFeTViOXZOVUFDem8/view?usp=sharing

你好～
請問這LSP
是指AutoCAD Mechanical 與AutoCAD都可以用是這個意思嗎...

是的亲测

二個gif檔案是動畫，沒法直接以附件方式上傳，要轉成影音格式avi,mp4...
在網上找了一下，以下鏈結可以下載轉檔程式而且是免費的
http://www.azofreeware.com/2008/10/formatfactory-155.html
轉體名稱：格式工廠
影片1

https://youtu.be/knPxTW9Ko

影片2

https://youtu.be/w4GeYkQ-c2k
以下把原始lsp上傳（版權屬原作者），其中有幾簡體字已轉為繁體字

代碼:

(defun ax:getboundingbox (entname / entpl entpr ptlist)
  (vla-getboundingbox (vlax-ename->vla-object entname) 'entpl 'entpr)
  (setq ptlist (mapcar 'vlax-safearray->list (list entpl entpr)))
  (mapcar '(lambda (x) (trans x 0 1)) ptlist)
)
(defun getentdxf (ent dxf)
  (cond
    ((= (type ent) 'ename)
      (cdr (assoc dxf (entget ent '("*"))))
    )
    ((= (type ent) 'vla-object)
      (cdr (assoc dxf (entget (vlax-vla-object->ename ent) '("*"))))
    )
  )
)
(setq *en2obj* vlax-ename->vla-object)
(defun c:ds ( / entgrp entgrpt entname entnamet n ptlist scale)
  (prompt "根據圖框比例自動改變圖框內所有標註比例")
  (if (setq entgrpt (ssget '((0 . "insert")(2 . "GB_A*"))))
    (repeat (setq nn (sslength entgrpt))
      (progn
        (setq entnamet (ssname entgrpt (setq nn (1- nn))))
        (command "zoom" "o" entnamet "")
 (setq ptlist (ax:getboundingbox entnamet))
 (setq entgrp (ssget "W" (car ptlist) (cadr ptlist) '((0 . "DIMENSION,*TEXT,*LINE,HATCH"))))
 (setq scale (vla-get-XScaleFactor (*en2obj* entnamet)))
 (repeat (setq n (sslength entgrp))
  (setq entname (ssname entgrp (setq n (1- n))))
  (cond
    ((= "HATCH" (getentdxf entname 0))
      (vla-put-PatternScale (*en2obj* entname) scale)
    )
    ((= "DIMENSION" (getentdxf entname 0))
      (vla-put-ScaleFactor (*en2obj* entname) scale)
    )
    ((wcmatch (getentdxf entname 0) "*TEXT")
      (vla-put-Height (*en2obj* entname) (* (getvar "textsize") scale))
    )
    ((wcmatch (getentdxf entname 0) "*LINE")
      (vla-put-LinetypeScale (*en2obj* entname) scale)
    )
  )
 )
      )
    )
  )
  (princ)
)


y有没有办法把引线也添加进去。这个估计得苹果爸出马了

請問是不是少了東西，圖框

djh1006 寫到:請問是不是少了東西，圖框

图框自己做。就是一个块。然后按照块比例还来做。你做个一块按照图纸框大小。放大50就是50倍。

苹果爸爸，啥时候看到来解决一下。把标注引线也添加进去。