ZZXXQQ 发表于 2014-11-1 08:48:08

;车位转块 明经 ZZXXQQ 2014.11.1
(defun c:tt ()
(setvar "CMDECHO" 1)
(if (setq ss (ssget '((0 . "LWPOLYLINE")(90 . 6)))) (progn
    (setq en (ssname ss 0))
    (ssdel en ss)
    (setq ent (entget en))
    (setq ptlst (list))
    (foreach x ent (if (= (car x) 10) (setq ptlst (cons (cdr x) ptlst))))
    (setq ptm (mapcar '(lambda (a b) (/ (+ a b) 2)) (car ptlst) (caddr ptlst)))
    (setq ang (angle (car ptlst) (caddr ptlst)))
    (setq dis (distance (car ptlst) (caddr ptlst)))
    (if (not (tblsearch "BLOCK" "chewei"))
      (command "-BLOCK" "chewei" ptm en "")
    )
    (command "-INSERT" "chewei" ptm 1 1 0)
    (repeat (setq i (sslength ss))
      (setq ent (entget(setq en (ssname ss (setq i (1- i))))))
      (setq ptlst (list))
      (foreach x ent (if (= (car x) 10) (setq ptlst (cons (cdr x) ptlst))))
      (setq ptm (mapcar '(lambda (a b) (/ (+ a b) 2)) (car ptlst) (caddr ptlst)))
      (setq ang1 (- (angle (car ptlst) (caddr ptlst)) ang))
      (setq ang2 (/ (* ang1 180) pi))
      (setq sc (/ (distance (car ptlst) (caddr ptlst)) dis))
      (entdel en)
      (command "-INSERT" "chewei" ptm sc sc ang2)
    )
))
(setvar "CMDECHO" 1)
(princ)
)
页: 1 [2]
查看完整版本: 批量“PL多段线车位”做单独块