大神能帮忙改一下吗？我初学好多地方看不明白
你说的原对象的属性是指什么，颜色、线型、图层？还是扩展数据xdata？还是什么别的 本帖最后由 ketxu 于 2019-4-16 00:57 编辑
Mine version.
(defun c:COL (/ s *error* l _id)
(defun *error*(m)
(princ m)
(:CM:EndMark *CM:Doc*)
(if oCMD (setvar 'cmdEcho oCMD))
;(if l (setq *lSetting* l))
(princ)
)
(:CM:StartMark *CM:Doc*)
(setq oCMD (getvar 'cmdecho))(setvar 'cmdecho 0)
;Private function
(cond
(
(and
;Select
(setq s
(:CM:SS-Select "\nCh\U+1ECDn c\U+00E1c Line, Pline, Arc, SPLINE mu\U+1ED1n thay \U+0111\U+1ED5i chi\U+1EC1u d\U+00E0i :"
(list "_:L" '((0 . "LINE,LWPOLYLINE,POLYLINE,ARC,SPLINE")))
)
)
;Setting
;Chi can doan nay la vua thiet dat che do hien hanh, vua tao dialog. Chua co phan luu key vao Reg
(setq *lSetting*
((lambda(/ fl ret dcl_id lstKey init l)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w")
tt "Ch\U+01B0\U+01A1ng tr\U+00ECnh cho ph\U+00E9p k\U+00E9o d\U+00E0i \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Line, Polyline, LWPolyline, Arc theo ph\U+00EDa
\n\\U+00A9 Ketxu 3/2017
\nMail : ks.stung@gmail.com
\niCad Group"
title "Change Objects Length v1"
)
(or *lengDelta* (setq *lengDelta* 10))
;List key_label_value default
(or *lSetting* (setq *lSetting* '(("kStart" "\U+0110\U+1EA7u" "0")("kEnd" "Cu\U+1ED1i" "0")("kBoth" "C\U+1EA3 2 ph\U+00EDa" "1") ("kTotal" "T\U+1ED5ng" "0"))))
(mapcar
'(lambda (x) (write-line x ret))
(list
"Dialog : dialog { "
(strcat "label=\"" title "\"; width = 10;fixed_width = true;")
":edit_box {label =\"Chi\U+1EC1u d\U+00E0i :\";key = \"kDel\";}"
" :radio_column{"
(strcat "label=\"" "Ph\U+00EDa :""\";")
(apply 'strcat (mapcar '(lambda (x)(strcat ":radio_button {key=\"" (car x) "\";width=2;label=\"" (cadr x) "\";}")) *lSetting*))
": spacer { height = 0.2; }"
" :text_part {alignment=centered;"
(strcat "label=\"" "\\U+00A9 Ketxu - iCad Tools" "\";")
"}"
"}"
": column {"
": row {"
" fixed_width = true;"
" alignment = centered;"
":button {label = \"Ok\";key = \"kOK\";is_cancel = true;fixed_width = true;width = 1;is_default = 1;}"
":button {label = \"Help\";fixed_width = true;width = 1;key = \"kHelp\";}"
"}"
"}}"
)
) ;_ end of mapcar
;Load DCL
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "Dialog" dcl_id)
) ;_ end of and
(progn
;Init
(defun init()
(mapcar '(lambda(x)(set_tile (car x) (last x))) *lSetting*)
(set_tile "kDel" (rtos *lengDelta*))
)
(init)
;Get all value when change
(defun Get_Value(/ l1)
(setq *lengDelta* (distof (get_tile "kDel")))
(mapcar
'(lambda(x)(list (car x) (cadr x)(get_tile (car x))))
*lSetting*
)
)
(defun get_len()
(if (not (distof (get_tile "kDel")))(alert "Vui l\U+00F2ng nh\U+1EADp s\U+1ED1 !"))
)
(action_tile "kOK" "(setq ret (Get_value))(done_dialog 4)")
(action_tile "kDel" "(get_len)")
(action_tile "kHelp" "(alert tt)")
(setq dlg_Exit (start_dialog))
) ;_ end of progn
) ;_ end of if
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
))
);End setq
);End And + Cond
(defun _id(i)(= (last (assoc i *lSetting*)) "1"))
(foreach e (:CM:SS->List s)
(apply 'command
(append
(list "_.lengthen")
(cond ((_id "kStart") (list "_delta" *lengDelta* (list e (vlax-curve-getstartpoint e)) ""))
((_id "kEnd") (list "_delta" *lengDelta* (list e (vlax-curve-getendpoint e)) ""))
((_id "kBoth") (list "_delta" *lengDelta* (list e (vlax-curve-getendpoint e)) (list e (vlax-curve-getstartpoint e)) ""))
((_id "kTotal") (list "Total" *lengDelta* (list e (vlax-curve-getstartpoint e)) ""))
)
)
))
)
(T (princ "\nL\U+1ED7i ! Xin li\U+00EAn h\U+1EC7 v\U+1EDBi t\U+00E1c gi\U+1EA3 !") )
)
(*error* nil)
(princ)
)
<blockquote>(vl-load-com) 本帖最后由 ketxu 于 2019-4-16 01:13 编辑
(vl-load-com)
;; Open mark and closed mark status
;; doc : active document object
;; doc = (vla-get-activedocument (vlax-get-acad-object))
;;------------------------------------------------------------;;
(defun :CM:StartMark ( doc ) (:CM:EndMark doc)
(vla-StartUndoMark doc)
)
;;------------------------------------------------------------;;
(defun :CM:EndMark ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
;(princ)
)
;;------------------------------------------------------------;;
(defun :CM:acdoc nil
(eval (list 'defun ':CM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(:CM:acdoc)
)
(or *CM:Doc* (setq *CM:Doc* (:CM:acdoc)))
(defun Start()(:CM:StartMark *CM:DOC*))
(defun End()(:CM:EndMark *CM:DOC*))
ketxu 发表于 2019-4-16 00:57
命令: col
no function definition: :CM:SS-SELECT Sorry, it's in my library function, and credit for Lee-mac ^^
;; ssget-Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - selection prompt
;; arg - list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
(setq :CM:SS-Select LM:ssget) 我也遇到这个问题了:(
页:
1
[2]