用户坐标系下，块中直线定位点-----------练习

/db_自贡黄明儒_

;;用户坐标系下，拾取对象的定位点(包括块内对象)
;;相当于getpoint，下面的程序意义不大
(defun C:w2 (/ E E1 EN MAT1 P10W PT)
  (if (setq e (entsel))
    (progn
      (setq pt (cadr e))                                              ;击点
      (setq e (car e))                                                      ;块
      (setq en (nentselp "" pt))
      (if (= (length en) 4)
        (progn
          (setq e (car (cadddr en)))                                      ;块
          (setq e1 (car en))                                              ;块内图元
          (setq mat1 (caddr en))
          (setq P10w (cdr (assoc 10 (entget e1))))
          (setq P10w (mat:mxp mat1 P10w))                              ;wcs
        )
        (setq P10w (cdr (assoc 10 (entget e))))
      )
      (trans P10W 0 1)                                                      ;ucs
    )
  )
)
;;用户坐标系下，拾取点在对象内的位置
;;不使用矩阵
(defun C:w3 (/ E EN PT PT1)
  (if (setq e (entsel))
    (progn
      (setq pt (cadr e))                                              ;击点
      (setq e (car e))                                                      ;块
      (setq en (nentselp "" pt))
      (if (= (length en) 4)
        (progn
          (setq e (car (cadddr en)))                                      ;块
          (setq pt1 (trans pt 1 0))
          (vl-cmdf "_.ucs" "_OB" e)                                      ;wcs
          (setq pt (trans pt1 0 1))                                      ;ucs
          (vl-cmdf "_.ucs" "_p")                                      ;恢复ucs
        )
      )
      pt
    )
  )
)

xvjiex

感谢楼主分享用户坐标系下，块中直线定位点-----------练习