[求助]：分析源代码---求助高手

knight928 · 发表于 2006-5-28 11:14:17

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

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

×

(Defun C:Checkj()
(Vl-Load-Com)
(Setvar "Cmdecho" 0)
(setq ptd '(-4890.5 828.38 00000.00))
(setq cc 6)
(Setq Sslabel (Ssget "X" '((0 . "Polyline"))))
(Setq Ssn (Sslength Sslabel))
(Setq M 0 L 0)
(Repeat Ssn ;1求顶点坐标
(Setq En (Ssname Sslabel M))
(Setq Obj (Vlax-Ename->Vla-Object En))
(Setq Vtx (Vla-Get-Coordinates Obj))
(Setq Vtxlst (Vlax-Safearray->List (Vlax-Variant-Value Vtx)))
(Setq Ll (/ (Length Vtxlst) 3))
(Setq N 0 )
(Repeat Ll ;11
(Setq Pt (List (Nth N Vtxlst) (Nth (+ N 1) Vtxlst)))
(setq ptla (strcat (Rtos (Nth 0 Pt)) (Rtos (Nth 1 Pt))))
(Setq ssyuan (ssget "x" '((0 . "Circle"))))
(setq ssyuanl (sslength ssyuan))
(repeat ssyuanl;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;过滤圆
(setq eny (ssname ssyuan l))
(setq enydata (entget eny ))
(setq yuan (cdr (assoc 10 enydata)))
(setq ptyu (strcat (Rtos (Nth 0 yuan)) (Rtos (Nth 1 yuan))))
(command "PLINE" pt ptd "")
(setq pl (entlast))
(If (= ptyu ptla)
(COMMAND "CHPROP" PL "" C CC "") ;;;???不能变颜色？？？
)
(setq l (1+ l))
);;;yuan
(Setq N (+ N 3))
);11
(Setq M (1+ M))
);;;;;;;;;;;;;;1
(setq se (ssget "x" '((62 . cc )))) ;;;要删除改变颜色后的项
(command "erase" se "");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;这里有问题，不能执行命令，可能这两句的位置不合适
(Princ "\n.命令:...The End...")
(princ "\n.")
;(Prin1)
)

(Defun C:Checkj() 
  (Vl-Load-Com) 
  (Setvar "Cmdecho" 0) 
  (setq ptd '(-4890.5 828.38 00000.00)) 
  (setq cc 6) 
  (Setq Sslabel (Ssget "X" '((0 . "Polyline")))) 
  (Setq Ssn (Sslength Sslabel)) 
  (Setq M 0 L 0) 
  (Repeat Ssn             ;1求顶点坐标                        
    (Setq En (Ssname Sslabel M))            
               (Setq Obj (Vlax-Ename->Vla-Object En)) 
        (Setq Vtx (Vla-Get-Coordinates Obj)) 
        (Setq Vtxlst (Vlax-Safearray->List (Vlax-Variant-Value Vtx))) 
        (Setq Ll (/ (Length Vtxlst) 3)) 
        (Setq N 0 ) 
        (Repeat        Ll            ;11 
          (Setq Pt (List (Nth N Vtxlst) (Nth (+ N 1) Vtxlst))) 
          (setq ptla (strcat (Rtos (Nth 0 Pt)) (Rtos (Nth 1 Pt)))) 
          (Setq ssyuan (ssget "x" '((0 . "Circle")))) 
          (setq ssyuanl (sslength ssyuan)) 
          (repeat ssyuanl;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;过滤圆 
            (setq eny (ssname ssyuan l)) 
            (setq enydata (entget eny )) 
            (setq yuan (cdr (assoc 10 enydata))) 
            (setq ptyu (strcat (Rtos (Nth 0 yuan)) (Rtos (Nth 1 yuan)))) 
            (command "PLINE" pt ptd "") 
            (setq pl (entlast)) 
              (If (= ptyu ptla) 
                (COMMAND "CHPROP" PL "" C CC "")  ;;;???不能变颜色？？？                                                      
                ) 
            (setq l (1+ l)) 
             
            );;;yuan 
                  
           
        (Setq N (+ N 3)) 
         );11 
        (Setq M (1+ M)) 
    );;;;;;;;;;;;;;1 
  (setq se (ssget "x" '((62 . cc ))))  ;;;要删除改变颜色后的项 
  (command "erase" se "");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;这里有问题，不能执行命令，可能这两句的位置不合适 
  (Princ "\n.命令:...The End...") 
  (princ "\n.") 
  ;(Prin1) 
  )

eachy · 发表于 2006-5-28 11:44:48

'((62 . cc )) -> (list (cons 62 cc))

(COMMAND "CHPROP" PL "" C CC "") -> (COMMAND "CHPROP" PL "c" CC "")

先要看清命令怎么使用！

knight928 · 发表于 2006-5-28 15:40:08

(COMMAND "CHPROP" PL "c" CC "") 这个也不行哟命令行提示：命令: (COMMAND "CHPROP" PL "c" CC "")
窗口说明无效。
; 错误: *error* 函数中出错参数太多

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

[求助] [求助]：分析源代码---求助高手

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

相关帖子