成功原位纠正圆的210组码，形状位置不变

/db_自贡黄明儒_ · 发表于 2018-8-24 18:24:04

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

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

×

成功原位纠正圆的210组码，形状位置不变。其它的还没有搞定

(defun C:ww (/ E EN)
;;不考虑块和文字,块可以先爆破
(setq e (car (entsel)))
(setq en (entget e))
;;改变210,视觉位置可能移动
(entmod (subst '(210 1 1 1) (assoc 210 en) en))
;;画一方框，用于观察纠正后位置有没移动
(setq obj (vlax-ename->vla-object e))
(vla-GetBoundingBox obj 'll 'uu)
(setq ll (safearray-value ll))
(setq uu (safearray-value uu))
(command "_.rectang" ll uu)
;;纠正210,使形状和位置不变
(_RemainShape e)
(princ)
)
;;下面实体支持非等比例：
;;(wcmatch str "AcDbLeader,AcDbMLine,AcDbMText,AcDbOle2Frame,AcDbPloyFaceMesh,AcDbPolygonMesh,AcDbRay,AcDbXline,AcDbFcf,AcDbSolid,AcDbEllipse,AcDbSpline,AcDbImage")
(defun _RemainShape (e / ANG CMDECHO EN L LL NAME OBJ OSMODE P0 P1 P210 UU X Y)
(setq en (entget e))
(setq p210 (cdr (assoc 210 en)))
(if (not (equal '(0.0 0.0 1.0) p210))
(progn
;;L*直径后，投影后的短轴长度
(setq L (sqrt (- 1 (* (car p210)(car p210)) (* (cadr p210)(cadr p210)))))
;;投影后长轴与X夹角
(setq ang (atan (/ (car p210) (cadr p210))))
(setq osmode (getvar "osmode"))
(setq cmdecho (getvar "cmdecho"))
(Setvar "cmdecho" 0)
(Setvar "osmode" 0)
;;求块插入中心点
(setq obj (vlax-ename->vla-object e))
(vla-GetBoundingBox obj 'll 'uu)
(setq ll (safearray-value ll))
(setq uu (safearray-value uu))
(setq p0 (mapcar '(lambda (x y) (* (+ x y) 0.5)) ll uu))
(setq p0 (mapcar '+ '(0 0) p0)) ;3D=>2D
;;制作块;采用entmake,command、vla-insertblock失败
(entmod (subst '(210 0 0 1) (assoc 210 en) en));纠正
(vla-GetBoundingBox obj 'll 'uu)
(setq ll (safearray-value ll))
(setq uu (safearray-value uu))
(setq p1 (mapcar '(lambda (x y) (* (+ x y) 0.5)) ll uu))
(setq p1 (mapcar '+ '(0 0) p1))
(entmake
(list '(0 . "BLOCK")
'(2 . "*U")
'(70 . 1)
(cons 10 p1)
)
)
(entmake (entget e))
;;(command "_.BLOCK" "*U" "non" p0 e "")不能用于无名块
(setq name (entmake '((0 . "ENDBLK"))))
(entmake (list '(0 . "INSERT")
(cons 2 name)
(cons 10 p0)
(cons 41 L)
(cons 42 1)
(cons 43 1)
(cons 50 ang)
'(210 0 0 1)
)
)
(vl-cmdf "._explode" "L")
(vla-delete obj) ;删除
(or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
(or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
;;(vla-delete (vla-item (vla-get-blocks *DOC*) name));清除块
(Setvar "cmdecho" cmdecho)
(Setvar "osmode" osmode)
)
)
)

(defun C:ww (/ E EN) 
  ;;不考虑块和文字,块可以先爆破 
  (setq e (car (entsel))) 
  (setq en (entget e)) 
  ;;改变210,视觉位置可能移动 
  (entmod (subst '(210 1 1 1) (assoc 210 en) en)) 
  ;;画一方框，用于观察纠正后位置有没移动 
  (setq obj (vlax-ename->vla-object e)) 
  (vla-GetBoundingBox obj 'll 'uu) 
  (setq ll (safearray-value ll)) 
  (setq uu (safearray-value uu)) 
  (command "_.rectang" ll uu) 
   
  ;;纠正210,使形状和位置不变 
  (_RemainShape e) 
  (princ) 
) 
;;下面实体支持非等比例： 
;;(wcmatch str "AcDbLeader,AcDbMLine,AcDbMText,AcDbOle2Frame,AcDbPloyFaceMesh,AcDbPolygonMesh,AcDbRay,AcDbXline,AcDbFcf,AcDbSolid,AcDbEllipse,AcDbSpline,AcDbImage") 
 
(defun _RemainShape (e / ANG CMDECHO EN L LL NAME OBJ OSMODE P0 P1 P210 UU X Y) 
  (setq en (entget e)) 
  (setq p210 (cdr (assoc 210 en))) 
  (if (not (equal '(0.0 0.0 1.0) p210)) 
    (progn 
      ;;L*直径后，投影后的短轴长度 
      (setq L (sqrt (- 1  (* (car p210)(car p210)) (* (cadr p210)(cadr p210))))) 
      ;;投影后长轴与X夹角 
      (setq ang (atan (/  (car p210) (cadr p210)))) 
       
      (setq osmode (getvar "osmode")) 
      (setq cmdecho (getvar "cmdecho")) 
      (Setvar "cmdecho" 0) 
      (Setvar "osmode" 0) 
 
      ;;求块插入 中心点 
      (setq obj (vlax-ename->vla-object e)) 
      (vla-GetBoundingBox obj 'll 'uu) 
      (setq ll (safearray-value ll)) 
      (setq uu (safearray-value uu)) 
      (setq p0 (mapcar '(lambda (x y) (* (+ x y) 0.5)) ll uu)) 
      (setq p0 (mapcar '+ '(0 0) p0))                            ;3D=>2D 
      ;;制作块;采用entmake,command、vla-insertblock失败 
      (entmod (subst '(210 0 0 1) (assoc 210 en) en));纠正 
      (vla-GetBoundingBox obj 'll 'uu) 
      (setq ll (safearray-value ll)) 
      (setq uu (safearray-value uu)) 
      (setq p1 (mapcar '(lambda (x y) (* (+ x y) 0.5)) ll uu)) 
      (setq p1 (mapcar '+ '(0 0) p1)) 
      (entmake 
        (list '(0 . "BLOCK") 
              '(2 . "*U") 
              '(70 . 1) 
              (cons 10 p1) 
        ) 
      )    
      (entmake (entget e)) 
      ;;(command "_.BLOCK" "*U" "non" p0 e "")不能用于无名块 
      (setq name (entmake '((0 . "ENDBLK")))) 
       
      (entmake (list '(0 . "INSERT") 
                     (cons 2 name) 
                     (cons 10 p0) 
                     (cons 41 L) 
                     (cons 42 1) 
                     (cons 43 1) 
                     (cons 50 ang) 
                     '(210 0 0 1) 
               ) 
      ) 
      (vl-cmdf "._explode" "L") 
      (vla-delete obj)                                            ;删除 
       
      (or *ACAD* (setq *ACAD* (vlax-get-acad-object))) 
      (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*))) 
      ;;(vla-delete (vla-item (vla-get-blocks *DOC*) name));清除块 
 
      (Setvar "cmdecho" cmdecho) 
      (Setvar "osmode" osmode) 
    ) 
  ) 
)

st788796 · 发表于 2018-8-24 18:32:05

投影到哪个面？WCS 的 X/Y ？

圆投影是椭圆（圆是特殊的椭圆），可以计算出来直接绘制投影椭圆

sicky111 · 发表于 2018-8-25 11:07:16

向黄工学习！

/db_自贡黄明儒_ · 发表于 2018-8-27 15:03:02

st788796 发表于 2018-8-24 18:32
投影到哪个面？WCS 的 X/Y ？

圆投影是椭圆（圆是特殊的椭圆），可以计算出来直接绘制投影椭圆

You are right!

;;下面实体支持非等比例：
;;(wcmatch str "AcDbLeader,AcDbMLine,AcDbMText,AcDbOle2Frame,AcDbPloyFaceMesh,AcDbPolygonMesh,AcDbRay,AcDbXline,AcDbFcf,AcDbSolid,AcDbEllipse,AcDbSpline,AcDbImage")
(defun _RemainArcCircle (e / EN P0 P1 P11 P2 P210 P3 P4 P40 P41 P51 R)
(setq en (entget e))
(setq p210 (cdr (assoc 210 en)))
(if (not (equal '(0.0 0.0 1.0) p210))
(progn
(setq p0 (cdr (assoc 10 en)));椭圆中心点
(setq R (cdr (assoc 40 en)))
(setq p1 (mapcar '+ (list R 0) p0))
(setq p2 (mapcar '+ (list 0 R) p0))
(setq p3 (mapcar '+ (list (- R) 0) p0))
(setq p4 (mapcar '+ (list 0 (- R)) p0))
(setq p0 (trans p0 p210 0))
(setq p1 (trans p1 p210 0))
(setq p2 (trans p2 p210 0))
(setq p3 (trans p3 p210 0))
(setq p4 (trans p4 p210 0))
(setq p0 (mapcar '+ '(0 0) p0))
(setq p1 (mapcar '+ '(0 0) p1))
(setq p2 (mapcar '+ '(0 0) p2))
(setq p3 (mapcar '+ '(0 0) p3))
(setq p4 (mapcar '+ '(0 0) p4))
(setq p40 (/ (distance p2 p4) (distance p1 p3)));短轴与长轴比
(setq p11 (mapcar '- p1 p0))
(if (setq p41 (cdr (assoc 50 en)))
nil
(setq p41 0.0)
)
(if (setq p51 (cdr (assoc 51 en)))
nil
(setq p51 (* pi 2))
)
(entmake
(list '(0 . "ELLIPSE")
'(100 . "AcDbEntity")
'(100 . "AcDbEllipse")
(cons 10 p0)
(cons 11 p11)
(cons 40 p40)
(cons 41 p41)
(cons 42 p51)
'(210 0 0 1)
)
)
(entdel e)
)
)
)

;;下面实体支持非等比例： 
;;(wcmatch str "AcDbLeader,AcDbMLine,AcDbMText,AcDbOle2Frame,AcDbPloyFaceMesh,AcDbPolygonMesh,AcDbRay,AcDbXline,AcDbFcf,AcDbSolid,AcDbEllipse,AcDbSpline,AcDbImage") 
(defun _RemainArcCircle (e / EN P0 P1 P11 P2 P210 P3 P4 P40 P41 P51 R) 
  (setq en (entget e)) 
  (setq p210 (cdr (assoc 210 en))) 
  (if (not (equal '(0.0 0.0 1.0) p210)) 
    (progn 
      (setq p0 (cdr (assoc 10 en)));椭圆 中心点 
      (setq R (cdr (assoc 40 en))) 
      (setq p1 (mapcar '+ (list R 0) p0)) 
      (setq p2 (mapcar '+ (list 0 R) p0)) 
      (setq p3 (mapcar '+ (list (- R) 0) p0)) 
      (setq p4 (mapcar '+ (list 0 (- R)) p0)) 
      (setq p0 (trans p0 p210 0)) 
      (setq p1 (trans p1 p210 0)) 
      (setq p2 (trans p2 p210 0)) 
      (setq p3 (trans p3 p210 0)) 
      (setq p4 (trans p4 p210 0)) 
      (setq p0 (mapcar '+ '(0 0) p0)) 
      (setq p1 (mapcar '+ '(0 0) p1)) 
      (setq p2 (mapcar '+ '(0 0) p2)) 
      (setq p3 (mapcar '+ '(0 0) p3)) 
      (setq p4 (mapcar '+ '(0 0) p4)) 
      (setq p40 (/ (distance p2 p4) (distance p1 p3)));短轴与长轴比 
      (setq p11 (mapcar '- p1 p0)) 
      (if (setq p41 (cdr (assoc 50 en))) 
        nil 
        (setq p41 0.0) 
      ) 
      (if (setq p51 (cdr (assoc 51 en))) 
        nil 
        (setq p51 (* pi 2)) 
      )       
      (entmake 
        (list '(0 . "ELLIPSE") 
              '(100 . "AcDbEntity") 
              '(100 . "AcDbEllipse") 
              (cons 10 p0) 
              (cons 11 p11) 
              (cons 40 p40) 
              (cons 41 p41) 
              (cons 42 p51) 
              '(210 0 0 1) 
        ) 
      ) 
      (entdel e) 
    ) 
  ) 
)

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

[研讨] 成功原位纠正圆的210组码，形状位置不变

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