付费，寻找懂视口的高手制作一个插件

caiqs

;;师兄 QQ361865648 Tel:13736698134于2019/12/16
;;闲来无事发一贴刷下存在感
(defun c:Vscl (/        center         curitm          dimscale ent            entdat
               etype        extcode         extinfo  extp1           extp2    hei
               i        j         len          lst           maxx            maxy
               minx        miny         msphei          mspwid   n1            n2
               newdat        newext         newextinfo           pickent  scale
               sclalecode         ss          vporthei wid            x
               y
              )
  (command "_.Pspace")
  (setq pickent (VL-CATCH-ALL-APPLY 'entsel '("\n拾取布局视口: ")))
  (if (VL-CATCH-ALL-ERROR-P pickent)
    (VL-EXIT-WITH-VALUE 0)
  )

  (setq ent (car pickent))
  (setq        entdat (entget ent)
        etype  (cdr (assoc 0 entdat))
  )
  (if (/= etype "VIEWPORT")
    (VL-EXIT-WITH-VALUE 0)
  )

  (setq lst (entget ent))
  (setq        wid         (cdr (assoc 40 lst)) ;_布局视口宽
        hei         (cdr (assoc 41 lst)) ;_布局视口高
        center         (cdr (assoc 12 lst)) ;_视口中心点wcs
        vporthei (cdr (assoc 45 lst))
        scale         (/ hei vporthei) ;_视口比例
        mspwid         (/ wid scale) ;_模型空间范围宽度
        msphei         (/ hei scale) ;_模型空间范围高度
        x         (car center)
        y         (cadr center)
        minx         (- x mspwid)
        maxx         (+ x mspwid)
        miny         (- y msphei)
        maxy         (+ y msphei)
        extp1         (list minx miny) ;_模型空间左下角点
        extp2         (list maxx maxy) ;_模型空间右上角点
  )
  (command "_.mspace")
;;;(command "_.zoom" "W" extp2 extp1)
  (setq        ss (ssget "_c"
                  extp2
                  extp1
                  (list (cons 0 "DIMENSION,LEADER,ARC_DIMENSION"))
           )
  )
  (setq dimscale (/ 1.0 scale)) ;_新的标注比例
  (setq i 0)
  (if ss
    (repeat (sslength ss)
      (setq ent        (ssname ss i)
            i        (1+ i)
      )
      (setq entdat (entget ent '("ACAD")))
      (setq extinfo (assoc -3 entdat))
      (setq sclalecode (cons 1040 dimscale))
      (cond
        (extinfo
         (setq extcode (cadr extinfo))
         (setq n1 (VL-POSITION (cons 1070 40) extcode))
         (setq n2 (VL-POSITION (cons 1002 "{") extcode))
         (setq j      0
               newext nil
               len    (length extcode)
         )
         (cond
           (n1
            (repeat len
              (setq curitm (nth j extcode))
              (if (= j (1+ n1))
                (setq newext (cons sclalecode newext))
                (setq newext (cons curitm newext))
              )
              (setq j (1+ j))
            )
           )
           (n2
            (repeat len
              (setq curitm (nth j extcode))
              (if (= j (1+ n2))
                (setq newext (cons sclalecode newext))
              )
              (setq newext (cons curitm newext))
              (setq j (1+ j))
            )
           )
         )
         (setq newext (REVERSE newext))
         (setq newextinfo (cons -3 (list newext)))
         (setq newdat (subst newextinfo extinfo entdat))
        )
        (t
         (setq newdat (REVERSE entdat)
               newdat
                      (cons
                        (cons
                          -3
                          (list        (cons "ACAD"
                                      (list
                                        (cons 1000 "DSTYLE")
                                        (cons 1002 "{")
                                        (cons 1070 40)
                                        (cons 1040 dimscale)
                                        (cons 1002 "}")
                                      )
                                )
                          )
                        )
                        newdat
                      )
               newdat (REVERSE newdat)
         )
        )
      )
      (entmod newdat)
      (entupd ent)
    )
  )
  (command "_.Pspace")
)

lwl450

caiqs 发表于 2019-12-16 22:34
;;师兄 QQ361865648 Tel:13736698134于2019/12/16
;;闲来无事发一贴刷下存在感
(defun c:Vscl (/        center         ...

师兄厉害，架构构思有了看来有希望弄成自己想要的了，谢谢师兄了

wt1688

这个看上不难啊