vlisp学习第468天：修改块基点自定义函数，叉乘、坐标转换等的学习

水吉空

;;说明ljb-tk-ChInsPt修改块基点
;;参数InsertEName:图块名
;;参数oldInsPt1:原块基点
;;参数newInsPt1:新快基点
;;返回:
(defun ljb-tk-ChInsPt (InsertEName          oldInsPt1     newInsPt1  /
                                 doc       blks          sel     BlockName  blkdef
                                 oldInsPt2  newInsPt2  ss     idx        XformSpec
                                 atts       att
                             )
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq blks (vla-get-blocks doc))
  (setq    BlockName (cdr (assoc 2 (entget InsertEName)))
    XformSpec (BlockToInsertSetup InsertEName)
    ) ;((0.908879 0.41706 0.0) (-0.41706 0.908879 0.0) (0.0 0.0 1.0) (1586.61 340.397
;0.0) (1.0 1.0 1.0))
  (setq    oldInsPt2 (InsertToBlockXform oldInsPt1 XformSpec)
    newInsPt2 (InsertToBlockXform newInsPt1 XformSpec)
    )
  (setq blkdef (vla-item blks BlockName))
  (vlax-for obj    blkdef
    (vla-move obj
            (vlax-3d-point newInsPt2)
            (vlax-3d-point oldInsPt2)
        )
    )
  (setq ss (ssget "x" (list (cons 0 "INSERT") (cons 2 BlockName))))
  (setq idx 0)
  (repeat (sslength ss)
    (setq InsertEName (ssname ss idx)
      XformSpec   (BlockToInsertSetup InsertEName)
        )
    (setq oldInsPt1 (BlockToInsertXform oldInsPt2 XformSpec)
      newInsPt1 (BlockToInsertXform newInsPt2 XformSpec)
        )
    (setq InsertObj (vlax-ename->vla-object InsertEName))
    (vla-move InsertObj
            (vlax-3d-point oldInsPt1)
            (vlax-3d-point newInsPt1)
        )
    (if    (= (vla-get-HasAttributes InsertObj) :vlax-true)
      (progn
                (setq atts (vlax-safearray->list
                                         (vlax-variant-value
                                             (vla-GetAttributes InsertObj)
                                         )
                                     )
                )
                (foreach att atts
                    (vla-move att
            (vlax-3d-point newInsPt1)
            (vlax-3d-point oldInsPt1)
                    )
                )
            )
        )
    (setq idx (1+ idx))
    ) ;repeat
  (princ)
)
(progn (defun InsertToBlockXform (P1 TransformSpec)
  (3dTransformBA
    (nth 0 TransformSpec)
    (nth 1 TransformSpec)
    (nth 2 TransformSpec)
    (nth 3 TransformSpec)
    (nth 4 TransformSpec)
    P1
  ) ;_ end 3dTransformBA
)
(defun InsertToBlockXform (P1 TransformSpec)
  (3dTransformBA
    (nth 0 TransformSpec)
    (nth 1 TransformSpec)
    (nth 2 TransformSpec)
    (nth 3 TransformSpec)
    (nth 4 TransformSpec)
    P1
  ) ;_ end 3dTransformBA
)
;块插入设置
;(BlockToInsertSetup InsertEname)
(defun BlockToInsertSetup (InsertEname
                                                        /
                                                        InsertEList
                                                        ZAxis
                                                        NCSXAxis
                                                        InsertAngle
                          )
  (setq ZAxis       (cdr (assoc 210 (setq InsertEList (entget InsertEName)))) ;拉伸方向
        InsertAngle (cdr (assoc 50 InsertEList)) ;旋转
        NCSXAxis    (trans (list (cos InsertAngle) (sin InsertAngle) 0.0);(1.0 0.0 0.0)
                                    (cdr (assoc 210 InsertEList)) ;拉伸方向sin(0.0 0.0 1.0)
                                    0
                                ) ;_ end trans
  ) ;_ end setq
  (list NCSXAxis
        (VectorCrossProduct ZAxis NCSXAxis)
        ZAxis
        
        (trans (cdr (assoc 10 InsertEList)) ZAxis 0)
        
        (list (cdr (assoc 41 InsertEList))
            (cdr (assoc 42 InsertEList))
            (cdr (assoc 43 InsertEList))
        ) ;_ end list
  ) ;_ end list
)
(defun BlockToInsertXform (P1 TransformSpec)
  (3dTransformTT
    (nth 0 TransformSpec)
    (nth 1 TransformSpec)
    (nth 2 TransformSpec)
    (nth 3 TransformSpec)
    (nth 4 TransformSpec)
    P1
  ) ;_ end 3dTransformTT
)
(defun BlockToInsertXform (P1 TransformSpec)
  (3dTransformTT
    (nth 0 TransformSpec)
    (nth 1 TransformSpec)
    (nth 2 TransformSpec)
    (nth 3 TransformSpec)
    (nth 4 TransformSpec)
    P1
  ) ;_ end 3dTransformTT
)
;向量交叉相乘
(defun VectorCrossProduct (InputVector1 InputVector2)
  (list (- (* (cadr InputVector1) (caddr InputVector2))
                    (* (cadr InputVector2) (caddr InputVector1))
        ) ;_ end -
        (- (* (caddr InputVector1) (car InputVector2))
            (* (caddr InputVector2) (car InputVector1))
        ) ;_ end -
        (- (* (car InputVector1) (cadr InputVector2))
            (* (car InputVector2) (cadr InputVector1))
        ) ;_ end -
  ) ;_ end list
)
(defun 3DTransformBA (XA YA ZA OA SA P1 /)
   
  (setq P1 (mapcar '- P1 OA))
   
  (mapcar '/
        
        (list (+ (* (car XA) (car P1))
                        (* (cadr XA) (cadr P1))
                        (* (caddr XA) (caddr P1))
                    ) ;_ end +
            (+ (* (car YA) (car P1))
                (* (cadr YA) (cadr P1))
                (* (caddr YA) (caddr P1))
            ) ;_ end +
            (+ (* (car ZA) (car P1))
                (* (cadr ZA) (cadr P1))
                (* (caddr ZA) (caddr P1))
            ) ;_ end +
        ) ;_ end list
        SA
  ) ;_ end mapcar
)
(defun 3DTransformTT (XA YA ZA OA SA P1 /)
  
  (setq P1 (mapcar '* P1 SA))
  
  (mapcar '+
        OA
        
        (list (+ (* (car XA) (car P1))
                        (* (car YA) (cadr P1))
                        (* (car ZA) (caddr P1))
                    ) ;_ end +
            (+ (* (cadr XA) (car P1))
                (* (cadr YA) (cadr P1))
                (* (cadr ZA) (caddr P1))
            ) ;_ end +
            (+ (* (caddr XA) (car P1))
                (* (caddr YA) (cadr P1))
                (* (caddr ZA) (caddr P1))
            ) ;_ end +
        ) ;_ end list
  ) ;_ end mapcar
))

依然小小鸟

Kye

楼主，能不能少发点贴?好几个贴子都显示 此贴仅作者可见

水吉空

Kye 发表于 2018-1-16 20:12
楼主，能不能少发点贴?好几个贴子都显示 此贴仅作者可见

好的，以后没事不发帖了。

依然小小鸟

Kye 发表于 2018-1-16 20:12
楼主，能不能少发点贴?好几个贴子都显示 此贴仅作者可见

因为他怕大家看到证据

ghgh0130

WCS转OCS X轴向量 (list (cos ang) (sin ang) 0)
OCS转WCS X轴向量 (list (cos ang) (- (sin ang)) 0)
楼主你的程序好像没有注意这一点.

水吉空

ghgh0130 发表于 2018-1-20 12:50
WCS转OCS X轴向量 (list (cos ang) (sin ang) 0)
OCS转WCS X轴向量 (list (cos ang) (- (sin ang)) 0)
楼 ...

谢谢大神提醒

LIULISHENG