[求助]：怎样改变最后一个对象的宽度？

madbull · 发表于 2003-5-15 00:00:10

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(if (car (atoms-family 1 '("vl-load-com")))
(vl-load-com)
)
(defun cw_ucs_2_ent (p1 /)
(setq p1 (strcat "*"
(rtos (car p1) 1 20)
","
(rtos (cadr p1) 1 20)
","
(rtos (caddr p1) 1 20)
)
)
(command "_.ucs" "_za" "*0.0,0.0,0.0" p1)
)
;; Change Width of Polyline
;; Support:
;; line, arc, circle, polyline, lightweightpolyline
(defun C:CHANGE-WIDTH
(/ i ss sslen obj pt cenpt thick width ucsicon rad entname lay)
(setq ss (ssget))
(if (null ss)
(exit)
)
(setq i 0
sslen (sslength ss)
)
(if (null cw-width-save)
(progn ;then
(setq width (getdist "\nNew Width:"))
(while (null width) (setq width (getdist "\nNew Width:")))
)
(setq width
(getdist (strcat "\nNew Width<" (rtos cw-width-save 2) ">:")
)
)
)
(if width
(setq cw-width-save width)
)
(if (and cw-width-save (null width))
(setq width cw-width-save)
)
(setvar "cmdecho" 0)
(command "_.UNDO" "Auto" "off")
(command "_.UNDO" "_GROUP")
(setq ucsicon (getvar "ucsicon"))
(setvar "ucsicon" 0)
(while (< i (sslength ss))
(setq entname (ssname ss i))
(setq obj (vlax-ename->vla-object entname))
; change lines and arcs to polyline
(if (or (= "AcDbLine" (vla-get-objectname obj))
(= "AcDbArc" (vla-get-objectname obj))
)
(progn
(setq pt (vlax-safearray->list
(vlax-variant-value (vla-get-normal obj))
)
)
(cw_ucs_2_ent pt)
(setq thick (vla-get-thickness obj))
(command "_.pedit" entname "Y" "")
(command "_.ucs" "_p")
(setq obj (vlax-ename->vla-object (entlast)))
(vla-put-thickness obj thick)
)
)
; change circle to polyline
(if (= "AcDbCircle" (vla-get-objectname obj))
(progn
(setq cenpt (vla-get-center obj)
rad (vla-get-radius obj)
thick (vla-get-thickness obj)
lay (vla-get-layer obj)
)
(setq cenpt (vlax-safearray->list (vlax-variant-value cenpt)))
(setq pt (vlax-safearray->list
(vlax-variant-value (vla-get-normal obj))
)
)
(cw_ucs_2_ent pt)
(setq cenpt (trans cenpt 0 1))
(command "_.donut" (* 2 rad) (* 2 rad) "_non" cenpt "")
(vla-delete obj)
(command "_.ucs" "_p")
(setq obj (vlax-ename->vla-object (entlast)))
(vla-put-thickness obj thick)
(vla-put-layer obj lay)
)
)
; change polylines width
(if (member (vla-get-objectname obj)
'("AcDbPolyline" "AcDb2dPolyline")
)
(vla-put-constantwidth obj width)
)
(setq i (1+ i))
)
(setvar "ucsicon" ucsicon)
(setvar "cmdecho" 0)
(command "_.UNDO" "END")
(setvar "cmdecho" 1)
(princ)
)

(if (car (atoms-family 1 '("vl-load-com"))) 
  (vl-load-com) 
) 
 
(defun cw_ucs_2_ent (p1 /) 
  (setq p1 (strcat "*" 
     (rtos (car p1) 1 20) 
     "," 
     (rtos (cadr p1) 1 20) 
     "," 
     (rtos (caddr p1) 1 20) 
    ) 
  ) 
  (command "_.ucs" "_za" "*0.0,0.0,0.0" p1) 
) 
 
;; Change Width of Polyline 
;; Support: 
;; line, arc, circle, polyline, lightweightpolyline 
(defun C:CHANGE-WIDTH 
       (/ i ss sslen obj pt cenpt thick width ucsicon rad entname lay) 
  (setq ss (ssget)) 
  (if (null ss) 
    (exit) 
  ) 
  (setq i     0 
 sslen (sslength ss) 
  ) 
 
  (if (null cw-width-save) 
    (progn    ;then 
      (setq width (getdist "\nNew Width:")) 
      (while (null width) (setq width (getdist "\nNew Width:"))) 
    ) 
    (setq width 
    (getdist (strcat "\nNew Width<" (rtos cw-width-save 2) ">:") 
    ) 
    ) 
  ) 
  (if width 
    (setq cw-width-save width) 
  ) 
  (if (and cw-width-save (null width)) 
    (setq width cw-width-save) 
  ) 
 
  (setvar "cmdecho" 0) 
  (command "_.UNDO" "Auto" "off") 
  (command "_.UNDO" "_GROUP") 
  (setq ucsicon (getvar "ucsicon")) 
  (setvar "ucsicon" 0) 
 
  (while (
    (setq entname (ssname ss i)) 
    (setq obj (vlax-ename->vla-object entname)) 
 
     ; change lines and arcs to polyline 
    (if (or (= "AcDbLine" (vla-get-objectname obj)) 
     (= "AcDbArc" (vla-get-objectname obj)) 
 ) 
      (progn 
 (setq pt (vlax-safearray->list 
     (vlax-variant-value (vla-get-normal obj)) 
   ) 
 ) 
 (cw_ucs_2_ent pt) 
 (setq thick (vla-get-thickness obj)) 
 (command "_.pedit" entname "Y" "") 
 (command "_.ucs" "_p") 
 (setq obj (vlax-ename->vla-object (entlast))) 
 (vla-put-thickness obj thick) 
      ) 
    ) 
 
     ; change circle to polyline 
    (if (= "AcDbCircle" (vla-get-objectname obj)) 
      (progn 
 (setq cenpt (vla-get-center obj) 
       rad   (vla-get-radius obj) 
       thick (vla-get-thickness obj) 
       lay   (vla-get-layer obj) 
 ) 
 (setq cenpt (vlax-safearray->list (vlax-variant-value cenpt))) 
 (setq pt (vlax-safearray->list 
     (vlax-variant-value (vla-get-normal obj)) 
   ) 
 ) 
 (cw_ucs_2_ent pt) 
 (setq cenpt (trans cenpt 0 1)) 
 (command "_.donut" (* 2 rad) (* 2 rad) "_non" cenpt "") 
 (vla-delete obj) 
 (command "_.ucs" "_p") 
 (setq obj (vlax-ename->vla-object (entlast))) 
 (vla-put-thickness obj thick) 
 (vla-put-layer obj lay) 
      ) 
    ) 
 
     ; change polylines width 
    (if (member (vla-get-objectname obj) 
  '("AcDbPolyline" "AcDb2dPolyline") 
 ) 
      (vla-put-constantwidth obj width) 
    ) 
    (setq i (1+ i)) 
  ) 
 
  (setvar "ucsicon" ucsicon) 
  (setvar "cmdecho" 0) 
  (command "_.UNDO" "END") 
  (setvar "cmdecho" 1) 
 
  (princ) 
)

这是别人编写的改编线宽的LISP，怎样在它的基础上编一个LISP改变最后一个物体的线宽（包括弧、圆等）？

XDSoft · 发表于 2003-5-15 00:01:57

最初由 madbull 发布
[B](if (car (atoms-family 1 '("vl-load-com")))
  (vl-load-com)
)

(defun cw_ucs_2_ent (p1 /)
  (setq p1 (strcat "*"
   (rtos (car p1) 1 20)
   ","
   (rtos (cadr p1) 1 20)
   ","
   ... [/B]

改变最后一个实体的线宽，怎么理解？详细解释下吧。

aeo · 发表于 2003-5-15 20:32:39

(defun c:cha () (C:CHANGE-WIDTH(entlast)))

madbull · 发表于 2003-5-16 07:00:05

我的意思是：改变图面上最后一个画的line, arc, circle, polyline, lightweightpolyline的宽度。
to aeo ：您的(defun c:cha () (C:CHANGE-WIDTH(entlast)))放在哪个位置上才好使呀？

aeo · 发表于 2003-5-16 20:53:19

上面的C:CHANGE-WIDTH你不是已经加载了么!
(setq ss (ssget))改为(setq ss(ssadd)ss(ssadd (entlast)ss) )

madbull · 发表于 2003-6-3 08:40:17

明白了。谢谢！

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：怎样改变最后一个对象的宽度？

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [求助]：[LISP程序]：怎样改变最后一个对象的宽度？

浏览过的版块