[编程交流] 延伸两端的线

;For Extension of linear (lines & align Dimension only)
;hanhphuc 2014
argument:
_e= ename
ex= extension. 'REAL
id= dxf index. eg: '(10 11)
(defun +exlin (_e ex id / l ep a d) 
 (if (and id (= (length id) 2)) ; index list only limited for 2
   (progn (setq l  (entget _e)
         ep (mapcar ''((x) (cdr (assoc x l))) id)
         a  (angle (car ep) (cadr ep))
         d  (apply 'distance ep)
         ) ;_ end of setq
   (mapcar ''((u v)(entmod [color="blue"] (setq l [/color](subst (cons u v) (assoc u l) l)))) ; <--updated
           id
           (mapcar ''((x) (polar (mapcar ''((a b) (/ (+ a b) 2.)) (car ep) (cadr ep)) x (+ (/ d 2.) ex)))
                   (list a (+ a pi))
                   ) ;_ end of mapcar
           ) ;_ end of mapcar
   ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of defun
;Example call:
;(+exlin (car(entsel)) 1.0[color="red"] '(10 11)[/color]) <--- click line
;(+exlin (car(entsel)) 1.0[color="red"] '(13 14)[/color]) <--- click aligned dimension

(if (not *dist*)(setq *dist* 1.0))
(defun c:EXLIN (/ *error* ext e ve os ad)
 (defun *error* (msg)
   (if        (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\nError: " msg))
     ) ;_ end of if
   (princ)
   ) ;_ end of defun
 (setq        ext (getdist (strcat "\nEnter extension? <" (rtos *dist* 2) "> : "))
os  (getvar "osmode")
) ;_ end of setq
 (if (not ext)
   (setq ext *dist*)
   (setq *dist* ext)
   ) ;_ end of if
 (setvar "osmode" 0)
 (while (and (setq e (entsel "\nPick Aligned Dimension: "))
      (setq ve (vlax-ename->vla-object (car e))
            ad (vla-get-objectname ve)
            ) ;_ end of setq
      ) ;_ end of and
   (cond ((apply 'or (mapcar ''(($) (wcmatch ad $)) '("*AcDbAlignedD*" "*AcDbRotatedD*")))
   (+exlin (car e) ext '(13 14))
   ) 
  ((wcmatch ad "*AcDbLine*") (+exlin (car e) ext '(10 11))) ;(+rdim (car e) ext)
  (t nil)
  ) ;_ end of cond
   ) ;_ end of while
 (setvar "osmode" os)
 ) ;_ end of defun
http://www.cadtutor.net/forum/showthread.php?88181-line-at-both-ends-of-the-extension
(princ "\nhanhphuc 2014. Extension Dimension. Command: EXLIN")
(princ)