Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 02/17/2023 in all areas

  1. Just watch for : vlax-curve-getpointatdist function... Provided distance must not go above total length of curve, otherwise, return will be start point... This is bug in AutoCAD; BricsCAD returns nil which is correct...
    1 point
  2. Okay @Steven P For reference sample dwg attached Chainage.dwg
    1 point
  3. I moved your thread to the AutoLISP, Visual LISP & DCL Forum and put your code in code tags.
    1 point
  4. (defun c:Lay_Copy_Locked ( / *error* layUlist laydata ss ) (vl-load-com) (defun *error* ( m ) (if command-s (command-s "_.UNDO" "_E") (vl-cmdf "_.UNDO" "_E") ) (if m (prompt m) ) (princ) ) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) (if (= 8 (logand 8 (getvar 'undoctl))) (if command-s (command-s "_.UNDO" "_E") (vl-cmdf "_.UNDO" "_E") ) ) (if command-s (command-s "_.UNDO" "_G") (vl-cmdf "_.UNDO" "_G") ) ; Unlock all layers - https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/unlocking-layers-is-painfully-slow/m-p/2881866#M294136 (vlax-for item (vla-get-layers doc) (if (= (vlax-get-property item "Lock") :vlax-true) (progn (setq Locked_Layers (cons item Locked_Layers)) ; set variable "locked_layers" to all locked layers. (vlax-put-property item "Lock" :vlax-false) ; unlock each layer if it is locked. ) ; end progn ) ; end if ) ; end vlax ;; Copy to layer (if (setq ss (ssget "_:L")) (command "._-copytolayer" ss "") ) ; end if ; If any layers were locked at the beginning, lock them again. -https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/unlocking-layers-is-painfully-slow/m-p/2881866#M294136 (if Locked_Layers (mapcar '(lambda (x) (vlax-put-property x "Lock" :vlax-true)) Locked_Layers) ) ; end if (*error* nil) ) ; defun
    1 point
  5. You can do it with temporarily changing UCS rotation and just processing RECTANGLE command... (defun c:foo ( / *error* ucsf ll lr ) (defun *error* ( m ) (if ucsf (if command-s (command-s "_.UCS" "_P") (vl-cmdf "_.UCS" "_P") ) ) (if m (prompt m) ) (princ) ) (if (= 0 (getvar 'worlducs)) (progn (vl-cmdf "_.UCS" "_W") (setq ucsf t) ) ) (vl-cmdf "_.UCS" "_Z" (cvunit (getangle (setq ll (getpoint "\nBase point : ")) (setq lr (getpoint "\nDirection : ")) "radian" "degree")) (vl-cmdf "_.RECTANGLE" "_non" (trans ll 0 1) "\\") (*error* nil) )
    1 point
×
×
  • Create New...