864643236 发表于 2017-11-8 19:35:38

拜托大神能帮我看看这个代码,为什么只能在俯视图里使用

xy轴比例调节

(defun C:11 (/ bp ss xscal yscal entL)
(setvar "qaflags" 0)
(defun errexit (s)
    (princ "\nError:")
    (princ s)
    (restore)
)

(defun restore ()
    (setvar "CMDECHO" (car oldvar))
    (setq *error* olderr)
    (princ)
)

(defun MAKEUNBLOCK (ss ip / tmp errexit mbx BLAYER)
    (setq olderr*error*
          *error* errexit
    )
    (setq oldvar (list (getvar "CMDECHO")))
    (setvar "CMDECHO" 0)
    (terpri)
    (if        BLAYER
      (command "._LAYER"
             (if (tblsearch "LAYER" BLAYER)
               "_S"
               "_M"
             )
             BLAYER
             ""
      )
    )
    (if        (and
          ip
          ss
        )
      (progn
        (entmake (list (cons '0 "BLOCK")
                     (cons '2 "*U")
                     (cons '70 1)
                     (cons '10 ip)
               )
        )
        (setq cnt (sslength ss))
        (while (>= (setq cnt (1- cnt))
                   0
             )
          (setq tmp (ssname ss cnt))
          (entmake (setq el (entget tmp)))
          (if (> (cdr (assoc 66 el)) 0)
          (while (/= "SEQEND"
                     (cdr (assoc 0
                                   (entmake (setq el
                                                   (entget
                                                     (entnext
                                                     (cdr
                                                       (assoc -1 el)
                                                     )
                                                     )
                                                   )
                                          )
                                   )
                          )
                     )
                   )
          )
          )
          (entdel tmp)
        )
        (setq tmp (entmake (list (cons '0 "ENDBLK"))))
        (entmake
          (list (cons '0 "INSERT") (cons '2 tmp) (cons '10 ip))
        )
      )
    )
    (restore)
)
(setq ss (cadr (ssgetfirst)))
(while (= ss nil)
    (setq ss (ssget))                        ; 选择缩放实体
)
(setq        i 0
        dwcorn nil
        upcorn nil
)
(repeat (sslength ss)
    (setq ent (ssname ss i))
    (setq obj (vlax-ename->vla-object ent))
    (vla-GetBoundingBox obj 'pta 'ptb)
    (setq dwcorn (cons (vlax-safearray->list pta) dwcorn))
    (setq upcorn (cons (vlax-safearray->list ptb) upcorn))
    (setq i (1+ i))
)
(setq        ptlist (append
               dwcorn
               upcorn
             )
)
(setq        x (mapcar
          'car
          ptlist
          )
)
(setq        y (mapcar
          'cadr
          ptlist
          )
)
(setq        x1 (apply
             'min
             x
           )
)
(setq        y1 (apply
             'min
             y
           )
)
(setq        x2 (apply
             'max
             x
           )
)
(setq        y2 (apply
             'max
             y
           )
)
(setq xx (- (car (list x2 y2)) (car (list x1 y1))))
(setq yy (- (cadr (list x2 y2)) (cadr (list x1 y1))))
(if ss
    (progn
      (setq bp (polar (list x1 y1)
                      (angle (list x1 y1) (list x2 y2))
                      (/ (distance (list x1 y1) (list x2 y2)) 2)
             )
      )
      (setq xx1 (getdist "\n指定新的X方向尺寸:"))
      (setq yy1 (getdist "\n指定新的Y方向尺寸:"))

      (setq xscal (/ xx1 xx))
      (setq yscal (/ yy1 yy))
      (MAKEUNBLOCK ss bp)
      (setq entL (entget (entLast))
          entL (subst
                   (cons 41 xscal)
                   (assoc 41 entL)
                   entL
               )
          entL (subst
                   (cons 42 yscal)
                   (assoc 42 entL)
                   entL
               )
      )
      (entmod entL)
      (command "_explode" "l")
    )
)
(princ)
)


请大神能帮我修改哈这个代码,只能在俯视图里面使用,其他视图不能用


pengfei2010 发表于 2017-11-10 09:06:57

回帖是一种美德!感谢楼主的无私分享 谢谢

davide888 发表于 2017-11-8 21:48:13

是加Z轴不   

864643236 发表于 2017-11-9 07:36:39

不是加z轴,我遇见很多插件都是这样,cad 中默认的只能在顶视图中自动生成图形,可是我喜欢在主视图中绘制,但在主视图里就不能正常使用了,不知道要怎么修改

xinxirong 发表于 2017-11-9 08:21:49

单步调试,总能找到问题是所在

ll_j 发表于 2017-11-9 08:34:56

你试着把上面的控制点ptlist使用trans函数转换一下,看看能不能解决,dxf组码得到的点是世界坐标系的,需要转换到当前坐标系操作,操作完毕后在转回世界坐标系,才能操作修改实体。
现在不太动Lisp了,就不帮你调试了。

xinxirong 发表于 2017-11-9 17:58:28

解决办法,所有点trans到view就应该能解决了。

864643236 发表于 2017-11-9 18:40:59

能具体点吗?朋友

864643236 发表于 2017-11-9 22:06:48

还有朋友知道这个问题吗,麻烦帮忙解决哈,感谢

864643236 发表于 2017-11-9 22:07:27

ll_j 发表于 2017-11-9 08:34
你试着把上面的控制点ptlist使用trans函数转换一下,看看能不能解决,dxf组码得到的点是世界坐标系的,需要 ...

你说的办法能具体点吗,朋友
页: [1]
查看完整版本: 拜托大神能帮我看看这个代码,为什么只能在俯视图里使用