根据线长 自动批量调整线型比例

lengxiaxi

          作图时，经常需要用到多种线型，而且即便是同一种线型，因为画的长度不同，线型比例又是一致的，导致显示为连续线，很不方便识图。但是一个个调整，又很浪费时间。我觉得应该有一种方式，可以根据线的长度，自动调整为不同得线型比例，以实现容易识别之目的。而且最好可以多线型，批量的调整。
     
         此前看过小笨大神的 智能中心线程序，出中心线时，能够根据图元大小，自动调整中心线的线型比例。不知道我的上述情况，能根据小笨大神的启示而实现吗？

song宋_74729

lengxiaxi 发表于 2014-11-21 19:52
亲，能帮忙写个吗？我不懂编程，如果需要，你看我就4个币了，全部家当都给你也行，只为画好图！

;;; 动态线型比例 by qjchen@gmail.com
;;; 思路来自于eachy版主 http://eachy.bokee.com/5731665.html
;;; http://eachy.bokee.com/5731665.html

(defun C:test ( / dcl_id dclcontent dclname userclick temp)
  (vl-load-com)
  (setq temp (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq dclcontent (list
           "qjchenedynamicltscale:dialog{"
           "label=\"线型比例修改 qjchen编制\";"
           ":button{"
                "key = \"button1\";"
                "label = \"单独线型比例修改\";}"
           ":button{"
                "key = \"button2\";"
                "label = \"全局线型比例修改\";}"
           "ok_cancel;}")
  dclname "qjchendltscale"
  )
  (setq dcl_id (load_dialog (qjchencreatdcl dclname dclcontent)))
  (if (not (new_dialog "qjchenedynamicltscale" dcl_id)) (exit))
  (action_tile "button1" "(done_dialog 3)")
  (action_tile "button2" "(done_dialog 4)")
  (setq userclick (start_dialog))
  (unload_dialog dcl_id)
  (cond ((= 3 userclick)(qjchenedltscale 1))
        ((= 4 userclick)(qjchenedltscale 2))
  )
  (command "undo" "e")
  (setvar "cmdecho" temp)
)

(defun qjchenedltscale(n / a b gr linetype newscale o orilst overallltscale zq)
  (prompt "\n 请选择某一非continuous线型的物体:")
  (setq a (car (entsel)) o (vlax-ename->vla-object a))
  (setq orilst (vlax-get-property o 'LinetypeScale))
  (setq linetype (cdr (assoc 6 (entget a))))
  (if (= linetype nil)
      (setq linetype (cdr (assoc 6 (tblsearch "layer" (cdr (assoc 8 (entget a)))))))
  )
  (if (and linetype (/= linetype "Continuous"))
    (progn  
      (setq zq (cdr (assoc 40 (tblsearch "ltype" linetype))))
      (setq overallltscale (getvar "LTSCALE"))
      (setq b (getpoint "\n请选择一个点:"))
      (while (= (car (setq gr (grread nil 5 0))) 5)
        (redraw)
        (grdraw (cadr gr) b 1 1)
        (setq newscale (/ (distance (cadr gr) b) zq overallltscale))
        (apply-props o (list (list "LinetypeScale" newscale)))
      )
      (if (= n 2)
        (progn
          (setvar "ltscale" (* overallltscale (/ newscale orilst)))
          (apply-props o (list (list "LinetypeScale" orilst)))
          (command "regen")
        )
      )
    )
  )
  (vlax-release-object o)
  (princ)
)

(defun apply-props (object proplist)
  (foreach prop proplist
    (if (vlax-property-available-p object (car prop))
      (vlax-put-property object (car prop) (cadr prop))
    )
  )
)

(defun qjchencreatdcl(dclname lst)
(setq dcl_name (strcat (getenv "temp") "\\" dclname ".dcl")
        f (OPEN dcl_name "w")
  )
  (foreach x lst
     (write-line x f)
   )
  (close f)
  dcl_name
)

;;end main program
(princ "\n By qjchen@gmail.com, 动态线型比例调整, The command is test")
(princ)


[飞马系列] Grread 动态调整线型比例
http://bbs.mjtd.com/forum.php?mo ... amp;fromuid=7313835
(出处: 明经CAD社区)

鱼与熊掌

    那当然也是可以的。     

lengxiaxi

鱼与熊掌 发表于 2014-11-21 19:46
那当然也是可以的。

亲，能帮忙写个吗？我不懂编程，如果需要，你看我就4个币了，全部家当都给你也行，只为画好图！